Skip to content

Commit 36aea30

Browse files
committed
Create new tests for printing and table validation
1 parent 616a157 commit 36aea30

4 files changed

Lines changed: 94 additions & 17 deletions

File tree

DESCRIPTION

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,15 +38,17 @@ Imports:
3838
tidyr,
3939
tidyselect,
4040
xml2
41-
Suggests:
41+
Suggests:
4242
covr,
4343
knitr,
4444
rmarkdown,
45-
testthat
45+
testthat,
46+
withr
4647
VignetteBuilder:
4748
knitr
4849
Encoding: UTF-8
4950
Roxygen: list(markdown = TRUE, r6 = FALSE)
51+
Config/testthat/edition: 3
5052
Config/roxygen2/version: 8.0.0
5153
Collate:
5254
'Metacore.R'

R/DatasetMeta.R

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#' Shared print method for DatasetMeta variants
22
#' @noRd
3-
.dataset_meta_print <- function(...) {
3+
DatasetMeta_print <- function(...) {
44
tables <- ls(envir = self)
55
cli_par()
66
cli_rule(left = "Dataset specification object for {private$.name} ({private$.label})")
@@ -22,7 +22,7 @@
2222

2323
#' Shared private fields and greet for DatasetMeta variants
2424
#' @noRd
25-
.dataset_meta_private <- list(
25+
DatasetMeta_private <- list(
2626
.name = NA,
2727
.label = NA,
2828
.num_vars = NA,
@@ -38,7 +38,7 @@
3838

3939
#' Shared post-initialize bookkeeping for DatasetMeta variants
4040
#' @noRd
41-
.dataset_meta_post_init <- function(metacore, quiet, verbose, private) {
41+
DatasetMeta_post_init <- function(metacore, quiet, verbose, private) {
4242
private$.name <- metacore$ds_spec$dataset[[1]]
4343
private$.label <- metacore$ds_spec$label[[1]]
4444
private$.num_vars <- nrow(metacore$ds_vars)
@@ -58,7 +58,7 @@
5858
#' @noRd
5959
DatasetMeta <- R6::R6Class("DatasetMeta",
6060
inherit = MetaCore,
61-
private = .dataset_meta_private,
61+
private = DatasetMeta_private,
6262
public = list(
6363
initialize = function(metacore, quiet = deprecated(), verbose = "message") {
6464
super$initialize(
@@ -70,9 +70,9 @@ DatasetMeta <- R6::R6Class("DatasetMeta",
7070
codelist = metacore$codelist,
7171
supp = metacore$supp
7272
)
73-
.dataset_meta_post_init(metacore, quiet, verbose, private)
73+
DatasetMeta_post_init(metacore, quiet, verbose, private)
7474
},
75-
print = .dataset_meta_print
75+
print = DatasetMeta_print
7676
)
7777
)
7878

@@ -90,7 +90,7 @@ DatasetMeta <- R6::R6Class("DatasetMeta",
9090
#' @noRd
9191
DatasetMetaDefine <- R6::R6Class("DatasetMeta",
9292
inherit = MetaCoreDefine,
93-
private = .dataset_meta_private,
93+
private = DatasetMeta_private,
9494
public = list(
9595
initialize = function(metacore, quiet = deprecated(), verbose = "message") {
9696
super$initialize(
@@ -107,8 +107,8 @@ DatasetMetaDefine <- R6::R6Class("DatasetMeta",
107107
quiet = quiet,
108108
verbose = verbose
109109
)
110-
.dataset_meta_post_init(metacore, quiet, verbose, private)
110+
DatasetMeta_post_init(metacore, quiet, verbose, private)
111111
},
112-
print = .dataset_meta_print
112+
print = DatasetMeta_print
113113
)
114114
)

tests/testthat/test-dataset-meta.R

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
dm_base <- select_dataset(mc_original, "DM", verbose = "silent")
2+
dm_define <- select_dataset(mc_define, "DM", verbose = "silent")
3+
4+
# DatasetMeta print -------------------------------------------------------
5+
6+
test_that("DatasetMeta print snapshot", {
7+
withr::local_options(cli.num_colors = 0)
8+
expect_snapshot(print(dm_base))
9+
})
10+
11+
# DatasetMetaDefine print -------------------------------------------------
12+
13+
test_that("DatasetMetaDefine print snapshot", {
14+
withr::local_options(cli.num_colors = 0)
15+
expect_snapshot(print(dm_define))
16+
})

tests/testthat/test-reader.R

Lines changed: 65 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -538,7 +538,7 @@ test_that("codelist reader tests", {
538538
"SCREENING 1", "UNSCHEDULED 1.1", "UNSCHEDULED 1.2", "UNSCHEDULED 1.3", "SCREENING 2", "BASELINE", "UNSCHEDULED 3.1", "AMBUL ECG PLACEMENT", "WEEK 2", "UNSCHEDULED 4.1", "UNSCHEDULED 4.2", "WEEK 4", "UNSCHEDULED 5.1", "AMBUL ECG REMOVAL",
539539
"UNSCHEDULED 6.1", "WEEK 6", "UNSCHEDULED 7.1", "WEEK 8", "WEEK 10 (T)", "UNSCHEDULED 8.2", "WEEK 12", "WEEK 14 (T)", "UNSCHEDULED 9.2", "UNSCHEDULED 9.3", "WEEK 16", "WEEK 18 (T)", "UNSCHEDULED 10.2", "WEEK 20", "WEEK 22 (T)", "UNSCHEDULED 11.2", "WEEK 24", "UNSCHEDULED 12.1", "WEEK 26", "UNSCHEDULED 13.1", "AE FOLLOW-UP", "RETRIEVAL", "Rash followup"
540540
)), "code_decode",
541-
# "CL.Y_BLANK", "Y_BLANK", tibble(code = "Y", decode = "Yes"), "code_decode",
541+
# "CL.Y_BLANK", "Y_BLANK", tibble(code = "Y", decode = "Yes"), "code_decode",
542542
"CL.YN", "YN", tibble(code = c("N", "Y"), decode = c("No", "Yes")), "code_decode"
543543
)
544544

@@ -723,7 +723,7 @@ test_that("spec_type_to_value_spec auto-generates derivation_id from origin when
723723
Predecessor = c(NA_character_, NA_character_)
724724
)
725725
doc <- list(ValueSpec = val_sheet)
726-
# No derivation_id in cols — auto-generated at lines 786-795
726+
# No derivation_id in cols. Auto-generated at lines 786-795
727727
cols <- c(
728728
dataset = "^Dataset$",
729729
variable = "^Variable$",
@@ -734,16 +734,16 @@ test_that("spec_type_to_value_spec auto-generates derivation_id from origin when
734734

735735
result <- spec_type_to_value_spec(doc, cols = cols, where_sep_sheet = FALSE, var_sheet = NULL)
736736

737-
# origin "Assigned" dataset.variable
737+
# origin "Assigned" to dataset.variable
738738
expect_equal(result$derivation_id[result$variable == "AGE"], "ADSL.AGE")
739-
# other origin pred.dataset.variable
739+
# other origin to pred.dataset.variable
740740
expect_equal(result$derivation_id[result$variable == "VISIT"], "pred.ADSL.VISIT")
741741
})
742742

743743
test_that("spec_type_to_var_spec errors when duplicate variables have different metadata without dataset col", {
744744
vars_sheet <- tibble::tibble(
745745
Variable = c("VISIT", "VISIT"),
746-
Length = c("20", "40"), # different lengths same variable, different metadata
746+
Length = c("20", "40"), # different lengths, same variable, different metadata
747747
Label = c("Visit", "Visit"),
748748
Type = c("Char", "Char"),
749749
Format = c(NA_character_, NA_character_)
@@ -770,7 +770,7 @@ test_that("spec_type_to_var_spec errors when duplicate variables have different
770770
test_that("spec_type_to_var_spec passes when duplicate variables have identical metadata without dataset col", {
771771
vars_sheet <- tibble::tibble(
772772
Variable = c("VISIT", "VISIT"),
773-
Length = c("20", "20"), # identical rows distinct() collapses to one
773+
Length = c("20", "20"), # identical rows. distinct() collapses to one
774774
Label = c("Visit", "Visit"),
775775
Type = c("Char", "Char"),
776776
Format = c(NA_character_, NA_character_)
@@ -836,3 +836,62 @@ test_that("spec_to_metacore provides detailed information for failed regular exp
836836
))
837837
)
838838
})
839+
840+
# spec_type_to_codelist column-name validation --------------------------------
841+
842+
test_that("spec_type_to_codelist errors when codelist_cols not provided", {
843+
expect_error(
844+
spec_type_to_codelist(spec, codelist_cols = NULL),
845+
regexp = "Codelist column names must be provided as `codelist_cols`"
846+
)
847+
})
848+
849+
test_that("spec_type_to_codelist errors on bad codelist_cols names", {
850+
expect_error(
851+
spec_type_to_codelist(spec, codelist_cols = c("bad" = "ID")),
852+
regexp = "Incorrect column names supplied for `codelist_cols`"
853+
)
854+
})
855+
856+
test_that("spec_type_to_codelist errors on unnamed codelist_cols", {
857+
expect_error(
858+
spec_type_to_codelist(spec, codelist_cols = c("ID", "Name")),
859+
regexp = "Incorrect column names supplied for `codelist_cols`"
860+
)
861+
})
862+
863+
test_that("spec_type_to_codelist errors on bad permitted_val_cols names", {
864+
expect_error(
865+
spec_type_to_codelist(
866+
spec,
867+
permitted_val_cols = c("bad" = "^Code|^Term")
868+
),
869+
regexp = "Incorrect column names supplied for `permitted_val_cols`"
870+
)
871+
})
872+
873+
test_that("spec_type_to_codelist errors on bad dict_cols names", {
874+
expect_error(
875+
spec_type_to_codelist(
876+
spec,
877+
dict_cols = c("bad" = "ID")
878+
),
879+
regexp = "Incorrect column names supplied for `dict_cols`"
880+
)
881+
})
882+
883+
# spec_type_to_derivations var_cols validation --------------------------------
884+
885+
test_that("spec_type_to_derivations errors on bad var_cols names", {
886+
expect_error(
887+
spec_type_to_derivations(spec, var_cols = c("bad" = "[D|d]ataset")),
888+
regexp = "Incorrect column names supplied for `var_cols`"
889+
)
890+
})
891+
892+
test_that("spec_type_to_derivations errors on unnamed var_cols", {
893+
expect_error(
894+
spec_type_to_derivations(spec, var_cols = c("[D|d]ataset", "[V|v]ariable")),
895+
regexp = "Incorrect column names supplied for `var_cols`"
896+
)
897+
})

0 commit comments

Comments
 (0)