diff --git a/inst/validation/run_validation.R b/inst/validation/run_validation.R index 66396c0..465c65c 100644 --- a/inst/validation/run_validation.R +++ b/inst/validation/run_validation.R @@ -5,19 +5,19 @@ test_results <- tibble::as_tibble(devtools::test()) local({ # This is evaluated inside a local because, otherwise, all the variables created in the chunks of the rendered # document leak into the environment - + validation_root <- "./inst/validation" validation_report_rmd <- file.path(validation_root, "val_report.Rmd") validation_report_html <- "val_report.html" validation_results <- file.path(validation_root, "results") val_param_rds <- file.path(validation_results, "val_param.rds") - + stopifnot(dir.exists(validation_root)) stopifnot(file.exists(validation_report_rmd)) - + stopifnot(dir.exists(validation_results)) unlink(list.files(validation_results)) - + saveRDS( list( package = pkg_name, @@ -26,7 +26,7 @@ local({ ), val_param_rds ) - + rmarkdown::render( input = validation_report_rmd, params = list( @@ -37,7 +37,7 @@ local({ output_dir = validation_results, output_file = validation_report_html ) - + # We use one of the leaked variables, created inside the validation report to asses if the validation is # succesful or not VALIDATION_PASSED diff --git a/inst/validation/utils-validation.R b/inst/validation/utils-validation.R index eeb9356..06eeb3d 100644 --- a/inst/validation/utils-validation.R +++ b/inst/validation/utils-validation.R @@ -67,29 +67,29 @@ local({ return(parent) } unlist(mapply(recursive_ids, - x, - paste(parent, names(x), - sep = if (identical(parent, character(0))) "" else "$" - ), - SIMPLIFY = FALSE, USE.NAMES = FALSE + x, + paste(parent, names(x), + sep = if (identical(parent, character(0))) "" else "$" + ), + SIMPLIFY = FALSE, USE.NAMES = FALSE )) } - + recursive_ids <- function(x, parent = character(0)) { if (!is.list(x)) { return(parent) } unlist(mapply(recursive_ids, x, - paste(parent, names(x), - sep = if (identical(parent, character(0))) "" else "$" - ), - SIMPLIFY = FALSE, USE.NAMES = FALSE + paste(parent, names(x), + sep = if (identical(parent, character(0))) "" else "$" + ), + SIMPLIFY = FALSE, USE.NAMES = FALSE )) } - - + + spec_id_list <- recursive_ids(specs) - + list( specs = specs, spec_id_list = spec_id_list, @@ -102,11 +102,11 @@ local({ } else { spec_id <- list(s_spec) # Otherwise the posterior vapply iterates over the expression } - + spec_id_chr <- vapply(spec_id, function(x) { sub("^[^$]*\\$", "", deparse(x)) }, FUN.VALUE = character(1)) - + if (!all(spec_id_chr %in% spec_id_list)) { stop("At least one spec is not declared in the spec list") } # This should be covered by pack of constants but just in case @@ -117,39 +117,39 @@ local({ }, get_spec = function(test, specs) { spec_ids <- utils::strcapture( - pattern = "__spec_ids\\{(.*)\\}", - x = test, - proto = list(spec = character()) - )[["spec"]] + pattern = "__spec_ids\\{(.*)\\}", + x = test, + proto = list(spec = character()) + )[["spec"]] spec_ids <- strsplit(spec_ids, split = ";") - + specs_and_id <- list() - + for (idx in seq_along(spec_ids)){ ids <- spec_ids[[idx]] if (all(!is.na(ids))) { this_specs <- list() - for (sub_idx in seq_along(ids)) { - id <- ids[[sub_idx]] - this_specs[[sub_idx]] <- eval(str2expression(paste0("specs$", id))) - } - specs_and_id[[idx]] <- list( - spec_id = ids, - spec = this_specs - ) + for (sub_idx in seq_along(ids)) { + id <- ids[[sub_idx]] + this_specs[[sub_idx]] <- eval(str2expression(paste0("specs$", id))) + } + specs_and_id[[idx]] <- list( + spec_id = ids, + spec = this_specs + ) } else { specs_and_id[[idx]] <- list( - spec_id = NULL, - spec = NULL - ) + spec_id = NULL, + spec = NULL + ) } } specs_and_id } - + ) }) -# nolint end cyclocomp_linter +# nolint end cyclocomp_linter \ No newline at end of file