# Tests for read_spec() (native JSON + Pinnacle 21 Excel). # ---- Native JSON round-trip (F1) ---------------------------------------- test_that("read_spec() round-trips a spec through JSON identically (F1)", { spec <- artoo_spec( cdisc_adam_datasets, cdisc_adam_variables, codelists = cdisc_codelists ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) expect_identical(read_spec(p), spec) }) test_that("read_spec() round-trips value-level and study slots (F1)", { vlm <- data.frame( dataset = "ADSL", variable = "PARAMCD", where_clause = "PARAMCD EQ HEIGHT", label = "Height", stringsAsFactors = FALSE ) spec <- artoo_spec( cdisc_adam_datasets, cdisc_adam_variables, codelists = cdisc_codelists, study = data.frame(studyid = "CDISCPILOT01"), values = vlm ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) back <- read_spec(p) expect_identical(back, spec) expect_s3_class(back@values, "data.frame") }) test_that("artoo_spec() demotes a tibble value-level table to plain df (H2)", { skip_if_not_installed("tibble") vlm <- tibble::tibble(dataset = "ADSL", variable = "PARAMCD", label = "L") spec <- artoo_spec( cdisc_adam_datasets, cdisc_adam_variables, codelists = cdisc_codelists, values = vlm ) expect_s3_class(spec@values, "data.frame") expect_false(inherits(spec@values, "tbl_df")) }) test_that("read_spec() preserves non-ASCII labels and empty strings (H8)", { vars <- data.frame( dataset = "DM", variable = c("A", "B"), data_type = c("string", "string"), label = c("Naïve label", ""), stringsAsFactors = FALSE ) spec <- artoo_spec(data.frame(dataset = "DM"), vars) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) back <- read_spec(p) lbl <- back@variables$label expect_identical(lbl[back@variables$variable == "A"], "Naïve label") expect_identical(lbl[back@variables$variable == "B"], "") }) test_that("read_spec() reconstructs empty optional slots", { spec <- artoo_spec( data.frame(dataset = "DM"), data.frame(dataset = "DM", variable = "AGE", data_type = "integer") ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) back <- read_spec(p) expect_identical(back, spec) expect_null(back@values) expect_equal(nrow(back@codelists), 0L) }) test_that("read_spec() warns on an unrecognised version but still reads (H10)", { spec <- artoo_spec( data.frame(dataset = "DM"), data.frame(dataset = "DM", variable = "AGE", data_type = "integer") ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) txt <- gsub( '("artoo_spec_version":\\s*)"1"', '\\1"99"', readLines(p) ) writeLines(txt, p) expect_warning(s <- read_spec(p), class = "artoo_warning_spec") expect_true(is_artoo_spec(s)) }) test_that("read_spec() rejects bad paths and unsupported extensions", { expect_error(read_spec(42), class = "artoo_error_input") expect_error(read_spec("does-not-exist.json"), class = "artoo_error_input") tmp <- withr::local_tempfile(fileext = ".csv") file.create(tmp) expect_error(read_spec(tmp), class = "artoo_error_input") expect_snapshot(read_spec(tmp), error = TRUE) }) # ---- Pinnacle 21 Excel (integration, committed fixture) ----------------- test_that("read_spec() ingests a P21 Excel spec with merged cells", { skip_if_not_installed("readxl") spec <- read_spec(test_path("fixtures", "p21_adam_spec.xlsx")) expect_true(is_artoo_spec(spec)) expect_setequal(spec_datasets(spec), c("ADSL", "DM")) v <- spec_variables(spec) # H4: the merged Dataset column is forward-filled to continuation rows. expect_identical(v$dataset[v$variable == "AGE"], "ADSL") expect_identical( unique(v$dataset[v$variable == "USUBJID" & v$dataset == "DM"]), "DM" ) # H1: a Define-XML partialDatetime canonicalises to datetime. expect_identical(v$data_type[v$variable == "TRTSDTM"], "datetime") # H6: a space-padded codelist id is trimmed and resolves. expect_identical( v$codelist_id[v$variable == "SEX" & v$dataset == "ADSL"], "C66731" ) # Mandatory "Yes" coerces to TRUE. expect_true(v$mandatory[v$variable == "STUDYID"][1]) }) test_that("read_spec() recovers all terms of a merged-id codelist (H4/H5)", { skip_if_not_installed("readxl") spec <- read_spec(test_path("fixtures", "p21_adam_spec.xlsx")) cl <- spec_codelists(spec, "C66731") expect_setequal(cl$term, c("F", "M", "U")) expect_setequal(cl$decode, c("Female", "Male", "Unknown")) }) test_that("read_spec() populates methods/comments/documents slots", { skip_if_not_installed("readxl") spec <- read_spec(test_path("fixtures", "p21_adam_spec.xlsx")) # Trailing blank-key method row is dropped (H4): MT.TRTSDTM + MT.DM only. expect_setequal(spec_methods(spec)$method_id, c("MT.TRTSDTM", "MT.DM")) expect_identical(spec_comments(spec)$comment_id, "C.BLANK") expect_identical(spec_documents(spec)$document_id, "DOC.SAP") # FK columns mapped onto variables. v <- spec_variables(spec) expect_identical(v$method_id[v$variable == "TRTSDTM"], "MT.TRTSDTM") expect_identical( v$method_id[v$variable == "USUBJID" & v$dataset == "DM"], "MT.DM" ) # The DM method carries a blank description (a crafted defect). m <- spec_methods(spec) expect_true(is.na(m$description[m$method_id == "MT.DM"])) }) test_that("read_spec() round-trips the new slots through JSON (F1)", { spec <- artoo_spec( data.frame(dataset = "ADSL"), data.frame( dataset = "ADSL", variable = "AGEGR1", data_type = "string", method_id = "MT.AGEGR1", stringsAsFactors = FALSE ), methods = data.frame( method_id = "MT.AGEGR1", description = "Age group from AGE.", stringsAsFactors = FALSE ), comments = data.frame( comment_id = "C1", description = "A note.", stringsAsFactors = FALSE ), documents = data.frame( document_id = "SAP", title = "SAP", href = "sap.pdf", stringsAsFactors = FALSE ) ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) expect_identical(read_spec(p), spec) }) test_that("read_spec() pivots the P21 Define sheet into a study row", { skip_if_not_installed("readxl") spec <- read_spec(test_path("fixtures", "p21_adam_spec.xlsx")) # The sheet's verbatim StudyName attribute lands as the canonical field. expect_identical(spec_study(spec, "study_name"), "CDISCPILOT01") }) # ---- P21 internals (fast unit tests of the hardening branches) ---------- test_that(".match_p21_sheet resolves spelling and spacing variants (H3)", { al <- artoo:::.p21_sheet_aliases$variables expect_identical( artoo:::.match_p21_sheet("Variable Level Metadata", al), "Variable Level Metadata" ) expect_identical(artoo:::.match_p21_sheet("VARIABLES", al), "VARIABLES") expect_null(artoo:::.match_p21_sheet("Datasets", al)) }) test_that(".fill_down leaves a leading NA, and .check_filled fails loud (H4)", { df <- data.frame( dataset = c(NA, "ADSL", NA), variable = c("A", "B", "C"), stringsAsFactors = FALSE ) filled <- artoo:::.fill_down(df, "dataset") expect_identical(filled$dataset, c(NA, "ADSL", "ADSL")) expect_error( artoo:::.check_filled(filled, "dataset", "Variables", rlang::current_env()), class = "artoo_error_spec" ) }) test_that(".require_p21_sheet errors on an absent or empty required sheet (H7)", { expect_error( artoo:::.require_p21_sheet( NULL, NULL, "Datasets", "X", rlang::current_env() ), class = "artoo_error_spec" ) expect_error( artoo:::.require_p21_sheet( data.frame(), "Datasets", "Datasets", "Datasets", rlang::current_env() ), class = "artoo_error_spec" ) }) # ---- .match_p21_sheet alias resolution ---------------------------------- test_that(".match_p21_sheet informs when several sheets match one role", { expect_message( used <- artoo:::.match_p21_sheet(c("Datasets", "datasets "), "datasets"), class = "artoo_message_p21_sheet" ) # The first match wins; the inform names it. expect_identical(used, "Datasets") expect_snapshot( invisible(artoo:::.match_p21_sheet(c("Datasets", "datasets "), "datasets")) ) }) test_that(".match_p21_sheet returns NULL when nothing matches", { expect_null(artoo:::.match_p21_sheet(c("Foo", "Bar"), "datasets")) }) test_that(".match_p21_sheet on a single match is silent", { expect_no_message( used <- artoo:::.match_p21_sheet(c("Variables", "Datasets"), "datasets") ) expect_identical(used, "Datasets") }) # ---- datasets = scoping + on_duplicate (read-time hardening) ---------------- test_that("read_spec(datasets=) scopes a native JSON spec to one dataset", { # The bundled SDTM spec spans four datasets (one standard), so scoping # to DM genuinely narrows it. p <- withr::local_tempfile(fileext = ".json") write_spec(sdtm_spec, p) dm_only <- read_spec(p, datasets = "DM") expect_identical(spec_datasets(dm_only), "DM") expect_identical(unique(spec_variables(dm_only)$dataset), "DM") }) test_that("read_spec(datasets=) rejects an unknown dataset, listing what exists", { spec <- artoo_spec( cdisc_sdtm_datasets, cdisc_sdtm_variables, codelists = cdisc_codelists ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) expect_error(read_spec(p, datasets = "ADAE"), class = "artoo_error_input") expect_snapshot(error = TRUE, read_spec(p, datasets = "ADAE")) expect_error(read_spec(p, datasets = 1L), class = "artoo_error_input") }) test_that("read_spec(datasets=) scopes a P21 workbook", { skip_if_not_installed("readxl") p <- test_path("fixtures", "p21_adam_spec.xlsx") suppressMessages(dm_only <- read_spec(p, datasets = "DM")) expect_identical(spec_datasets(dm_only), "DM") }) # A native JSON spec with one variable defined twice (hand-built: the # artoo_spec() constructor itself refuses duplicates, which is the point). .dup_spec_json <- function() { # The bundled SDTM spec spans four domains, so a duplicate confined to DM # can coexist with clean domains for the scoping test below. p <- withr::local_tempfile(fileext = ".json", .local_envir = parent.frame()) write_spec(sdtm_spec, p) raw <- jsonlite::fromJSON(p, simplifyDataFrame = TRUE) v <- raw$variables dup <- v[v$dataset == "DM" & v$variable == "SEX", , drop = FALSE] raw$variables <- rbind(v, dup) jsonlite::write_json(raw, p, auto_unbox = TRUE, null = "null", na = "null") p } test_that("a duplicated variable aborts at read with its row locations", { p <- .dup_spec_json() expect_error(read_spec(p), class = "artoo_error_spec") err <- tryCatch(read_spec(p), error = function(e) conditionMessage(e)) # The message names the locations and the offending variable. expect_match(paste(err, collapse = " "), "DM.SEX") expect_match(paste(err, collapse = " "), "rows") }) test_that("on_duplicate = 'first' keeps the first definition", { p <- .dup_spec_json() spec <- suppressMessages(read_spec(p, on_duplicate = "first")) v <- spec_variables(spec, "DM") expect_identical(sum(v$variable == "SEX"), 1L) }) test_that("on_duplicate = 'warn' keeps the first definition and warns", { p <- .dup_spec_json() expect_warning( spec <- read_spec(p, on_duplicate = "warn"), class = "artoo_warning_spec" ) expect_identical(sum(spec_variables(spec, "DM")$variable == "SEX"), 1L) }) test_that("scoping runs before the duplicate guard (broken domain elsewhere)", { # The dogfood scenario: a duplicate confined to one domain must not block # reading a different, clean domain. p <- .dup_spec_json() # duplicate lives in DM vs_only <- read_spec(p, datasets = "VS") expect_identical(spec_datasets(vs_only), "VS") }) test_that(".resolve_duplicate_variables reports source rows (Excel-style)", { vars <- data.frame( dataset = c("ADCM", "ADCM", "ADCM"), variable = c("STUDYID", "TRTP", "STUDYID"), stringsAsFactors = FALSE ) err <- tryCatch( artoo:::.resolve_duplicate_variables( vars, "error", where = "Sheet 'Variables'", rows = c(276L, 277L, 280L) ), error = function(e) conditionMessage(e) ) expect_match( paste(err, collapse = " "), "Sheet 'Variables' rows 276 and 280 all define ADCM.STUDYID", fixed = TRUE ) }) # ---- Regression: spec round-trip + codelist scoping (code review 2026-06-14) ---- test_that("an all-NA value-level column round-trips as character, not logical", { vlm <- data.frame( dataset = "ADSL", variable = "PARAMCD", label = "Height", method_id = NA_character_, stringsAsFactors = FALSE ) spec <- artoo_spec( cdisc_adam_datasets, cdisc_adam_variables, codelists = cdisc_codelists, values = vlm ) p <- withr::local_tempfile(fileext = ".json") write_spec(spec, p) back <- read_spec(p) # Pre-fix the all-NA method_id came back logical, so identical() failed. expect_identical(class(back@values$method_id), "character") expect_identical(back, spec) }) test_that(".scope_codelists rejects a term that resolves to no codelist", { # A first-row term with a blank id (the merged-cell fill cannot reach row 1). bad <- data.frame( codelist_id = c(NA_character_, "CL.SEX"), term = c("MALE", "FEMALE"), stringsAsFactors = FALSE ) expect_error(artoo:::.scope_codelists(bad), class = "artoo_error_spec") # A list-header row (id present, term blank) is dropped, not an error. ok <- data.frame( codelist_id = c("CL.SEX", "CL.SEX"), term = c("", "FEMALE"), stringsAsFactors = FALSE ) expect_identical(nrow(artoo:::.scope_codelists(ok)), 1L) })