From 3eb0cd4221ceae59da1ea73811ef7f644c34f366 Mon Sep 17 00:00:00 2001 From: theHumanBorch Date: Sat, 24 Jan 2026 12:13:31 -0600 Subject: [PATCH] expand unit tests --- .../test-calculatePeptideBindingLoad.R | 216 +++++++++++ tests/testthat/test-deepmatchrEnv.R | 85 ++++- tests/testthat/test-updateWmdaData.R | 347 ++++++++++++++++++ 3 files changed, 646 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-updateWmdaData.R diff --git a/tests/testthat/test-calculatePeptideBindingLoad.R b/tests/testthat/test-calculatePeptideBindingLoad.R index fdd99fa..9723689 100644 --- a/tests/testthat/test-calculatePeptideBindingLoad.R +++ b/tests/testthat/test-calculatePeptideBindingLoad.R @@ -160,3 +160,219 @@ test_that("calculatePeptideBindingLoad accepts character vector of alleles", { expect_type(result, "double") expect_true(result >= 0) }) + +# --- Identical Genotype Tests --- + +test_that("calculatePeptideBindingLoad returns 0 for identical genotypes with no mismatched peptides", { + # When donor and recipient have identical alleles, no mismatched peptides should be derived + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", A_2 = "A*03:01", stringsAsFactors = FALSE)) + donor <- hlaGeno(data.frame(A_1 = "A*02:01", A_2 = "A*03:01", stringsAsFactors = FALSE)) + + # With empty peptides (when peptides cannot be derived), should return 0 + result <- calculatePeptideBindingLoad(recipient, character(0), return = "total") + expect_equal(result, 0) +}) + +# --- PWM Backend Detailed Tests --- + +test_that("PWM backend produces consistent scores for known binders", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + # GILGFVFTL is a well-known A*02:01 binder (influenza M1 peptide) + peptides <- c("GILGFVFTL") + + result <- calculatePeptideBindingLoad(recipient, peptides, backend = "pwm", return = "detail") + + expect_equal(nrow(result), 1) + expect_equal(result$peptide, "GILGFVFTL") + expect_equal(result$hla_allele, "A*02:01") + expect_true(result$predicted_ic50 > 0) +}) + +test_that("PWM backend handles unknown supertypes gracefully", { + # Use an allele that might not be in the supertype mapping + recipient <- hlaGeno(data.frame(A_1 = "A*99:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL") + + # Should not error, falls back to A02-like + result <- calculatePeptideBindingLoad(recipient, peptides, backend = "pwm", return = "detail") + expect_equal(nrow(result), 1) +}) + +# --- Summary Return Tests --- + +test_that("summary return correctly aggregates across alleles", { + recipient <- hlaGeno(data.frame( + A_1 = "A*02:01", A_2 = "A*03:01", + stringsAsFactors = FALSE + )) + peptides <- c("GILGFVFTL", "NLVPMVATV", "FLKEKGGL") + + result <- calculatePeptideBindingLoad(recipient, peptides, return = "summary") + + expect_equal(nrow(result), 2) # Two alleles + expect_true(all(result$n_strong >= 0)) + expect_true(all(result$n_weak >= 0)) + expect_true(all(result$n_strong + result$n_weak <= result$n_peptides)) +}) + +test_that("summary totals match detail breakdown", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV", "FLKEKGGL") + + detail <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + summary <- calculatePeptideBindingLoad(recipient, peptides, return = "summary") + + expect_equal(summary$n_peptides[1], nrow(detail)) + expect_equal(summary$n_strong[1], sum(detail$binding_level == "strong")) + expect_equal(summary$n_weak[1], sum(detail$binding_level == "weak")) +}) + +# --- Contribution Calculation Tests --- + +test_that("contribution scores are non-negative", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV") + + result <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + + expect_true(all(result$contribution >= 0)) +}) + +test_that("strong binders have higher contribution than weak binders", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV", "FLKEKGGL", "AAAAAAAAL") + + result <- calculatePeptideBindingLoad( + recipient, peptides, + binding_threshold = 500, + weak_threshold = 5000, + return = "detail" + ) + + # Check that multiplier difference is reflected + strong <- result[result$binding_level == "strong", ] + weak <- result[result$binding_level == "weak", ] + + # This tests the formula: strong gets 2x multiplier, weak gets 1x + # For same IC50, strong contribution should be ~2x weak + if (nrow(strong) > 0 && nrow(weak) > 0) { + # At least verify strong binders have non-zero contribution + expect_true(all(strong$contribution > 0)) + } +}) + +# --- Edge Case Tests --- + +test_that("calculatePeptideBindingLoad handles single character peptide input", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + + # Single short peptide (will be filtered out for 9-mer requirement) + result <- calculatePeptideBindingLoad(recipient, "ABC", peptide_length = 9L) + expect_equal(result, 0) +}) + +test_that("calculatePeptideBindingLoad handles peptides with non-standard characters", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + # Peptide with X (unknown) + peptides <- c("GILGFVFTX") + + result <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + expect_equal(nrow(result), 1) # Should still process +}) + +test_that("calculatePeptideBindingLoad handles duplicate peptides", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "GILGFVFTL", "GILGFVFTL") + + result <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + + # Duplicates should be deduplicated internally by .getPeptides + expect_equal(nrow(result), 1) +}) + +# --- Different Peptide Lengths --- + +test_that("calculatePeptideBindingLoad works with different peptide lengths", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + + # 8-mers + peptides_8 <- c("GILGFVFT", "NLVPMVAT") + result_8 <- calculatePeptideBindingLoad(recipient, peptides_8, peptide_length = 8L, return = "detail") + expect_equal(nrow(result_8), 2) + expect_true(all(nchar(result_8$peptide) == 8)) + + # 10-mers + peptides_10 <- c("GILGFVFTLA", "NLVPMVATVA") + result_10 <- calculatePeptideBindingLoad(recipient, peptides_10, peptide_length = 10L, return = "detail") + expect_equal(nrow(result_10), 2) + expect_true(all(nchar(result_10$peptide) == 10)) +}) + +# --- Aggregate Method Tests --- + +test_that("aggregate_method sum gives total of all contributions", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV") + + detail <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + total_sum <- calculatePeptideBindingLoad(recipient, peptides, aggregate_method = "sum") + + expect_equal(total_sum, sum(detail$contribution)) +}) + +test_that("aggregate_method max gives maximum contribution", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV") + + detail <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + total_max <- calculatePeptideBindingLoad(recipient, peptides, aggregate_method = "max") + + expect_equal(total_max, max(detail$contribution)) +}) + +test_that("aggregate_method mean gives average contribution", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + peptides <- c("GILGFVFTL", "NLVPMVATV") + + detail <- calculatePeptideBindingLoad(recipient, peptides, return = "detail") + total_mean <- calculatePeptideBindingLoad(recipient, peptides, aggregate_method = "mean") + + expect_equal(total_mean, mean(detail$contribution)) +}) + +# --- Class I vs Class II Alleles --- + +test_that("calculatePeptideBindingLoad handles Class I B locus alleles", { + recipient <- hlaGeno(data.frame(B_1 = "B*07:02", B_2 = "B*08:01", stringsAsFactors = FALSE)) + peptides <- c("TPRVTGGGAM") # Known B*07:02 binder motif (Pro at P2) + + result <- calculatePeptideBindingLoad(recipient, peptides, peptide_length = 10L, return = "detail") + + expect_true(nrow(result) >= 1) + expect_true(all(grepl("B\\*", result$hla_allele))) +}) + +# --- Empty and Edge Cases for Summary --- + +test_that("summary return handles empty peptides correctly", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", A_2 = "A*03:01", stringsAsFactors = FALSE)) + + result <- calculatePeptideBindingLoad(recipient, character(0), return = "summary") + + expect_s3_class(result, "data.frame") + expect_equal(nrow(result), 2) + expect_true(all(result$n_peptides == 0)) + expect_true(all(result$n_strong == 0)) + expect_true(all(result$n_weak == 0)) + expect_true(all(result$risk_contribution == 0)) +}) + +test_that("detail return handles empty peptides correctly", { + recipient <- hlaGeno(data.frame(A_1 = "A*02:01", stringsAsFactors = FALSE)) + + result <- calculatePeptideBindingLoad(recipient, character(0), return = "detail") + + expect_s3_class(result, "data.frame") + expect_equal(nrow(result), 0) + expect_true(all(c("peptide", "hla_allele", "predicted_ic50", "binding_level", "contribution") %in% names(result))) +}) diff --git a/tests/testthat/test-deepmatchrEnv.R b/tests/testthat/test-deepmatchrEnv.R index a284d3f..7837416 100644 --- a/tests/testthat/test-deepmatchrEnv.R +++ b/tests/testthat/test-deepmatchrEnv.R @@ -21,12 +21,13 @@ sysname <- tryCatch({ test_that("explicit platform selection returns expected BasiliskEnvironment S4 objects", { out_lin <- deepmatchrEnv("linux") out_mac <- deepmatchrEnv("macos") - + # S4 class checks expect_s4_class(out_lin, "BasiliskEnvironment") expect_s4_class(out_mac, "BasiliskEnvironment") - + # envname slot is the one you defined in your code ("deepmatchrEnv") + expect_identical(out_lin@envname, "deepmatchrEnv_v2") expect_identical(out_mac@envname, "deepmatchrEnv_v2") }) @@ -34,3 +35,83 @@ test_that("explicit platform selection returns expected BasiliskEnvironment S4 o test_that("match.arg validates unsupported platform", { expect_error(deepmatchrEnv("windows"), "arg") }) + +# --- Auto Platform Detection Tests --- + +test_that("auto platform detection returns valid BasiliskEnvironment", { + out_auto <- deepmatchrEnv("auto") + expect_s4_class(out_auto, "BasiliskEnvironment") + expect_identical(out_auto@envname, "deepmatchrEnv_v2") +}) + +test_that("auto platform matches explicit selection for current OS", { + out_auto <- deepmatchrEnv("auto") + + if (grepl("darwin|mac", sysname)) { + out_explicit <- deepmatchrEnv("macos") + } else { + out_explicit <- deepmatchrEnv("linux") + } + + expect_identical(out_auto@envname, out_explicit@envname) + expect_identical(out_auto@pkgname, out_explicit@pkgname) +}) + +# --- Environment Configuration Tests --- + +test_that("linux environment has correct package configuration", { + out_lin <- deepmatchrEnv("linux") + + expect_identical(out_lin@pkgname, "deepMatchR") + # Check pip packages are specified (the slots vary by basilisk version) + # At minimum, envname and pkgname should be correct +}) + +test_that("macos environment has correct package configuration", { + out_mac <- deepmatchrEnv("macos") + + expect_identical(out_mac@pkgname, "deepMatchR") +}) + +# --- Default Argument Tests --- + +test_that("deepmatchrEnv with no arguments uses auto", { + out_default <- deepmatchrEnv() + out_auto <- deepmatchrEnv("auto") + + expect_identical(out_default@envname, out_auto@envname) +}) + +# --- Internal Environment Object Tests --- + +test_that("internal linux environment object exists and is valid", { + env_lin <- get_linux_env() + expect_s4_class(env_lin, "BasiliskEnvironment") + expect_identical(env_lin@envname, "deepmatchrEnv_v2") + expect_identical(env_lin@pkgname, "deepMatchR") +}) + +test_that("internal macos environment object exists and is valid", { + env_mac <- get_macos_env() + expect_s4_class(env_mac, "BasiliskEnvironment") + expect_identical(env_mac@envname, "deepmatchrEnv_v2") + expect_identical(env_mac@pkgname, "deepMatchR") +}) + +# --- Idempotency Tests --- + +test_that("repeated calls return identical environments", { + out1 <- deepmatchrEnv("linux") + out2 <- deepmatchrEnv("linux") + + expect_identical(out1@envname, out2@envname) + expect_identical(out1@pkgname, out2@pkgname) +}) + +test_that("environment names are consistent across platforms", { + out_lin <- deepmatchrEnv("linux") + out_mac <- deepmatchrEnv("macos") + + # Both should have the same environment name for consistency + expect_identical(out_lin@envname, out_mac@envname) +}) diff --git a/tests/testthat/test-updateWmdaData.R b/tests/testthat/test-updateWmdaData.R new file mode 100644 index 0000000..6657e6b --- /dev/null +++ b/tests/testthat/test-updateWmdaData.R @@ -0,0 +1,347 @@ +# tests/testthat/test-updateWmdaData.R + +# --- Cache Directory Tests --- + +test_that(".getWmdaCacheDir returns valid path", { + cache_dir <- deepMatchR:::.getWmdaCacheDir() + expect_type(cache_dir, "character") + expect_true(nzchar(cache_dir)) +}) + +test_that(".getWmdaCacheDir respects DEEPMATCHR_CACHE_DIR environment variable", { + withr::with_envvar(c(DEEPMATCHR_CACHE_DIR = "/custom/cache/path"), { + cache_dir <- deepMatchR:::.getWmdaCacheDir() + expect_equal(cache_dir, "/custom/cache/path") + }) +}) + +test_that(".getWmdaCacheDir falls back to rappdirs when available", { + withr::with_envvar(c(DEEPMATCHR_CACHE_DIR = ""), { + cache_dir <- deepMatchR:::.getWmdaCacheDir() + expect_type(cache_dir, "character") + expect_true(nzchar(cache_dir)) + # Should either be rappdirs path or tempdir fallback + expect_true(grepl("deepMatchR", cache_dir) || grepl("Rtmp", cache_dir)) + }) +}) + +# --- clearWmdaCache Tests --- + +test_that("clearWmdaCache works without error when no cache exists", { + temp_dir <- tempfile("wmda_cache_test") + + result <- clearWmdaCache(cache_dir = temp_dir, verbose = FALSE) + expect_false(result) # No cache existed +}) + +test_that("clearWmdaCache removes existing cache files", { + temp_dir <- tempfile("wmda_cache_test") + dir.create(temp_dir, recursive = TRUE) + + # Create mock cache files + cache_file <- file.path(temp_dir, "wmda_cache.rds") + version_file <- file.path(temp_dir, "wmda_version.txt") + saveRDS(list(test = "data"), cache_file) + writeLines("test_version", version_file) + + expect_true(file.exists(cache_file)) + expect_true(file.exists(version_file)) + + result <- clearWmdaCache(cache_dir = temp_dir, verbose = FALSE) + + expect_true(result) + expect_false(file.exists(cache_file)) + expect_false(file.exists(version_file)) + + # Cleanup + unlink(temp_dir, recursive = TRUE) +}) + +test_that("clearWmdaCache with verbose=TRUE prints message", { + temp_dir <- tempfile("wmda_cache_test") + + expect_message(clearWmdaCache(cache_dir = temp_dir, verbose = TRUE), "No WMDA cache found") + + # Now with actual cache + dir.create(temp_dir, recursive = TRUE) + cache_file <- file.path(temp_dir, "wmda_cache.rds") + saveRDS(list(test = "data"), cache_file) + + expect_message(clearWmdaCache(cache_dir = temp_dir, verbose = TRUE), "WMDA cache cleared") + + unlink(temp_dir, recursive = TRUE) +}) + +# --- Parser Tests --- + +test_that(".parseDnaSer parses valid lines correctly", { + lines <- c( + "A*;01:01;1;;", + "A*;02:01;2;;", + "B*;07:02;7;;" + ) + + result <- deepMatchR:::.parseDnaSer(lines) + + expect_s3_class(result, "data.table") + expect_true(all(c("locus", "allele_2f", "serology") %in% names(result))) + expect_equal(nrow(result), 3) +}) + +test_that(".parseDnaSer handles multiple serology assignments", { + # When multiple serologies are listed (separated by /), first should be taken + lines <- c("A*;01:01;1/9;;") + + result <- deepMatchR:::.parseDnaSer(lines) + + expect_equal(result$serology[1], "1") +}) + +test_that(".parseDnaSer extracts two-field alleles correctly", { + lines <- c( + "A*;01:01:01:01;1;;", # Four-field + "A*;02:01:01;2;;" # Three-field + ) + + result <- deepMatchR:::.parseDnaSer(lines) + + expect_equal(result$allele_2f[1], "01:01") + expect_equal(result$allele_2f[2], "02:01") +}) + +test_that(".parseSerSer parses broad/split relationships", { + lines <- c( + "A;9;23", + "A;9;24", + "DR;2;15", + "DR;2;16" + ) + + result <- deepMatchR:::.parseSerSer(lines) + + expect_s3_class(result, "data.table") + expect_true(all(c("locus", "broad", "splits") %in% names(result))) + + # Should aggregate splits for same broad + a9_row <- result[locus == "A" & broad == "9"] + expect_equal(nrow(a9_row), 1) + expect_true(grepl("23", a9_row$splits)) + expect_true(grepl("24", a9_row$splits)) +}) + +test_that(".parseNomP parses P-group definitions", { + lines <- c( + "A*01:01/01:02/01:03;01:01P", + "B*07:02/07:03;07:02P" + ) + + result <- deepMatchR:::.parseNomP(lines) + + expect_s3_class(result, "data.table") + expect_true(all(c("locus", "p_group", "reference_2f") %in% names(result))) + expect_true("A" %in% result$locus) + expect_true("B" %in% result$locus) +}) + +test_that(".parseNomP handles malformed lines gracefully", { + lines <- c( + "A*01:01/01:02;01:01P", # Valid + "invalid_line", # Invalid - no asterisk + ";;" # Empty + ) + + result <- deepMatchR:::.parseNomP(lines) + + # Should only have the valid line + expect_equal(nrow(result), 1) +}) + +# --- updateWmdaData Integration Tests (with mocking) --- + +test_that("updateWmdaData skips download when cache is current", { + temp_dir <- tempfile("wmda_update_test") + dir.create(temp_dir, recursive = TRUE) + + # Create mock cache with "Latest" version + cache_file <- file.path(temp_dir, "wmda_cache.rds") + version_file <- file.path(temp_dir, "wmda_version.txt") + + mock_data <- list( + serology = data.table::data.table(locus = "A*", allele_2f = "01:01", serology = "1"), + splits = data.table::data.table(locus = "A", broad = "9", splits = "23|24"), + pgroups = data.table::data.table(locus = "A", p_group = "01:01P", reference_2f = "01:01") + ) + saveRDS(mock_data, cache_file) + writeLines("Latest", version_file) + + expect_message( + updateWmdaData(version = "Latest", cache_dir = temp_dir, force = FALSE, verbose = TRUE), + "up to date" + ) + + unlink(temp_dir, recursive = TRUE) +}) + +test_that("updateWmdaData force parameter overrides cache check", { + temp_dir <- tempfile("wmda_force_test") + dir.create(temp_dir, recursive = TRUE) + + # Create mock cache + cache_file <- file.path(temp_dir, "wmda_cache.rds") + version_file <- file.path(temp_dir, "wmda_version.txt") + + mock_data <- list( + serology = data.table::data.table(locus = "A*", allele_2f = "01:01", serology = "1"), + splits = data.table::data.table(locus = "A", broad = "9", splits = "23"), + pgroups = data.table::data.table(locus = "A", p_group = "01:01P", reference_2f = "01:01") + ) + saveRDS(mock_data, cache_file) + writeLines("Latest", version_file) + + # With force=TRUE, it should attempt to download (and may fail due to network) + # We just verify it doesn't short-circuit + result <- tryCatch({ + updateWmdaData(version = "Latest", cache_dir = temp_dir, force = TRUE, verbose = FALSE) + "completed" + }, error = function(e) { + # Network error is expected in test environment + "network_error" + }) + + expect_true(result %in% c("completed", "network_error")) + + unlink(temp_dir, recursive = TRUE) +}) + +test_that("updateWmdaData creates cache directory if needed", +{ + temp_dir <- tempfile("wmda_newdir_test") + expect_false(dir.exists(temp_dir)) + + # This will fail due to network, but should create the directory first + tryCatch({ + updateWmdaData(version = "Latest", cache_dir = temp_dir, verbose = FALSE) + }, error = function(e) { + # Expected + }) + + expect_true(dir.exists(temp_dir)) + + unlink(temp_dir, recursive = TRUE) +}) + +test_that("updateWmdaData returns cache directory path invisibly", { + temp_dir <- tempfile("wmda_return_test") + dir.create(temp_dir, recursive = TRUE) + + # Create mock cache so it skips download + cache_file <- file.path(temp_dir, "wmda_cache.rds") + version_file <- file.path(temp_dir, "wmda_version.txt") + + mock_data <- list( + serology = data.table::data.table(locus = "A*", allele_2f = "01:01", serology = "1"), + splits = data.table::data.table(locus = "A", broad = "9", splits = "23"), + pgroups = data.table::data.table(locus = "A", p_group = "01:01P", reference_2f = "01:01") + ) + saveRDS(mock_data, cache_file) + writeLines("Latest", version_file) + + result <- updateWmdaData(version = "Latest", cache_dir = temp_dir, verbose = FALSE) + + expect_equal(result, temp_dir) + + unlink(temp_dir, recursive = TRUE) +}) + +# --- .loadWmdaData Tests --- + +test_that(".loadWmdaData returns list with required components", { + wmda_data <- deepMatchR:::.loadWmdaData() + + expect_type(wmda_data, "list") + expect_true(all(c("serology", "splits", "pgroups") %in% names(wmda_data))) +}) + +test_that(".loadWmdaData returns data.tables with correct keys", { + wmda_data <- deepMatchR:::.loadWmdaData() + + expect_s3_class(wmda_data$serology, "data.table") + expect_s3_class(wmda_data$splits, "data.table") + expect_s3_class(wmda_data$pgroups, "data.table") + + # Keys should be set + expect_true(data.table::haskey(wmda_data$serology)) + expect_true(data.table::haskey(wmda_data$splits)) + expect_true(data.table::haskey(wmda_data$pgroups)) +}) + +test_that(".loadWmdaData prefers cached data when available", { + temp_dir <- tempfile("wmda_load_test") + dir.create(temp_dir, recursive = TRUE) + + # Create mock cache with distinguishable data + cache_file <- file.path(temp_dir, "wmda_cache.rds") + + mock_data <- list( + serology = data.table::data.table( + locus = "TEST*", + allele_2f = "99:99", + serology = "TEST_SER" + ), + splits = data.table::data.table( + locus = "TEST", + broad = "99", + splits = "TEST_SPLIT" + ), + pgroups = data.table::data.table( + locus = "TEST", + p_group = "99:99P", + reference_2f = "99:99" + ) + ) + saveRDS(mock_data, cache_file) + + withr::with_envvar(c(DEEPMATCHR_CACHE_DIR = temp_dir), { + wmda_data <- deepMatchR:::.loadWmdaData() + expect_true("TEST*" %in% wmda_data$serology$locus) + }) + + unlink(temp_dir, recursive = TRUE) +}) + +# --- Version Handling Tests --- + +test_that("updateWmdaData handles specific version strings", { + temp_dir <- tempfile("wmda_version_test") + dir.create(temp_dir, recursive = TRUE) + + # Create cache with a specific version + cache_file <- file.path(temp_dir, "wmda_cache.rds") + version_file <- file.path(temp_dir, "wmda_version.txt") + + mock_data <- list( + serology = data.table::data.table(locus = "A*", allele_2f = "01:01", serology = "1"), + splits = data.table::data.table(locus = "A", broad = "9", splits = "23"), + pgroups = data.table::data.table(locus = "A", p_group = "01:01P", reference_2f = "01:01") + ) + saveRDS(mock_data, cache_file) + writeLines("3.54.0", version_file) + + # Request same version - should skip + expect_message( + updateWmdaData(version = "3.54.0", cache_dir = temp_dir, verbose = TRUE), + "up to date" + ) + + # Request different version - should attempt download + result <- tryCatch({ + updateWmdaData(version = "3.55.0", cache_dir = temp_dir, verbose = FALSE) + "completed" + }, error = function(e) { + "network_error" + }) + + expect_true(result %in% c("completed", "network_error")) + + unlink(temp_dir, recursive = TRUE) +})