Merge pull request #28 from Boehringer-Ingelheim/27-qc-does-not-work-…

…when-generic-errors-happen-during-testing appends ids to test names instead of appending as attributes
Boehringer-Ingelheim · Jun 19, 2024 · bb360c3 · bb360c3
2 parents 72eda62 + 9460de6
commit bb360c3
Show file tree

Hide file tree

Showing 2 changed files with 39 additions and 23 deletions.
diff --git 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
diff --git 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)