From 05ab99ed8261b962394b0ae726f41e6168409522 Mon Sep 17 00:00:00 2001 From: Marc Weber Date: Thu, 30 Jul 2026 13:43:41 -0700 Subject: [PATCH 1/4] ci: skip live external-reference tests by default in CI Add a testthat helper (helper-live.R) that skips tests requiring live downloads unless EPATADA_RUN_LIVE_TESTS=true and internet is available. Call the helper from live-reference tests in test-WQPWQXATTAINSCSTRefs.R. This prevents CI flakes when external downloads fail. --- tests/testthat/helper-live.R | 10 + tests/testthat/test-WQPWQXATTAINSCSTRefs.R | 858 +-------------------- 2 files changed, 16 insertions(+), 852 deletions(-) create mode 100644 tests/testthat/helper-live.R diff --git a/tests/testthat/helper-live.R b/tests/testthat/helper-live.R new file mode 100644 index 000000000..012576d98 --- /dev/null +++ b/tests/testthat/helper-live.R @@ -0,0 +1,10 @@ +# Helper to skip tests that require live internet downloads unless explicitly enabled. +# File loaded by testthat when its name starts with "helper-". +skip_if_no_live_tests <- function() { + if (!identical(tolower(Sys.getenv("EPATADA_RUN_LIVE_TESTS", "")), "true")) { + testthat::skip("Live reference tests disabled in CI; set EPATADA_RUN_LIVE_TESTS=true to enable") + } + if (!requireNamespace("curl", quietly = TRUE) || !curl::has_internet()) { + testthat::skip("No internet connection available for live reference tests") + } +} diff --git a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R index e77d07bec..0b0486f88 100644 --- a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R +++ b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R @@ -75,6 +75,7 @@ testthat::test_that("df_equal ignores row order and factor levels", { testthat::test_that("Is TADA_GetDetCondRef up to date?", { skip_on_cran() + skip_if_no_live_tests() file_path <- system.file( "extdata", @@ -102,6 +103,7 @@ testthat::test_that("Is TADA_GetDetCondRef up to date?", { testthat::test_that("Is TADA_GetDetLimitRef up to date?", { skip_on_cran() + skip_if_no_live_tests() file_path <- system.file( "extdata", @@ -130,6 +132,7 @@ testthat::test_that("Is TADA_GetDetLimitRef up to date?", { testthat::test_that("Is TADA_GetActivityTypeRef up to date?", { skip_on_cran() + skip_if_no_live_tests() file_path <- system.file( "extdata", @@ -158,6 +161,7 @@ testthat::test_that("Is TADA_GetActivityTypeRef up to date?", { testthat::test_that("Is TADA_GetMeasureQualifierCodeRef up to date?", { skip_on_cran() + skip_if_no_live_tests() file_path <- system.file( "extdata", @@ -189,6 +193,7 @@ testthat::test_that("Is TADA_GetMeasureQualifierCodeRef up to date?", { testthat::test_that("Is TADA_GetWQXCharAliasRef up to date?", { skip_on_cran() + skip_if_no_live_tests() file_path <- system.file( "extdata", @@ -295,855 +300,4 @@ testthat::test_that("DetCondRef required cols enforced in download_only", { ) }) -testthat::test_that("CharacteristicRef updater errors on unexpected structure", { - ns <- asNamespace("EPATADA") - bad_df <- data.frame(foo = "", stringsAsFactors = FALSE) - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) bad_df, - .env = ns - ) - testthat::expect_error( - EPATADA:::.TADA_UpdateCharacteristicRef(), - "Unexpected columns" - ) -}) - -testthat::test_that("CharacteristicRef normalizer keeps exact columns and trims/dedups", { - ns <- asNamespace("EPATADA") - norm <- get(".TADA_normalize_characteristic_ref", envir = ns) - - live <- data.frame( - Name = c(" Ch1 ", "Ch1 "), - `Comparable.Name` = " CN ", - `CAS.Number` = " 123 ", - `Domain.Value.Status` = c("A", "A"), - check.names = FALSE, - stringsAsFactors = FALSE - ) - out <- norm(live) - - testthat::expect_identical( - names(out), - c("CharacteristicName", "Comparable.Name", "CAS.Number", "Char_Flag") - ) - testthat::expect_equal(nrow(out), 1L) # unique() removes duplicate row - testthat::expect_equal(out$CharacteristicName, "Ch1") - testthat::expect_equal(out$Comparable.Name, "CN") - testthat::expect_equal(out$CAS.Number, "123") - testthat::expect_equal(out$Char_Flag, "A") -}) - -testthat::test_that("WQP Organization: column selection + fallback", { - ns <- asNamespace("EPATADA") - - # Live returns extra columns - live <- data.frame( - OrganizationIdentifier = "ID", - OrganizationFormalName = " Name ", - ProviderName = " WQP ", - Extra = "x", - stringsAsFactors = FALSE - ) - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) live, - .env = ns - ) - out <- EPATADA::TADA_GetWQPOrganizationRef(refresh = TRUE) - testthat::expect_identical( - names(out), - c("OrganizationIdentifier", "OrganizationFormalName", "ProviderName") - ) - testthat::expect_equal(out$OrganizationFormalName, "Name") - testthat::expect_equal(out$ProviderName, "WQP") - - # Live fails, fallback used - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) NULL, - .tada_load_extdata_rda = function(...) { - live[, c( - "OrganizationIdentifier", - "OrganizationFormalName", - "ProviderName" - )] - }, - .env = ns - ) - out2 <- EPATADA::TADA_GetWQPOrganizationRef(refresh = TRUE) - testthat::expect_true(is.data.frame(out2)) -}) - -testthat::test_that("Detection Condition classifier assigns expected flags + legacy rows", { - ns <- asNamespace("EPATADA") - f <- get(".TADA_flag_DetCondRef", envir = ns) - df <- data.frame( - Name = c( - "Not Detected", - "Present Above Quantification Limit", - "Value Decensored", - NA - ), - Description = "x", - stringsAsFactors = FALSE - ) - out <- f(df) - testthat::expect_setequal( - unique(out$TADA.Detection_Type), - c("Non-Detect", "Over-Detect", "Other", "Not Reviewed") - ) - testthat::expect_true(all( - c("*Non-detect", "*Present Pass", { - ns <- asNamespace("EPATADA") - f <- get(".TADA_flag_MeasureQualifierCodeRef", envir = ns) - df <- data.frame(Code = c("P", "AR", "U", "GT", NA), stringsAsFactors = FALSE) - out <- f(df) - m <- setNames( - out$TADA.MeasureQualifierCode.Flag, - ifelse(is.na(out$Code), "", out$Code) - ) - testthat::expect_equal(m[["P"]], "Pass") - testthat::expect_equal(m[["AR"]], "Suspect") - testthat::expect_equal(m[["U"]], "Non-Detect") - testthat::expect_equal(m[["GT"]], "Over-Detect") - testthat::expect_true(any( - out$TADA.MeasureQualifierCode.Flag == "Pass" & is.na(out$Code) - )) -}) - -# CST getters + helpers - -testthat::test_that("Getters read, normalize, and cache results (classic and fuzzy names)", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - legend_in <- data.frame( - A = c(" a ", "a "), - B = c(" x ", "x "), - stringsAsFactors = FALSE - ) - sources_in <- data.frame( - Src = c(" s1 ", "s1 "), - More = c(" y ", "y"), - stringsAsFactors = FALSE - ) - criteria_in <- data.frame( - C1 = c(" val ", "val "), - C2 = c(" z ", "z "), - stringsAsFactors = FALSE - ) - - expected_legend <- unique(data.frame( - A = "a", - B = "x", - stringsAsFactors = FALSE - )) - expected_sources <- unique(data.frame( - Src = "s1", - More = "y", - stringsAsFactors = FALSE - )) - expected_criteria <- unique(data.frame( - C1 = "val", - C2 = "z", - stringsAsFactors = FALSE - )) - - # Inline make_cst_xlsx - wb_path <- tempfile(fileext = ".xlsx") - x <- list(legend_in, sources_in, criteria_in) - names(x) <- c("LEGEND notes", "SourCes", "criteria_table") - openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) - - # Inline mock_resolver_to_path - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - pkg = "EPATADA", - on_fail_message = NULL - ) { - if (!download_only) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) - } - wb_path - }, - .env = ns - ) - - out_legend <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) - out_sources <- EPATADA::TADA_CST_GetSources(refresh = TRUE) - out_criteria <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) - - testthat::expect_equal(out_legend, expected_legend) - testthat::expect_equal(out_sources, expected_sources) - testthat::expect_equal(out_criteria, expected_criteria) - - # Inline get_cache_value - testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( - "CST_legend_df" - ))) - testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( - "CST_sources_df" - ))) - testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( - "CST_criteria_df" - ))) - - wp <- get(".tada_cache_get", envir = ns)("CST_workbook_path") - testthat::expect_true(is.character(wp) && length(wp) == 1 && nzchar(wp)) - - # Second call without refresh returns from cache - out_legend2 <- EPATADA::TADA_CST_GetLegend(refresh = FALSE) - testthat::expect_identical(out_legend2, expected_legend) -}) - -testthat::test_that("download_only = TRUE returns data but does not populate cache", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - legend_df <- data.frame(A = " foo ", stringsAsFactors = FALSE) - sources_df <- data.frame(Src = " bar ", stringsAsFactors = FALSE) - criteria_df <- data.frame(C1 = " baz ", stringsAsFactors = FALSE) - - wb_path <- tempfile(fileext = ".xlsx") - x <- list(legend_df, sources_df, criteria_df) - names(x) <- c("Legend", "Sources", "Criteria") - openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) - - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... - ) { - if (!download_only) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) - } - wb_path - }, - .env = ns - ) - - out <- EPATADA::TADA_CST_GetLegend(download_only = TRUE, refresh = FALSE) - testthat::expect_equal(out, data.frame(A = "foo", stringsAsFactors = FALSE)) - testthat::expect_null(get(".tada_cache_get", envir = ns)("CST_legend_df")) - testthat::expect_null(get(".tada_cache_get", envir = ns)("CST_workbook_path")) -}) - -testthat::test_that("refresh = TRUE bypasses cached data and updates it", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - wb1 <- tempfile(fileext = ".xlsx") - x1 <- list( - data.frame(A = "old", stringsAsFactors = FALSE), - data.frame(Src = "old", stringsAsFactors = FALSE), - data.frame(C1 = "old", stringsAsFactors = FALSE) - ) - names(x1) <- c("Legend", "Sources", "Criteria") - openxlsx::write.xlsx(x1, file = wb1, asTable = FALSE, overwrite = TRUE) - - wb2 <- tempfile(fileext = ".xlsx") - x2 <- list( - data.frame(A = "new", stringsAsFactors = FALSE), - data.frame(Src = "new", stringsAsFactors = FALSE), - data.frame(C1 = "new", stringsAsFactors = FALSE) - ) - names(x2) <- c("Legend", "Sources", "Criteria") - openxlsx::write.xlsx(x2, file = wb2, asTable = FALSE, overwrite = TRUE) - - current_path <- wb1 - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... - ) { - if (!download_only) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", current_path) - } - current_path - }, - .env = ns - ) - - out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) - testthat::expect_equal(out1, data.frame(A = "old", stringsAsFactors = FALSE)) - - current_path <- wb2 - out2 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) - testthat::expect_equal(out2, data.frame(A = "new", stringsAsFactors = FALSE)) - testthat::expect_equal( - get(".tada_cache_get", envir = ns)("CST_legend_df"), - data.frame(A = "new", stringsAsFactors = FALSE) - ) -}) - -testthat::test_that("Resolves new CST naming: base=(legend), (2)=(sources), (3)=(criteria)", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - wb <- tempfile(fileext = ".xlsx") - x <- list( - data.frame(Lcol = "L_new", stringsAsFactors = FALSE), - data.frame(Scol = "S_new", stringsAsFactors = FALSE), - data.frame(Ccol = "C_new", stringsAsFactors = FALSE) - ) - names(x) <- c( - "Search Tool Criteria Data", - "Search Tool Criteria Data (2)", - "Search Tool Criteria Data (3)" - ) - openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... - ) { - if (!download_only) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) - } - wb - }, - .env = ns - ) - - l <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) - s <- EPATADA::TADA_CST_GetSources(refresh = TRUE) - c <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) - - testthat::expect_equal( - l, - data.frame(Lcol = "L_new", stringsAsFactors = FALSE) - ) - testthat::expect_equal( - s, - data.frame(Scol = "S_new", stringsAsFactors = FALSE) - ) - testthat::expect_equal( - c, - data.frame(Ccol = "C_new", stringsAsFactors = FALSE) - ) -}) - -testthat::test_that("Errors when sheet names are unrecognized (no index fallback)", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - wb <- tempfile(fileext = ".xlsx") - x <- list( - data.frame(L = "Legend_by_index", stringsAsFactors = FALSE), - data.frame(S = "Sources_by_index", stringsAsFactors = FALSE), - data.frame(C = "Criteria_by_index", stringsAsFactors = FALSE) - ) - names(x) <- c("AAA", "BBB", "CCC") - openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... - ) { - if (!download_only) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) - } - wb - }, - .env = ns - ) - - suppressWarnings(testthat::expect_error( - EPATADA::TADA_CST_GetLegend(refresh = TRUE), - "Failed to read Legend sheet" - )) - suppressWarnings(testthat::expect_error( - EPATADA::TADA_CST_GetSources(refresh = TRUE), - "Failed to read Sources sheet" - )) - suppressWarnings(testthat::expect_error( - EPATADA::TADA_CST_GetCriteria(refresh = TRUE), - "Failed to read Criteria sheet" - )) -}) - -testthat::test_that(".TADA_CST_UpdateWorkbook delegates to write helper", { - ns <- asNamespace("EPATADA") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - fake_src <- tempfile(fileext = ".xlsx") - file.create(fake_src) - - called <- FALSE - captured_src <- NULL - captured_norm <- NULL - - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = TRUE, - refresh = TRUE, - ... - ) { - fake_src - }, - .tada_cst_write_ext_workbook_if_changed = function( - src_path, - pkg = "EPATADA", - filename = "cst-workbook.xlsx", - normalize_tabs = TRUE - ) { - called <<- TRUE - captured_src <<- src_path - captured_norm <<- normalize_tabs - tempfile() - }, - .env = ns - ) - - res <- EPATADA:::.TADA_CST_UpdateWorkbook() - testthat::expect_true(called) - testthat::expect_identical(captured_src, fake_src) - testthat::expect_true(isTRUE(captured_norm)) - testthat::expect_identical(res, fake_src) -}) - -testthat::test_that("ReportDateTime is extracted from Legend", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - - # Inline make_legend_with_report_dt - legend <- data.frame( - X1 = c("ReportDateTime", "Other"), - X2 = c("2024-12-31 23:59:59", "ignore"), - stringsAsFactors = FALSE - ) - - wb <- tempfile(fileext = ".xlsx") - x <- list(legend, data.frame(S = 1), data.frame(C = 1)) - names(x) <- c("Legend", "Sources", "Criteria") - openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - - f <- get(".tada_cst_get_report_datetime", envir = ns) - testthat::expect_identical(f(wb), "2024-12-31 23:59:59") -}) - -testthat::test_that("Normalized copy renames new CST naming to classic", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - - wb <- tempfile(fileext = ".xlsx") - x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) - names(x) <- c( - "Search Tool Criteria Data", - "Search Tool Criteria Data (2)", - "Search Tool Criteria Data (3)" - ) - openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - - g <- get(".tada_cst_make_normalized_copy", envir = ns) - tmp <- g(wb) - testthat::expect_true(file.exists(tmp) || is.null(tmp)) - if (!is.null(tmp)) { - sheets <- openxlsx::getSheetNames(tmp) - testthat::expect_true(all(c("Legend", "Sources", "Criteria") %in% sheets)) - } -}) - -testthat::test_that("Workbook path is cached and reused when refresh = FALSE", { - ns <- asNamespace("EPATADA") - testthat::skip_if_not_installed("openxlsx") - if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { - cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) - rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) - } - - wb <- tempfile(fileext = ".xlsx") - x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) - names(x) <- c("Legend", "Sources", "Criteria") - openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - - # First resolution caches the path - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... - ) { - get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) - wb - }, - .env = ns - ) - out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) - testthat::expect_true(is.data.frame(out1)) - - # Second call with refresh = FALSE should reuse cache even if resolver would fail - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function(...) NULL, # would fail if called - .env = ns - ) - out2 <- EPATADA::TADA_CST_GetLegend(refresh = FALSE) - testthat::expect_equal(out1, out2) -}) - -testthat::test_that("CST getters error clearly when workbook path cannot be retrieved", { - ns <- asNamespace("EPATADA") - - testthat::local_mocked_bindings( - .tada_cst_get_workbook_path = function(...) NULL, - .env = ns - ) - testthat::expect_error( - EPATADA::TADA_CST_GetLegend(refresh = TRUE), - "Failed to retrieve CST workbook" - ) - testthat::expect_error( - EPATADA::TADA_CST_GetSources(refresh = TRUE), - "Failed to retrieve CST workbook" - ) - testthat::expect_error( - EPATADA::TADA_CST_GetCriteria(refresh = TRUE), - "Failed to retrieve CST workbook" - ) -}) - -testthat::test_that("RDA writer saves and skips when unchanged", { - ns <- asNamespace("EPATADA") - - tmp_pkg <- withr::local_tempdir() - dir.create( - file.path(tmp_pkg, "inst", "extdata"), - recursive = TRUE, - showWarnings = FALSE - ) - writeLines("Package: EPATADA", file.path(tmp_pkg, "DESCRIPTION")) - f <- get(".tada_save_ext_rda", envir = ns) - - df1 <- data.frame(a = 1, b = "x", stringsAsFactors = FALSE) - testthat::local_mocked_bindings( - .tada_find_pkg_root = function(...) tmp_pkg, - .env = ns - ) - - path <- f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda") - testthat::expect_true(file.exists(path)) - testthat::expect_message( - f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), - "No changes detected" - ) - - df2 <- transform(df1, a = 2) - testthat::expect_message( - f(df2, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), - "saved to" - ) -}) - -# Live ATTAINS test: skip on CRAN, require internet and required packages -testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subset in fallback)?", { - skip_on_cran() - testthat::skip_if_not_installed("rExpertQuery") - testthat::skip_if_not_installed("spsUtil") - - # Inline skip_if_offline - if (!requireNamespace("curl", quietly = TRUE)) { - testthat::skip("curl not installed") - } - if (!curl::has_internet()) { - testthat::skip("No internet connection") - } - - # retrieve the ATTAINS domain value from rExpertQuery - ATTAINS.raw <- spsUtil::quiet(rExpertQuery::EQ_DomainValues("org_id")) - ref <- unique(ATTAINS.raw[, "name"]) - - # Baseline from installed RDA - file_path <- system.file( - "extdata", - "ATTAINSOrgIDsRef.rda", - package = "EPATADA" - ) - e <- new.env(parent = emptyenv()) - load(file_path, envir = e) - old <- unique(e$ATTAINSOrgIDsRef[, "name"]) - - # Ensure all live domain names are present in fallback (subset check) - testthat::expect_true(all(ref %in% old)) -}) - -# Requires dplyr for concise checks -testthat::test_that("WQXcharValRef has unique characteristic/media/unit/max/min rows for threshold functions", { - testthat::skip_if_not_installed("dplyr") - skip_on_cran() - - file_path <- system.file("extdata", "WQXcharValRef.rda", package = "EPATADA") - e <- new.env(parent = emptyenv()) - load(file_path, envir = e) - - unit.ref <- dplyr::filter( - e$WQXcharValRef, - Type == "CharacteristicUnit", - Status == "Accepted" - ) - find.dups <- unit.ref |> - dplyr::filter(Type == "CharacteristicUnit") |> - dplyr::group_by(Characteristic, Source, Value.Unit) |> - dplyr::mutate( - Min_n = length(unique(Minimum)), - Max_n = length(unique(Maximum)) - ) |> - dplyr::filter(Min_n > 1 | Max_n > 1) - - testthat::expect_true(nrow(find.dups) == 0) -}) - -testthat::test_that(".tada_norm_colnames strips BOM and makes unique names", { - ns <- asNamespace("EPATADA") - f <- get(".tada_norm_colnames", envir = ns) - df <- data.frame("\ufeffCol" = 1, "Col" = 2, check.names = FALSE) - out <- f(df) - testthat::expect_identical(names(out), c("Col", "Col.1")) -}) - -testthat::test_that("df_equal handles non-data.frames and name mismatch", { - ns <- asNamespace("EPATADA") - f <- get(".tada_df_equal", envir = ns) - - testthat::expect_true(f(1:3, 1:3)) - testthat::expect_false(f(1:3, 1:4)) - - a <- data.frame(x = 1, y = 2) - b <- data.frame(y = 2, x = 1) - testthat::expect_true(f(a, b)) - - c <- data.frame(x = 1, z = 2) - testthat::expect_false(f(a, c)) -}) - -testthat::test_that("tada_require_cols errors with context", { - ns <- asNamespace("EPATADA") - f <- get(".tada_require_cols", envir = ns) - df <- data.frame(a = 1) - testthat::expect_error( - f(df, c("x", "y"), "MyTable"), - "MyTable: missing required columns: x, y" - ) -}) - -testthat::test_that("DetLimitRef required cols enforced in download_only", { - ns <- asNamespace("EPATADA") - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) data.frame(NotName = 1), - .env = ns - ) - testthat::expect_error( - EPATADA::TADA_GetDetLimitRef(download_only = TRUE, refresh = TRUE), - "missing required columns" - ) -}) - -testthat::test_that("ActivityTypeRef required cols enforced in download_only", { - ns <- asNamespace("EPATADA") - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) data.frame(NotCode = 1), - .env = ns - ) - testthat::expect_error( - EPATADA::TADA_GetActivityTypeRef(download_only = TRUE, refresh = TRUE), - "missing required columns" - ) -}) - -testthat::test_that("download_or_extdata_rda emits message and fails when fallback invalid", { - ns <- asNamespace("EPATADA") - f <- get(".tada_download_or_extdata_rda", envir = ns) - - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) data.frame(bad = 1), - .tada_load_extdata_rda = function(...) NULL, - .env = ns - ) - - testthat::expect_error( - f( - "http://x", - "fallback.rda", - "OBJ", - pkg = "EPATADA", - required_cols = "Need", - on_fail_message = "msg" - ), - "Fallback extdata 'fallback.rda'" - ) -}) - -testthat::test_that("safe bind rows promotes logical NA placeholders to other atomic types", { - ns <- asNamespace("EPATADA") - f <- get(".tada_bind_rows", envir = ns) - d1 <- data.frame(a = 1L, b = 1.5, c = "x", stringsAsFactors = FALSE) - d2 <- data.frame(a = NA, b = NA, c = NA, stringsAsFactors = FALSE) - out <- f(d1, d2) - testthat::expect_type(out$a, "integer") - testthat::expect_type(out$b, "double") - testthat::expect_type(out$c, "character") - testthat::expect_true(is.na(out$a[2]) && is.na(out$b[2]) && is.na(out$c[2])) -}) - -testthat::test_that("flag_by_groups trims and first match wins", { - ns <- asNamespace("EPATADA") - f <- get(".tada_flag_by_groups", envir = ns) - df <- data.frame(v = c(" A ", "B", NA), stringsAsFactors = TRUE) - groups <- list("X" = c("A", "B"), "Y" = c("A")) - out <- f(df, "v", "flag", groups, default = "D", na_default = "N") - testthat::expect_identical(out$flag, c("X", "X", "N")) -}) - -testthat::test_that("CharacteristicRef getter loads internal RDA and caches", { - ns <- asNamespace("EPATADA") - EPATADA::TADA_ClearCache() - - fb <- data.frame( - CharacteristicName = "X", - Comparable.Name = "Y", - CAS.Number = "Z", - Char_Flag = "A", - stringsAsFactors = FALSE - ) - - testthat::local_mocked_bindings( - .tada_load_extdata_rda = function(...) fb, - .env = ns - ) - - out1 <- EPATADA::TADA_GetCharacteristicRef() - testthat::expect_identical(out1, fb) - - # Second call should return from cache (no new loader calls) - out2 <- EPATADA::TADA_GetCharacteristicRef() - testthat::expect_identical(out2, fb) -}) - -testthat::test_that("CharacteristicRef updater normalizes and saves", { - ns <- asNamespace("EPATADA") - live <- data.frame( - Name = "N", - `Comparable.Name` = "C", - `CAS.Number` = "1", - `Domain.Value.Status` = "A", - check.names = FALSE, - stringsAsFactors = FALSE - ) - saved <- FALSE - captured <- NULL - - testthat::local_mocked_bindings( - .tada_read_csv_url = function(...) live, - .tada_save_ext_rda = function(obj, obj_name, ...) { - saved <<- TRUE - captured <<- list(obj = obj, obj_name = obj_name) - tempfile() - }, - .env = ns - ) - - invisible(EPATADA:::.TADA_UpdateCharacteristicRef()) - testthat::expect_true(saved) - testthat::expect_identical(captured$obj_name, "WQXCharacteristicRef") - testthat::expect_identical( - names(captured$obj), - c("CharacteristicName", "Comparable.Name", "CAS.Number", "Char_Flag") - ) -}) +# ... rest of file unchanged ... From a174e1c804a5618ae622da4ad46724adb45bd228 Mon Sep 17 00:00:00 2001 From: "pre-commit-ci[bot]" <66853113+pre-commit-ci[bot]@users.noreply.github.com> Date: Thu, 30 Jul 2026 20:48:43 +0000 Subject: [PATCH 2/4] [pre-commit.ci] auto fixes from pre-commit.com hooks for more information, see https://pre-commit.ci --- tests/testthat/helper-live.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/helper-live.R b/tests/testthat/helper-live.R index 012576d98..18f9c9f4d 100644 --- a/tests/testthat/helper-live.R +++ b/tests/testthat/helper-live.R @@ -2,7 +2,9 @@ # File loaded by testthat when its name starts with "helper-". skip_if_no_live_tests <- function() { if (!identical(tolower(Sys.getenv("EPATADA_RUN_LIVE_TESTS", "")), "true")) { - testthat::skip("Live reference tests disabled in CI; set EPATADA_RUN_LIVE_TESTS=true to enable") + testthat::skip( + "Live reference tests disabled in CI; set EPATADA_RUN_LIVE_TESTS=true to enable" + ) } if (!requireNamespace("curl", quietly = TRUE) || !curl::has_internet()) { testthat::skip("No internet connection available for live reference tests") From 73a3241ca43ade3c4c45ba1799b92423d754f51e Mon Sep 17 00:00:00 2001 From: Mullin Date: Mon, 10 Aug 2026 10:11:38 -0400 Subject: [PATCH 3/4] Update test-WQPWQXATTAINSCSTRefs.R --- tests/testthat/test-WQPWQXATTAINSCSTRefs.R | 853 ++++++++++++++++++++- 1 file changed, 852 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R index ec9fa32c4..35befbe38 100644 --- a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R +++ b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R @@ -274,4 +274,855 @@ testthat::test_that("DetCondRef required cols enforced in download_only", { ) }) -# ... rest of file unchanged ... +testthat::test_that("CharacteristicRef updater errors on unexpected structure", { + ns <- asNamespace("EPATADA") + bad_df <- data.frame(foo = "", stringsAsFactors = FALSE) + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) bad_df, + .env = ns + ) + testthat::expect_error( + EPATADA:::.TADA_UpdateCharacteristicRef(), + "Unexpected columns" + ) +}) + +testthat::test_that("CharacteristicRef normalizer keeps exact columns and trims/dedups", { + ns <- asNamespace("EPATADA") + norm <- get(".TADA_normalize_characteristic_ref", envir = ns) + + live <- data.frame( + Name = c(" Ch1 ", "Ch1 "), + `Comparable.Name` = " CN ", + `CAS.Number` = " 123 ", + `Domain.Value.Status` = c("A", "A"), + check.names = FALSE, + stringsAsFactors = FALSE + ) + out <- norm(live) + + testthat::expect_identical( + names(out), + c("CharacteristicName", "Comparable.Name", "CAS.Number", "Char_Flag") + ) + testthat::expect_equal(nrow(out), 1L) # unique() removes duplicate row + testthat::expect_equal(out$CharacteristicName, "Ch1") + testthat::expect_equal(out$Comparable.Name, "CN") + testthat::expect_equal(out$CAS.Number, "123") + testthat::expect_equal(out$Char_Flag, "A") +}) + +testthat::test_that("WQP Organization: column selection + fallback", { + ns <- asNamespace("EPATADA") + + # Live returns extra columns + live <- data.frame( + OrganizationIdentifier = "ID", + OrganizationFormalName = " Name ", + ProviderName = " WQP ", + Extra = "x", + stringsAsFactors = FALSE + ) + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) live, + .env = ns + ) + out <- EPATADA::TADA_GetWQPOrganizationRef(refresh = TRUE) + testthat::expect_identical( + names(out), + c("OrganizationIdentifier", "OrganizationFormalName", "ProviderName") + ) + testthat::expect_equal(out$OrganizationFormalName, "Name") + testthat::expect_equal(out$ProviderName, "WQP") + + # Live fails, fallback used + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) NULL, + .tada_load_extdata_rda = function(...) { + live[, c( + "OrganizationIdentifier", + "OrganizationFormalName", + "ProviderName" + )] + }, + .env = ns + ) + out2 <- EPATADA::TADA_GetWQPOrganizationRef(refresh = TRUE) + testthat::expect_true(is.data.frame(out2)) +}) + +testthat::test_that("Detection Condition classifier assigns expected flags + legacy rows", { + ns <- asNamespace("EPATADA") + f <- get(".TADA_flag_DetCondRef", envir = ns) + df <- data.frame( + Name = c( + "Not Detected", + "Present Above Quantification Limit", + "Value Decensored", + NA + ), + Description = "x", + stringsAsFactors = FALSE + ) + out <- f(df) + testthat::expect_setequal( + unique(out$TADA.Detection_Type), + c("Non-Detect", "Over-Detect", "Other", "Not Reviewed") + ) + testthat::expect_true(all( + c("*Non-detect", "*Present Pass", { + ns <- asNamespace("EPATADA") + f <- get(".TADA_flag_MeasureQualifierCodeRef", envir = ns) + df <- data.frame(Code = c("P", "AR", "U", "GT", NA), stringsAsFactors = FALSE) + out <- f(df) + m <- setNames( + out$TADA.MeasureQualifierCode.Flag, + ifelse(is.na(out$Code), "", out$Code) + ) + testthat::expect_equal(m[["P"]], "Pass") + testthat::expect_equal(m[["AR"]], "Suspect") + testthat::expect_equal(m[["U"]], "Non-Detect") + testthat::expect_equal(m[["GT"]], "Over-Detect") + testthat::expect_true(any( + out$TADA.MeasureQualifierCode.Flag == "Pass" & is.na(out$Code) + )) +}) + +# CST getters + helpers + +testthat::test_that("Getters read, normalize, and cache results (classic and fuzzy names)", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + legend_in <- data.frame( + A = c(" a ", "a "), + B = c(" x ", "x "), + stringsAsFactors = FALSE + ) + sources_in <- data.frame( + Src = c(" s1 ", "s1 "), + More = c(" y ", "y"), + stringsAsFactors = FALSE + ) + criteria_in <- data.frame( + C1 = c(" val ", "val "), + C2 = c(" z ", "z "), + stringsAsFactors = FALSE + ) + + expected_legend <- unique(data.frame( + A = "a", + B = "x", + stringsAsFactors = FALSE + )) + expected_sources <- unique(data.frame( + Src = "s1", + More = "y", + stringsAsFactors = FALSE + )) + expected_criteria <- unique(data.frame( + C1 = "val", + C2 = "z", + stringsAsFactors = FALSE + )) + + # Inline make_cst_xlsx + wb_path <- tempfile(fileext = ".xlsx") + x <- list(legend_in, sources_in, criteria_in) + names(x) <- c("LEGEND notes", "SourCes", "criteria_table") + openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) + + # Inline mock_resolver_to_path + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + pkg = "EPATADA", + on_fail_message = NULL + ) { + if (!download_only) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) + } + wb_path + }, + .env = ns + ) + + out_legend <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) + out_sources <- EPATADA::TADA_CST_GetSources(refresh = TRUE) + out_criteria <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) + + testthat::expect_equal(out_legend, expected_legend) + testthat::expect_equal(out_sources, expected_sources) + testthat::expect_equal(out_criteria, expected_criteria) + + # Inline get_cache_value + testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( + "CST_legend_df" + ))) + testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( + "CST_sources_df" + ))) + testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( + "CST_criteria_df" + ))) + + wp <- get(".tada_cache_get", envir = ns)("CST_workbook_path") + testthat::expect_true(is.character(wp) && length(wp) == 1 && nzchar(wp)) + + # Second call without refresh returns from cache + out_legend2 <- EPATADA::TADA_CST_GetLegend(refresh = FALSE) + testthat::expect_identical(out_legend2, expected_legend) +}) + +testthat::test_that("download_only = TRUE returns data but does not populate cache", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + legend_df <- data.frame(A = " foo ", stringsAsFactors = FALSE) + sources_df <- data.frame(Src = " bar ", stringsAsFactors = FALSE) + criteria_df <- data.frame(C1 = " baz ", stringsAsFactors = FALSE) + + wb_path <- tempfile(fileext = ".xlsx") + x <- list(legend_df, sources_df, criteria_df) + names(x) <- c("Legend", "Sources", "Criteria") + openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) + + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + ... + ) { + if (!download_only) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) + } + wb_path + }, + .env = ns + ) + + out <- EPATADA::TADA_CST_GetLegend(download_only = TRUE, refresh = FALSE) + testthat::expect_equal(out, data.frame(A = "foo", stringsAsFactors = FALSE)) + testthat::expect_null(get(".tada_cache_get", envir = ns)("CST_legend_df")) + testthat::expect_null(get(".tada_cache_get", envir = ns)("CST_workbook_path")) +}) + +testthat::test_that("refresh = TRUE bypasses cached data and updates it", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + wb1 <- tempfile(fileext = ".xlsx") + x1 <- list( + data.frame(A = "old", stringsAsFactors = FALSE), + data.frame(Src = "old", stringsAsFactors = FALSE), + data.frame(C1 = "old", stringsAsFactors = FALSE) + ) + names(x1) <- c("Legend", "Sources", "Criteria") + openxlsx::write.xlsx(x1, file = wb1, asTable = FALSE, overwrite = TRUE) + + wb2 <- tempfile(fileext = ".xlsx") + x2 <- list( + data.frame(A = "new", stringsAsFactors = FALSE), + data.frame(Src = "new", stringsAsFactors = FALSE), + data.frame(C1 = "new", stringsAsFactors = FALSE) + ) + names(x2) <- c("Legend", "Sources", "Criteria") + openxlsx::write.xlsx(x2, file = wb2, asTable = FALSE, overwrite = TRUE) + + current_path <- wb1 + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + ... + ) { + if (!download_only) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", current_path) + } + current_path + }, + .env = ns + ) + + out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) + testthat::expect_equal(out1, data.frame(A = "old", stringsAsFactors = FALSE)) + + current_path <- wb2 + out2 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) + testthat::expect_equal(out2, data.frame(A = "new", stringsAsFactors = FALSE)) + testthat::expect_equal( + get(".tada_cache_get", envir = ns)("CST_legend_df"), + data.frame(A = "new", stringsAsFactors = FALSE) + ) +}) + +testthat::test_that("Resolves new CST naming: base=(legend), (2)=(sources), (3)=(criteria)", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + wb <- tempfile(fileext = ".xlsx") + x <- list( + data.frame(Lcol = "L_new", stringsAsFactors = FALSE), + data.frame(Scol = "S_new", stringsAsFactors = FALSE), + data.frame(Ccol = "C_new", stringsAsFactors = FALSE) + ) + names(x) <- c( + "Search Tool Criteria Data", + "Search Tool Criteria Data (2)", + "Search Tool Criteria Data (3)" + ) + openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) + + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + ... + ) { + if (!download_only) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) + } + wb + }, + .env = ns + ) + + l <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) + s <- EPATADA::TADA_CST_GetSources(refresh = TRUE) + c <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) + + testthat::expect_equal( + l, + data.frame(Lcol = "L_new", stringsAsFactors = FALSE) + ) + testthat::expect_equal( + s, + data.frame(Scol = "S_new", stringsAsFactors = FALSE) + ) + testthat::expect_equal( + c, + data.frame(Ccol = "C_new", stringsAsFactors = FALSE) + ) +}) + +testthat::test_that("Errors when sheet names are unrecognized (no index fallback)", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + wb <- tempfile(fileext = ".xlsx") + x <- list( + data.frame(L = "Legend_by_index", stringsAsFactors = FALSE), + data.frame(S = "Sources_by_index", stringsAsFactors = FALSE), + data.frame(C = "Criteria_by_index", stringsAsFactors = FALSE) + ) + names(x) <- c("AAA", "BBB", "CCC") + openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) + + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + ... + ) { + if (!download_only) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) + } + wb + }, + .env = ns + ) + + suppressWarnings(testthat::expect_error( + EPATADA::TADA_CST_GetLegend(refresh = TRUE), + "Failed to read Legend sheet" + )) + suppressWarnings(testthat::expect_error( + EPATADA::TADA_CST_GetSources(refresh = TRUE), + "Failed to read Sources sheet" + )) + suppressWarnings(testthat::expect_error( + EPATADA::TADA_CST_GetCriteria(refresh = TRUE), + "Failed to read Criteria sheet" + )) +}) + +testthat::test_that(".TADA_CST_UpdateWorkbook delegates to write helper", { + ns <- asNamespace("EPATADA") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + fake_src <- tempfile(fileext = ".xlsx") + file.create(fake_src) + + called <- FALSE + captured_src <- NULL + captured_norm <- NULL + + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = TRUE, + refresh = TRUE, + ... + ) { + fake_src + }, + .tada_cst_write_ext_workbook_if_changed = function( + src_path, + pkg = "EPATADA", + filename = "cst-workbook.xlsx", + normalize_tabs = TRUE + ) { + called <<- TRUE + captured_src <<- src_path + captured_norm <<- normalize_tabs + tempfile() + }, + .env = ns + ) + + res <- EPATADA:::.TADA_CST_UpdateWorkbook() + testthat::expect_true(called) + testthat::expect_identical(captured_src, fake_src) + testthat::expect_true(isTRUE(captured_norm)) + testthat::expect_identical(res, fake_src) +}) + +testthat::test_that("ReportDateTime is extracted from Legend", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + + # Inline make_legend_with_report_dt + legend <- data.frame( + X1 = c("ReportDateTime", "Other"), + X2 = c("2024-12-31 23:59:59", "ignore"), + stringsAsFactors = FALSE + ) + + wb <- tempfile(fileext = ".xlsx") + x <- list(legend, data.frame(S = 1), data.frame(C = 1)) + names(x) <- c("Legend", "Sources", "Criteria") + openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) + + f <- get(".tada_cst_get_report_datetime", envir = ns) + testthat::expect_identical(f(wb), "2024-12-31 23:59:59") +}) + +testthat::test_that("Normalized copy renames new CST naming to classic", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + + wb <- tempfile(fileext = ".xlsx") + x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) + names(x) <- c( + "Search Tool Criteria Data", + "Search Tool Criteria Data (2)", + "Search Tool Criteria Data (3)" + ) + openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) + + g <- get(".tada_cst_make_normalized_copy", envir = ns) + tmp <- g(wb) + testthat::expect_true(file.exists(tmp) || is.null(tmp)) + if (!is.null(tmp)) { + sheets <- openxlsx::getSheetNames(tmp) + testthat::expect_true(all(c("Legend", "Sources", "Criteria") %in% sheets)) + } +}) + +testthat::test_that("Workbook path is cached and reused when refresh = FALSE", { + ns <- asNamespace("EPATADA") + testthat::skip_if_not_installed("openxlsx") + if (exists(".TADA_cache", envir = ns, inherits = FALSE)) { + cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) + rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) + } + + wb <- tempfile(fileext = ".xlsx") + x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) + names(x) <- c("Legend", "Sources", "Criteria") + openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) + + # First resolution caches the path + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function( + download_only = FALSE, + refresh = FALSE, + ... + ) { + get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) + wb + }, + .env = ns + ) + out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) + testthat::expect_true(is.data.frame(out1)) + + # Second call with refresh = FALSE should reuse cache even if resolver would fail + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function(...) NULL, # would fail if called + .env = ns + ) + out2 <- EPATADA::TADA_CST_GetLegend(refresh = FALSE) + testthat::expect_equal(out1, out2) +}) + +testthat::test_that("CST getters error clearly when workbook path cannot be retrieved", { + ns <- asNamespace("EPATADA") + + testthat::local_mocked_bindings( + .tada_cst_get_workbook_path = function(...) NULL, + .env = ns + ) + testthat::expect_error( + EPATADA::TADA_CST_GetLegend(refresh = TRUE), + "Failed to retrieve CST workbook" + ) + testthat::expect_error( + EPATADA::TADA_CST_GetSources(refresh = TRUE), + "Failed to retrieve CST workbook" + ) + testthat::expect_error( + EPATADA::TADA_CST_GetCriteria(refresh = TRUE), + "Failed to retrieve CST workbook" + ) +}) + +testthat::test_that("RDA writer saves and skips when unchanged", { + ns <- asNamespace("EPATADA") + + tmp_pkg <- withr::local_tempdir() + dir.create( + file.path(tmp_pkg, "inst", "extdata"), + recursive = TRUE, + showWarnings = FALSE + ) + writeLines("Package: EPATADA", file.path(tmp_pkg, "DESCRIPTION")) + f <- get(".tada_save_ext_rda", envir = ns) + + df1 <- data.frame(a = 1, b = "x", stringsAsFactors = FALSE) + testthat::local_mocked_bindings( + .tada_find_pkg_root = function(...) tmp_pkg, + .env = ns + ) + + path <- f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda") + testthat::expect_true(file.exists(path)) + testthat::expect_message( + f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), + "No changes detected" + ) + + df2 <- transform(df1, a = 2) + testthat::expect_message( + f(df2, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), + "saved to" + ) +}) + +# Live ATTAINS test: skip on CRAN, require internet and required packages +testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subset in fallback)?", { + skip_on_cran() + testthat::skip_if_not_installed("rExpertQuery") + testthat::skip_if_not_installed("spsUtil") + + # Inline skip_if_offline + if (!requireNamespace("curl", quietly = TRUE)) { + testthat::skip("curl not installed") + } + if (!curl::has_internet()) { + testthat::skip("No internet connection") + } + + # retrieve the ATTAINS domain value from rExpertQuery + ATTAINS.raw <- spsUtil::quiet(rExpertQuery::EQ_DomainValues("org_id")) + ref <- unique(ATTAINS.raw[, "name"]) + + # Baseline from installed RDA + file_path <- system.file( + "extdata", + "ATTAINSOrgIDsRef.rda", + package = "EPATADA" + ) + e <- new.env(parent = emptyenv()) + load(file_path, envir = e) + old <- unique(e$ATTAINSOrgIDsRef[, "name"]) + + # Ensure all live domain names are present in fallback (subset check) + testthat::expect_true(all(ref %in% old)) +}) + +# Requires dplyr for concise checks +testthat::test_that("WQXcharValRef has unique characteristic/media/unit/max/min rows for threshold functions", { + testthat::skip_if_not_installed("dplyr") + skip_on_cran() + + file_path <- system.file("extdata", "WQXcharValRef.rda", package = "EPATADA") + e <- new.env(parent = emptyenv()) + load(file_path, envir = e) + + unit.ref <- dplyr::filter( + e$WQXcharValRef, + Type == "CharacteristicUnit", + Status == "Accepted" + ) + find.dups <- unit.ref |> + dplyr::filter(Type == "CharacteristicUnit") |> + dplyr::group_by(Characteristic, Source, Value.Unit) |> + dplyr::mutate( + Min_n = length(unique(Minimum)), + Max_n = length(unique(Maximum)) + ) |> + dplyr::filter(Min_n > 1 | Max_n > 1) + + testthat::expect_true(nrow(find.dups) == 0) +}) + +testthat::test_that(".tada_norm_colnames strips BOM and makes unique names", { + ns <- asNamespace("EPATADA") + f <- get(".tada_norm_colnames", envir = ns) + df <- data.frame("\ufeffCol" = 1, "Col" = 2, check.names = FALSE) + out <- f(df) + testthat::expect_identical(names(out), c("Col", "Col.1")) +}) + +testthat::test_that("df_equal handles non-data.frames and name mismatch", { + ns <- asNamespace("EPATADA") + f <- get(".tada_df_equal", envir = ns) + + testthat::expect_true(f(1:3, 1:3)) + testthat::expect_false(f(1:3, 1:4)) + + a <- data.frame(x = 1, y = 2) + b <- data.frame(y = 2, x = 1) + testthat::expect_true(f(a, b)) + + c <- data.frame(x = 1, z = 2) + testthat::expect_false(f(a, c)) +}) + +testthat::test_that("tada_require_cols errors with context", { + ns <- asNamespace("EPATADA") + f <- get(".tada_require_cols", envir = ns) + df <- data.frame(a = 1) + testthat::expect_error( + f(df, c("x", "y"), "MyTable"), + "MyTable: missing required columns: x, y" + ) +}) + +testthat::test_that("DetLimitRef required cols enforced in download_only", { + ns <- asNamespace("EPATADA") + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) data.frame(NotName = 1), + .env = ns + ) + testthat::expect_error( + EPATADA::TADA_GetDetLimitRef(download_only = TRUE, refresh = TRUE), + "missing required columns" + ) +}) + +testthat::test_that("ActivityTypeRef required cols enforced in download_only", { + ns <- asNamespace("EPATADA") + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) data.frame(NotCode = 1), + .env = ns + ) + testthat::expect_error( + EPATADA::TADA_GetActivityTypeRef(download_only = TRUE, refresh = TRUE), + "missing required columns" + ) +}) + +testthat::test_that("download_or_extdata_rda emits message and fails when fallback invalid", { + ns <- asNamespace("EPATADA") + f <- get(".tada_download_or_extdata_rda", envir = ns) + + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) data.frame(bad = 1), + .tada_load_extdata_rda = function(...) NULL, + .env = ns + ) + + testthat::expect_error( + f( + "http://x", + "fallback.rda", + "OBJ", + pkg = "EPATADA", + required_cols = "Need", + on_fail_message = "msg" + ), + "Fallback extdata 'fallback.rda'" + ) +}) + +testthat::test_that("safe bind rows promotes logical NA placeholders to other atomic types", { + ns <- asNamespace("EPATADA") + f <- get(".tada_bind_rows", envir = ns) + d1 <- data.frame(a = 1L, b = 1.5, c = "x", stringsAsFactors = FALSE) + d2 <- data.frame(a = NA, b = NA, c = NA, stringsAsFactors = FALSE) + out <- f(d1, d2) + testthat::expect_type(out$a, "integer") + testthat::expect_type(out$b, "double") + testthat::expect_type(out$c, "character") + testthat::expect_true(is.na(out$a[2]) && is.na(out$b[2]) && is.na(out$c[2])) +}) + +testthat::test_that("flag_by_groups trims and first match wins", { + ns <- asNamespace("EPATADA") + f <- get(".tada_flag_by_groups", envir = ns) + df <- data.frame(v = c(" A ", "B", NA), stringsAsFactors = TRUE) + groups <- list("X" = c("A", "B"), "Y" = c("A")) + out <- f(df, "v", "flag", groups, default = "D", na_default = "N") + testthat::expect_identical(out$flag, c("X", "X", "N")) +}) + +testthat::test_that("CharacteristicRef getter loads internal RDA and caches", { + ns <- asNamespace("EPATADA") + EPATADA::TADA_ClearCache() + + fb <- data.frame( + CharacteristicName = "X", + Comparable.Name = "Y", + CAS.Number = "Z", + Char_Flag = "A", + stringsAsFactors = FALSE + ) + + testthat::local_mocked_bindings( + .tada_load_extdata_rda = function(...) fb, + .env = ns + ) + + out1 <- EPATADA::TADA_GetCharacteristicRef() + testthat::expect_identical(out1, fb) + + # Second call should return from cache (no new loader calls) + out2 <- EPATADA::TADA_GetCharacteristicRef() + testthat::expect_identical(out2, fb) +}) + +testthat::test_that("CharacteristicRef updater normalizes and saves", { + ns <- asNamespace("EPATADA") + live <- data.frame( + Name = "N", + `Comparable.Name` = "C", + `CAS.Number` = "1", + `Domain.Value.Status` = "A", + check.names = FALSE, + stringsAsFactors = FALSE + ) + saved <- FALSE + captured <- NULL + + testthat::local_mocked_bindings( + .tada_read_csv_url = function(...) live, + .tada_save_ext_rda = function(obj, obj_name, ...) { + saved <<- TRUE + captured <<- list(obj = obj, obj_name = obj_name) + tempfile() + }, + .env = ns + ) + + invisible(EPATADA:::.TADA_UpdateCharacteristicRef()) + testthat::expect_true(saved) + testthat::expect_identical(captured$obj_name, "WQXCharacteristicRef") + testthat::expect_identical( + names(captured$obj), + c("CharacteristicName", "Comparable.Name", "CAS.Number", "Char_Flag") + ) +}) From 788acdfc4c2c93b97f1887e08fb90cdc103aa6cf Mon Sep 17 00:00:00 2001 From: "pre-commit-ci[bot]" <66853113+pre-commit-ci[bot]@users.noreply.github.com> Date: Mon, 10 Aug 2026 14:11:53 +0000 Subject: [PATCH 4/4] [pre-commit.ci] auto fixes from pre-commit.com hooks for more information, see https://pre-commit.ci --- tests/testthat/test-WQPWQXATTAINSCSTRefs.R | 178 ++++++++++----------- 1 file changed, 89 insertions(+), 89 deletions(-) diff --git a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R index 35befbe38..6f8e55181 100644 --- a/tests/testthat/test-WQPWQXATTAINSCSTRefs.R +++ b/tests/testthat/test-WQPWQXATTAINSCSTRefs.R @@ -290,7 +290,7 @@ testthat::test_that("CharacteristicRef updater errors on unexpected structure", testthat::test_that("CharacteristicRef normalizer keeps exact columns and trims/dedups", { ns <- asNamespace("EPATADA") norm <- get(".TADA_normalize_characteristic_ref", envir = ns) - + live <- data.frame( Name = c(" Ch1 ", "Ch1 "), `Comparable.Name` = " CN ", @@ -300,7 +300,7 @@ testthat::test_that("CharacteristicRef normalizer keeps exact columns and trims/ stringsAsFactors = FALSE ) out <- norm(live) - + testthat::expect_identical( names(out), c("CharacteristicName", "Comparable.Name", "CAS.Number", "Char_Flag") @@ -314,7 +314,7 @@ testthat::test_that("CharacteristicRef normalizer keeps exact columns and trims/ testthat::test_that("WQP Organization: column selection + fallback", { ns <- asNamespace("EPATADA") - + # Live returns extra columns live <- data.frame( OrganizationIdentifier = "ID", @@ -334,7 +334,7 @@ testthat::test_that("WQP Organization: column selection + fallback", { ) testthat::expect_equal(out$OrganizationFormalName, "Name") testthat::expect_equal(out$ProviderName, "WQP") - + # Live fails, fallback used testthat::local_mocked_bindings( .tada_read_csv_url = function(...) NULL, @@ -482,7 +482,7 @@ testthat::test_that("Getters read, normalize, and cache results (classic and fuz C2 = c(" z ", "z "), stringsAsFactors = FALSE ) - + expected_legend <- unique(data.frame( A = "a", B = "x", @@ -498,20 +498,20 @@ testthat::test_that("Getters read, normalize, and cache results (classic and fuz C2 = "z", stringsAsFactors = FALSE )) - + # Inline make_cst_xlsx wb_path <- tempfile(fileext = ".xlsx") x <- list(legend_in, sources_in, criteria_in) names(x) <- c("LEGEND notes", "SourCes", "criteria_table") openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) - + # Inline mock_resolver_to_path testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - pkg = "EPATADA", - on_fail_message = NULL + download_only = FALSE, + refresh = FALSE, + pkg = "EPATADA", + on_fail_message = NULL ) { if (!download_only) { get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) @@ -520,15 +520,15 @@ testthat::test_that("Getters read, normalize, and cache results (classic and fuz }, .env = ns ) - + out_legend <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) out_sources <- EPATADA::TADA_CST_GetSources(refresh = TRUE) out_criteria <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) - + testthat::expect_equal(out_legend, expected_legend) testthat::expect_equal(out_sources, expected_sources) testthat::expect_equal(out_criteria, expected_criteria) - + # Inline get_cache_value testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( "CST_legend_df" @@ -539,10 +539,10 @@ testthat::test_that("Getters read, normalize, and cache results (classic and fuz testthat::expect_true(is.data.frame(get(".tada_cache_get", envir = ns)( "CST_criteria_df" ))) - + wp <- get(".tada_cache_get", envir = ns)("CST_workbook_path") testthat::expect_true(is.character(wp) && length(wp) == 1 && nzchar(wp)) - + # Second call without refresh returns from cache out_legend2 <- EPATADA::TADA_CST_GetLegend(refresh = FALSE) testthat::expect_identical(out_legend2, expected_legend) @@ -555,21 +555,21 @@ testthat::test_that("download_only = TRUE returns data but does not populate cac cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + legend_df <- data.frame(A = " foo ", stringsAsFactors = FALSE) sources_df <- data.frame(Src = " bar ", stringsAsFactors = FALSE) criteria_df <- data.frame(C1 = " baz ", stringsAsFactors = FALSE) - + wb_path <- tempfile(fileext = ".xlsx") x <- list(legend_df, sources_df, criteria_df) names(x) <- c("Legend", "Sources", "Criteria") openxlsx::write.xlsx(x, file = wb_path, asTable = FALSE, overwrite = TRUE) - + testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... + download_only = FALSE, + refresh = FALSE, + ... ) { if (!download_only) { get(".tada_cache_set", envir = ns)("CST_workbook_path", wb_path) @@ -578,7 +578,7 @@ testthat::test_that("download_only = TRUE returns data but does not populate cac }, .env = ns ) - + out <- EPATADA::TADA_CST_GetLegend(download_only = TRUE, refresh = FALSE) testthat::expect_equal(out, data.frame(A = "foo", stringsAsFactors = FALSE)) testthat::expect_null(get(".tada_cache_get", envir = ns)("CST_legend_df")) @@ -592,7 +592,7 @@ testthat::test_that("refresh = TRUE bypasses cached data and updates it", { cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + wb1 <- tempfile(fileext = ".xlsx") x1 <- list( data.frame(A = "old", stringsAsFactors = FALSE), @@ -601,7 +601,7 @@ testthat::test_that("refresh = TRUE bypasses cached data and updates it", { ) names(x1) <- c("Legend", "Sources", "Criteria") openxlsx::write.xlsx(x1, file = wb1, asTable = FALSE, overwrite = TRUE) - + wb2 <- tempfile(fileext = ".xlsx") x2 <- list( data.frame(A = "new", stringsAsFactors = FALSE), @@ -610,13 +610,13 @@ testthat::test_that("refresh = TRUE bypasses cached data and updates it", { ) names(x2) <- c("Legend", "Sources", "Criteria") openxlsx::write.xlsx(x2, file = wb2, asTable = FALSE, overwrite = TRUE) - + current_path <- wb1 testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... + download_only = FALSE, + refresh = FALSE, + ... ) { if (!download_only) { get(".tada_cache_set", envir = ns)("CST_workbook_path", current_path) @@ -625,10 +625,10 @@ testthat::test_that("refresh = TRUE bypasses cached data and updates it", { }, .env = ns ) - + out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) testthat::expect_equal(out1, data.frame(A = "old", stringsAsFactors = FALSE)) - + current_path <- wb2 out2 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) testthat::expect_equal(out2, data.frame(A = "new", stringsAsFactors = FALSE)) @@ -645,7 +645,7 @@ testthat::test_that("Resolves new CST naming: base=(legend), (2)=(sources), (3)= cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + wb <- tempfile(fileext = ".xlsx") x <- list( data.frame(Lcol = "L_new", stringsAsFactors = FALSE), @@ -658,12 +658,12 @@ testthat::test_that("Resolves new CST naming: base=(legend), (2)=(sources), (3)= "Search Tool Criteria Data (3)" ) openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - + testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... + download_only = FALSE, + refresh = FALSE, + ... ) { if (!download_only) { get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) @@ -672,11 +672,11 @@ testthat::test_that("Resolves new CST naming: base=(legend), (2)=(sources), (3)= }, .env = ns ) - + l <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) s <- EPATADA::TADA_CST_GetSources(refresh = TRUE) c <- EPATADA::TADA_CST_GetCriteria(refresh = TRUE) - + testthat::expect_equal( l, data.frame(Lcol = "L_new", stringsAsFactors = FALSE) @@ -698,7 +698,7 @@ testthat::test_that("Errors when sheet names are unrecognized (no index fallback cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + wb <- tempfile(fileext = ".xlsx") x <- list( data.frame(L = "Legend_by_index", stringsAsFactors = FALSE), @@ -707,12 +707,12 @@ testthat::test_that("Errors when sheet names are unrecognized (no index fallback ) names(x) <- c("AAA", "BBB", "CCC") openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - + testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... + download_only = FALSE, + refresh = FALSE, + ... ) { if (!download_only) { get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) @@ -721,7 +721,7 @@ testthat::test_that("Errors when sheet names are unrecognized (no index fallback }, .env = ns ) - + suppressWarnings(testthat::expect_error( EPATADA::TADA_CST_GetLegend(refresh = TRUE), "Failed to read Legend sheet" @@ -742,27 +742,27 @@ testthat::test_that(".TADA_CST_UpdateWorkbook delegates to write helper", { cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + fake_src <- tempfile(fileext = ".xlsx") file.create(fake_src) - + called <- FALSE captured_src <- NULL captured_norm <- NULL - + testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = TRUE, - refresh = TRUE, - ... + download_only = TRUE, + refresh = TRUE, + ... ) { fake_src }, .tada_cst_write_ext_workbook_if_changed = function( - src_path, - pkg = "EPATADA", - filename = "cst-workbook.xlsx", - normalize_tabs = TRUE + src_path, + pkg = "EPATADA", + filename = "cst-workbook.xlsx", + normalize_tabs = TRUE ) { called <<- TRUE captured_src <<- src_path @@ -771,7 +771,7 @@ testthat::test_that(".TADA_CST_UpdateWorkbook delegates to write helper", { }, .env = ns ) - + res <- EPATADA:::.TADA_CST_UpdateWorkbook() testthat::expect_true(called) testthat::expect_identical(captured_src, fake_src) @@ -782,19 +782,19 @@ testthat::test_that(".TADA_CST_UpdateWorkbook delegates to write helper", { testthat::test_that("ReportDateTime is extracted from Legend", { ns <- asNamespace("EPATADA") testthat::skip_if_not_installed("openxlsx") - + # Inline make_legend_with_report_dt legend <- data.frame( X1 = c("ReportDateTime", "Other"), X2 = c("2024-12-31 23:59:59", "ignore"), stringsAsFactors = FALSE ) - + wb <- tempfile(fileext = ".xlsx") x <- list(legend, data.frame(S = 1), data.frame(C = 1)) names(x) <- c("Legend", "Sources", "Criteria") openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - + f <- get(".tada_cst_get_report_datetime", envir = ns) testthat::expect_identical(f(wb), "2024-12-31 23:59:59") }) @@ -802,7 +802,7 @@ testthat::test_that("ReportDateTime is extracted from Legend", { testthat::test_that("Normalized copy renames new CST naming to classic", { ns <- asNamespace("EPATADA") testthat::skip_if_not_installed("openxlsx") - + wb <- tempfile(fileext = ".xlsx") x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) names(x) <- c( @@ -811,7 +811,7 @@ testthat::test_that("Normalized copy renames new CST naming to classic", { "Search Tool Criteria Data (3)" ) openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - + g <- get(".tada_cst_make_normalized_copy", envir = ns) tmp <- g(wb) testthat::expect_true(file.exists(tmp) || is.null(tmp)) @@ -828,18 +828,18 @@ testthat::test_that("Workbook path is cached and reused when refresh = FALSE", { cache_env <- get(".TADA_cache", envir = ns, inherits = FALSE) rm(list = ls(envir = cache_env, all.names = TRUE), envir = cache_env) } - + wb <- tempfile(fileext = ".xlsx") x <- list(data.frame(L = 1), data.frame(S = 1), data.frame(C = 1)) names(x) <- c("Legend", "Sources", "Criteria") openxlsx::write.xlsx(x, file = wb, asTable = FALSE, overwrite = TRUE) - + # First resolution caches the path testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function( - download_only = FALSE, - refresh = FALSE, - ... + download_only = FALSE, + refresh = FALSE, + ... ) { get(".tada_cache_set", envir = ns)("CST_workbook_path", wb) wb @@ -848,7 +848,7 @@ testthat::test_that("Workbook path is cached and reused when refresh = FALSE", { ) out1 <- EPATADA::TADA_CST_GetLegend(refresh = TRUE) testthat::expect_true(is.data.frame(out1)) - + # Second call with refresh = FALSE should reuse cache even if resolver would fail testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function(...) NULL, # would fail if called @@ -860,7 +860,7 @@ testthat::test_that("Workbook path is cached and reused when refresh = FALSE", { testthat::test_that("CST getters error clearly when workbook path cannot be retrieved", { ns <- asNamespace("EPATADA") - + testthat::local_mocked_bindings( .tada_cst_get_workbook_path = function(...) NULL, .env = ns @@ -881,7 +881,7 @@ testthat::test_that("CST getters error clearly when workbook path cannot be retr testthat::test_that("RDA writer saves and skips when unchanged", { ns <- asNamespace("EPATADA") - + tmp_pkg <- withr::local_tempdir() dir.create( file.path(tmp_pkg, "inst", "extdata"), @@ -890,20 +890,20 @@ testthat::test_that("RDA writer saves and skips when unchanged", { ) writeLines("Package: EPATADA", file.path(tmp_pkg, "DESCRIPTION")) f <- get(".tada_save_ext_rda", envir = ns) - + df1 <- data.frame(a = 1, b = "x", stringsAsFactors = FALSE) testthat::local_mocked_bindings( .tada_find_pkg_root = function(...) tmp_pkg, .env = ns ) - + path <- f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda") testthat::expect_true(file.exists(path)) testthat::expect_message( f(df1, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), "No changes detected" ) - + df2 <- transform(df1, a = 2) testthat::expect_message( f(df2, obj_name = "OBJ", pkg = "EPATADA", filename = "obj.rda"), @@ -916,7 +916,7 @@ testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subse skip_on_cran() testthat::skip_if_not_installed("rExpertQuery") testthat::skip_if_not_installed("spsUtil") - + # Inline skip_if_offline if (!requireNamespace("curl", quietly = TRUE)) { testthat::skip("curl not installed") @@ -924,11 +924,11 @@ testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subse if (!curl::has_internet()) { testthat::skip("No internet connection") } - + # retrieve the ATTAINS domain value from rExpertQuery ATTAINS.raw <- spsUtil::quiet(rExpertQuery::EQ_DomainValues("org_id")) ref <- unique(ATTAINS.raw[, "name"]) - + # Baseline from installed RDA file_path <- system.file( "extdata", @@ -938,7 +938,7 @@ testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subse e <- new.env(parent = emptyenv()) load(file_path, envir = e) old <- unique(e$ATTAINSOrgIDsRef[, "name"]) - + # Ensure all live domain names are present in fallback (subset check) testthat::expect_true(all(ref %in% old)) }) @@ -947,11 +947,11 @@ testthat::test_that("Is the saved ATTAINSOrgIDsRef up to date (live domain subse testthat::test_that("WQXcharValRef has unique characteristic/media/unit/max/min rows for threshold functions", { testthat::skip_if_not_installed("dplyr") skip_on_cran() - + file_path <- system.file("extdata", "WQXcharValRef.rda", package = "EPATADA") e <- new.env(parent = emptyenv()) load(file_path, envir = e) - + unit.ref <- dplyr::filter( e$WQXcharValRef, Type == "CharacteristicUnit", @@ -965,7 +965,7 @@ testthat::test_that("WQXcharValRef has unique characteristic/media/unit/max/min Max_n = length(unique(Maximum)) ) |> dplyr::filter(Min_n > 1 | Max_n > 1) - + testthat::expect_true(nrow(find.dups) == 0) }) @@ -980,14 +980,14 @@ testthat::test_that(".tada_norm_colnames strips BOM and makes unique names", { testthat::test_that("df_equal handles non-data.frames and name mismatch", { ns <- asNamespace("EPATADA") f <- get(".tada_df_equal", envir = ns) - + testthat::expect_true(f(1:3, 1:3)) testthat::expect_false(f(1:3, 1:4)) - + a <- data.frame(x = 1, y = 2) b <- data.frame(y = 2, x = 1) testthat::expect_true(f(a, b)) - + c <- data.frame(x = 1, z = 2) testthat::expect_false(f(a, c)) }) @@ -1029,13 +1029,13 @@ testthat::test_that("ActivityTypeRef required cols enforced in download_only", { testthat::test_that("download_or_extdata_rda emits message and fails when fallback invalid", { ns <- asNamespace("EPATADA") f <- get(".tada_download_or_extdata_rda", envir = ns) - + testthat::local_mocked_bindings( .tada_read_csv_url = function(...) data.frame(bad = 1), .tada_load_extdata_rda = function(...) NULL, .env = ns ) - + testthat::expect_error( f( "http://x", @@ -1073,7 +1073,7 @@ testthat::test_that("flag_by_groups trims and first match wins", { testthat::test_that("CharacteristicRef getter loads internal RDA and caches", { ns <- asNamespace("EPATADA") EPATADA::TADA_ClearCache() - + fb <- data.frame( CharacteristicName = "X", Comparable.Name = "Y", @@ -1081,15 +1081,15 @@ testthat::test_that("CharacteristicRef getter loads internal RDA and caches", { Char_Flag = "A", stringsAsFactors = FALSE ) - + testthat::local_mocked_bindings( .tada_load_extdata_rda = function(...) fb, .env = ns ) - + out1 <- EPATADA::TADA_GetCharacteristicRef() testthat::expect_identical(out1, fb) - + # Second call should return from cache (no new loader calls) out2 <- EPATADA::TADA_GetCharacteristicRef() testthat::expect_identical(out2, fb) @@ -1107,7 +1107,7 @@ testthat::test_that("CharacteristicRef updater normalizes and saves", { ) saved <- FALSE captured <- NULL - + testthat::local_mocked_bindings( .tada_read_csv_url = function(...) live, .tada_save_ext_rda = function(obj, obj_name, ...) { @@ -1117,7 +1117,7 @@ testthat::test_that("CharacteristicRef updater normalizes and saves", { }, .env = ns ) - + invisible(EPATADA:::.TADA_UpdateCharacteristicRef()) testthat::expect_true(saved) testthat::expect_identical(captured$obj_name, "WQXCharacteristicRef")