diff --git a/inst/validation/utils-validation.R b/inst/validation/utils-validation.R index 72a1808..06eeb3d 100644 --- a/inst/validation/utils-validation.R +++ b/inst/validation/utils-validation.R @@ -56,7 +56,7 @@ if (FALSE) { } # Validation code - +# nolint start cyclocomp_linter local({ specs <- source( system.file("validation", "specs.R", package = package_name, mustWork = TRUE), @@ -112,27 +112,44 @@ local({ } # This should be covered by pack of constants but just in case } else { spec_id_chr <- spec_id - } - structure(desc, spec_id = spec_id_chr, spec = spec) + } + paste0(desc, "__spec_ids{", paste0(spec_id_chr, collapse = ";"), "}") }, - get_spec = function(result) { - lapply( - result, - function(x) { - first_result <- try( - x[[1]][["test"]], - silent = TRUE - ) - if (inherits(first_result, "try-error")) { - list(spec_id = NULL, desc = NULL) - } else { - list( - spec_id = attr(first_result, "spec_id", exact = TRUE), - spec = attr(first_result, "spec", exact = TRUE) - ) - } + get_spec = function(test, specs) { + spec_ids <- utils::strcapture( + 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 + ) + } else { + specs_and_id[[idx]] <- list( + spec_id = NULL, + spec = NULL + ) + } + } + specs_and_id } + + ) }) + +# nolint end cyclocomp_linter \ No newline at end of file diff --git a/inst/validation/val_report_child.Rmd b/inst/validation/val_report_child.Rmd index 95cb47c..bf7f1bc 100644 --- a/inst/validation/val_report_child.Rmd +++ b/inst/validation/val_report_child.Rmd @@ -30,7 +30,7 @@ suppressPackageStartupMessages(stopifnot(requireNamespace("devtools"))) # Parse tests ---- tests <- as.data.frame(params[["tests"]]) -tests[["validation_data"]] <- vdoc[["get_spec"]](tests[["result"]]) +tests[["validation_data"]] <- vdoc[["get_spec"]](tests[["test"]], vdoc[["specs"]]) tests[["spec_id"]] <- sapply(tests[["validation_data"]], function(x) x[["spec_id"]]) tests[["spec"]] <- sapply(tests[["validation_data"]], function(x) x[["spec"]]) tests[["spec_id_paste"]] <- vapply(tests[["spec_id"]], function(x) paste(x, collapse = "\n"), FUN.VALUE = character(1)) @@ -49,8 +49,7 @@ undeclared_spec <- tested_spec[!tested_spec %in% declared_spec] spec_tests[["are_declared"]] <- sapply(spec_tests[["spec_id"]], function(x) all(x %in% declared_spec)) # Count tests in the different categories ---- - -mask_failed <- !!spec_tests[["failed"]] +mask_failed <- !!spec_tests[["failed"]] | spec_tests[["error"]] mask_skipped <- !!spec_tests[["skipped"]] mask_declared <- spec_tests[["are_declared"]] n_pass_dec <- sum(!mask_failed & !mask_skipped & mask_declared)