diff --git a/.github/workflows/r-tests.yml b/.github/workflows/r-tests.yml index f0801b2..f4d835a 100644 --- a/.github/workflows/r-tests.yml +++ b/.github/workflows/r-tests.yml @@ -66,9 +66,28 @@ jobs: - name: Install Linux runtime libraries if: runner.os == 'Linux' shell: bash + timeout-minutes: 10 run: | - sudo apt-get update - sudo apt-get install -y --no-install-recommends libglpk40 + for attempt in 1 2 3; do + echo "apt-get update attempt ${attempt}/3" + if sudo timeout --kill-after=10s 90s apt-get \ + -o Acquire::Retries=2 \ + -o Acquire::http::Timeout=20 \ + -o Acquire::https::Timeout=20 update; then + break + fi + if [ "$attempt" -eq 3 ]; then + echo "::error::apt-get update failed or timed out after 3 attempts" + exit 1 + fi + sleep 5 + done + + sudo timeout --kill-after=10s 180s apt-get \ + -o Acquire::Retries=2 \ + -o Acquire::http::Timeout=20 \ + -o Acquire::https::Timeout=20 \ + install -y --no-install-recommends libglpk40 - name: Restore renv environment uses: r-lib/actions/setup-renv@d3c5be51b12e724e68f33216ca3c148b66d5f0b6 # v2 diff --git a/R/analytical_workbook.R b/R/analytical_workbook.R index 2de1676..9d624a4 100644 --- a/R/analytical_workbook.R +++ b/R/analytical_workbook.R @@ -1544,7 +1544,8 @@ build_executive_summary <- function( score_threshold, string_version, louvain_seed, - fdr_threshold + fdr_threshold, + run_enrichment = TRUE ) { module_class <- analytical_vector_text( module_annotations$interpretation_class, @@ -1657,7 +1658,9 @@ build_executive_summary <- function( string_version, "; score_threshold=", score_threshold, - "; offline_enrichment=TRUE; FDR<=", + "; offline_enrichment=", + as.character(isTRUE(run_enrichment)), + "; FDR<=", fdr_threshold, "; Louvain_seed=", louvain_seed @@ -2202,7 +2205,8 @@ build_analytical_workbook <- function( biological_evidence, string_version = "12.0", louvain_seed = CANCERPPIR_LOUVAIN_SEED, - fdr_threshold = 0.05 + fdr_threshold = 0.05, + run_enrichment = TRUE ) { required_evidence_objects <- c( "module_annotations", @@ -2273,7 +2277,8 @@ build_analytical_workbook <- function( score_threshold = score_threshold, string_version = string_version, louvain_seed = louvain_seed, - fdr_threshold = fdr_threshold + fdr_threshold = fdr_threshold, + run_enrichment = run_enrichment ) network_overview <- build_network_overview( diff --git a/R/pipeline.R b/R/pipeline.R index e53c3e4..f9839b5 100644 --- a/R/pipeline.R +++ b/R/pipeline.R @@ -1007,7 +1007,8 @@ run_cancerppir <- function( biological_evidence = biological_evidence, string_version = "12.0", louvain_seed = CANCERPPIR_LOUVAIN_SEED, - fdr_threshold = 0.05 + fdr_threshold = 0.05, + run_enrichment = run_enrichment ) analytical_sheets <- analytical_report$sheets diff --git a/scripts/README.md b/scripts/README.md index d16718a..fa1d0ba 100644 --- a/scripts/README.md +++ b/scripts/README.md @@ -28,7 +28,7 @@ still does not run the seven-case production regression. Individual commands remain available for focused diagnosis: - `run_unit_tests.R` — complete unit and CLI test suite. -- `run_smoke_test.R` — single-case smoke validation. +- `run_smoke_test.R` — bundled synthetic end-to-end smoke validation. - `validate_documentation_contract.R` — documentation contract. - `validate_reproducibility_contract.R` — pinned software-environment contract. - `validate_release_contract.R` — static release contract. @@ -36,6 +36,17 @@ Individual commands remain available for focused diagnosis: audit. - `validate_repository_quality.R` — repository and CI hygiene gate. +Run one complete non-clinical analysis against an existing STRING v12 cache: + +```bash +Rscript scripts/run_smoke_test.R STRING_CACHE OUTPUT_ROOT +``` + +Both paths must be outside the repository, and all required STRING resources +must already exist. The command validates all six outputs, workbook schemas, +GraphML, versioned provenance, checksums, and mapping metadata without running +any of the seven clinical release cases. + ## Release qualification - `run_release_qualification.R` — final seven-case release gate. diff --git a/scripts/run_smoke_test.R b/scripts/run_smoke_test.R index 18b45ff..18cd0d1 100644 --- a/scripts/run_smoke_test.R +++ b/scripts/run_smoke_test.R @@ -1,259 +1,266 @@ #!/usr/bin/env Rscript -# Run one local end-to-end R01 smoke test and compare it with the -# qualified reference baseline. -# -# Optional positional arguments: -# 1 baseline_root -# 2 input_file -# 3 cache_dir -# 4 results_root -# -# Default invocation from the repository root: -# Rscript scripts/run_smoke_test.R - -project_root <- normalizePath( - ".", - winslash = "/", - mustWork = TRUE -) +# Run one synthetic, non-clinical end-to-end analysis using an existing +# STRING v12 cache and verify the current public output contracts. -arguments <- commandArgs( - trailingOnly = TRUE +arguments <- commandArgs(trailingOnly = TRUE) +usage <- paste( + "CancerPPIr synthetic end-to-end smoke test", + "", + "Usage:", + " Rscript scripts/run_smoke_test.R STRING_CACHE OUTPUT_ROOT", + "", + "Uses examples/minimal_input.csv and never runs clinical cases.", + "STRING_CACHE and OUTPUT_ROOT must be outside the repository.", + "All four pinned STRING v12 resources must already be cached.", + sep = "\n" ) -baseline_root <- if (length(arguments) >= 1L) { - arguments[[1L]] -} else { - file.path("..", "results", "reference_baseline_v1") +if (length(arguments) == 1L && arguments[[1L]] %in% c("--help", "-h")) { + cat(usage, "\n") + quit(save = "no", status = 0L) } -input_file <- if (length(arguments) >= 2L) { - arguments[[2L]] -} else { - file.path("..", "input", "Genes_R.csv") +if (length(arguments) != 2L) { + stop(usage, call. = FALSE) } -cache_dir <- if (length(arguments) >= 3L) { - arguments[[3L]] -} else { - file.path("..", "string_cache") +project_root <- normalizePath(".", winslash = "/", mustWork = TRUE) +cache_dir <- normalizePath(arguments[[1L]], winslash = "/", mustWork = FALSE) +results_root <- normalizePath(arguments[[2L]], winslash = "/", mustWork = FALSE) +input_file <- file.path(project_root, "examples", "minimal_input.csv") + +if (!file.exists(input_file)) { + stop("Bundled synthetic example is missing: ", input_file, call. = FALSE) } -results_root <- if (length(arguments) >= 4L) { - arguments[[4L]] -} else { - file.path("..", "results", "r01_smoke_validation") +if (!dir.exists(cache_dir)) { + stop("STRING cache directory does not exist: ", cache_dir, call. = FALSE) } -required_paths <- c( - baseline_root, - input_file, - cache_dir -) +if (file.exists(results_root)) { + stop("Smoke-test output root already exists: ", results_root, call. = FALSE) +} + +path_is_within_project <- function(path) { + root <- project_root -missing_paths <- required_paths[ - !file.exists(required_paths) + if (identical(.Platform$OS.type, "windows")) { + root <- tolower(root) + path <- tolower(path) + } + + identical(path, root) || startsWith(path, paste0(root, "/")) +} + +if (path_is_within_project(cache_dir) || path_is_within_project(results_root)) { + stop( + "STRING_CACHE and OUTPUT_ROOT must be outside the repository.", + call. = FALSE + ) +} + +required_packages <- c("openxlsx", "igraph", "jsonlite", "digest") +missing_packages <- required_packages[ + !vapply(required_packages, requireNamespace, logical(1), quietly = TRUE) ] -if (length(missing_paths) > 0L) { +if (length(missing_packages)) { stop( - paste0( - "Required smoke-test paths are missing:\n", - paste0("- ", missing_paths, collapse = "\n") - ), + "Smoke test requires package(s): ", + paste(missing_packages, collapse = ", "), call. = FALSE ) } -if (dir.exists(results_root)) { +source(file.path(project_root, "R", "load_all.R"), local = .GlobalEnv) +load_cancerppir_modules(project_root = project_root, envir = .GlobalEnv) + +example_input <- read_gene_table(input_file) +resource_manifest <- cancerppir_string_v12_resource_manifest(cache_dir) +invalid_resources <- resource_manifest$filename[!resource_manifest$valid] + +if (length(invalid_resources)) { stop( - paste0( - "Smoke-test output folder already exists: ", - results_root, - "\nRemove it or provide a different fourth argument." - ), + "Smoke test will not download missing or invalid STRING resources: ", + paste(invalid_resources, collapse = ", "), call. = FALSE ) } -dir.create( - file.path(results_root, "logs"), - recursive = TRUE, - showWarnings = FALSE -) +logs_dir <- file.path(results_root, "logs") -log_file <- file.path( - results_root, - "logs", - "R01.log" -) +if (!dir.create(logs_dir, recursive = TRUE, showWarnings = FALSE)) { + stop("Could not create smoke-test output root: ", results_root, call. = FALSE) +} -rscript <- Sys.which( - "Rscript" +case_id <- "SMOKE01" +log_file <- file.path(logs_dir, paste0(case_id, ".log")) +rscript <- file.path( + R.home("bin"), + if (.Platform$OS.type == "windows") "Rscript.exe" else "Rscript" ) +message("[CancerPPIr smoke] Running one bundled synthetic case.") + pipeline_status <- system2( command = rscript, args = c( - shQuote( - file.path(project_root, "cancerppir.R") - ), + shQuote(file.path(project_root, "cancerppir.R")), shQuote(input_file), shQuote(results_root), shQuote(cache_dir), "400", "30", - "TRUE" + "TRUE", + "--case-id", + case_id ), stdout = log_file, - stderr = log_file -) - -if (!identical(as.integer(pipeline_status), 0L)) { - stop( - paste0( - "R01 smoke pipeline failed with exit code ", - pipeline_status, - ". See: ", - log_file - ), - call. = FALSE - ) -} - -log_lines <- readLines( - log_file, - warn = FALSE, - encoding = "UTF-8" + stderr = log_file, + wait = TRUE ) -required_log_fragments <- c( - "[CancerPPIr] Done.", - "[CancerPPIr] Mapped genes: 359/399 (90%)", - "[CancerPPIr] Network: 358 nodes, 4507 edges, 42 components" -) +if (is.null(pipeline_status) || is.na(pipeline_status) || pipeline_status != 0L) { + log_tail <- if (file.exists(log_file)) { + tail(readLines(log_file, warn = FALSE, encoding = "UTF-8"), 40L) + } else { + "Pipeline log was not created." + } -missing_log_fragments <- required_log_fragments[ - !vapply( - required_log_fragments, - function(fragment) { - any(grepl( - fragment, - log_lines, - fixed = TRUE - )) - }, - FUN.VALUE = logical(1) - ) -] - -if (length(missing_log_fragments) > 0L) { stop( - paste0( - "Smoke log is missing required completion evidence:\n", - paste0("- ", missing_log_fragments, collapse = "\n") - ), + "Synthetic smoke pipeline failed with exit status ", + pipeline_status, + ".\n\nLog tail:\n", + paste(log_tail, collapse = "\n"), call. = FALSE ) } -error_patterns <- c( - "Error", - "failed", - "Execution halted", - "Выполнение остановлено" +case_dir <- file.path(results_root, case_id) +output_names <- c( + "CancerPPIr_Analytical_Report.xlsx", + "CancerPPIr_Technical_Report.xlsx", + "Network_for_Cytoscape.graphml", + "STRING_links.txt", + "CancerPPIr_Output_Manifest.json", + "CancerPPIr_Output_Checksums.sha256" ) +output_paths <- file.path(case_dir, output_names) +missing_outputs <- output_names[!file.exists(output_paths)] -if (any(vapply( - error_patterns, - function(pattern) { - any(grepl( - pattern, - log_lines, - ignore.case = TRUE - )) - }, - FUN.VALUE = logical(1) -))) { +if (length(missing_outputs)) { stop( - paste0( - "Smoke log contains an error marker. See: ", - log_file - ), + "Synthetic smoke case did not create required output(s): ", + paste(missing_outputs, collapse = ", "), call. = FALSE ) } -expected_files <- file.path( - results_root, - "Genes_R", - c( - "CancerPPIr_Analytical_Report.xlsx", - "CancerPPIr_Technical_Report.xlsx", - "Network_for_Cytoscape.graphml", - "STRING_links.txt" - ) +analytical_file <- file.path(case_dir, output_names[[1L]]) +technical_file <- file.path(case_dir, output_names[[2L]]) +graph_file <- file.path(case_dir, output_names[[3L]]) +manifest_file <- file.path(case_dir, output_names[[5L]]) +checksum_file <- file.path(case_dir, output_names[[6L]]) + +log_lines <- readLines(log_file, warn = FALSE, encoding = "UTF-8") +graph <- igraph::read_graph(graph_file, format = "graphml") +manifest <- jsonlite::read_json(manifest_file, simplifyVector = FALSE) +technical_sheets <- openxlsx::getSheetNames(technical_file) +technical_nodes <- openxlsx::read.xlsx(technical_file, sheet = "Node annotations") +technical_mapping <- openxlsx::read.xlsx(technical_file, sheet = "Mapping summary") +mapping_values <- stats::setNames( + as.character(technical_mapping$value), + as.character(technical_mapping$metric) +) +analytical_summary <- openxlsx::read.xlsx(analytical_file, sheet = "Executive summary") +run_configuration <- analytical_summary$value[ + analytical_summary$item == "run_configuration" +] +provenance <- cancerppir_validate_output_provenance( + manifest_file = manifest_file, + checksums_file = checksum_file, + output_dir = case_dir, + forbidden_paths = c(project_root, cache_dir, results_root) ) -if (!all(file.exists(expected_files))) { - stop( - paste0( - "Smoke test did not produce all expected files:\n", - paste0( - "- ", - expected_files[!file.exists(expected_files)], - collapse = "\n" - ) +checks <- c( + current_completion_marker = cancerppir_log_has_completion_marker(log_lines), + expected_example_input_rows = nrow(example_input) == 20L, + analytical_sheet_order = identical( + openxlsx::getSheetNames(analytical_file), + CANCERPPIR_ANALYTICAL_SHEET_NAMES + ), + canonical_technical_sheets = all( + c( + "Module annotations", + "Rule evidence", + "Significant terms", + "Node annotations", + "Validation" + ) %in% technical_sheets + ), + graph_has_nodes_and_edges = igraph::vcount(graph) > 0L && + igraph::ecount(graph) > 0L, + graph_node_count_matches_workbook = + igraph::vcount(graph) == nrow(technical_nodes), + canonical_graphml_attributes = all( + canonical_graphml_attribute_names() %in% igraph::vertex_attr_names(graph) + ), + manifest_product_version = identical( + as.character(manifest$software$version), + cancerppir_product_version(project_root) + ), + manifest_pseudonymous_case_id = + identical(as.character(manifest$input$case_id), case_id) && + identical(as.character(manifest$input$case_id_source), "explicit_case_id"), + manifest_input_checksum = identical( + tolower(as.character(manifest$input$sha256)), + cancerppir_sha256_file(input_file) + ), + manifest_network_summary = + identical( + as.integer(manifest$summary$network_nodes), + as.integer(igraph::vcount(graph)) + ) && + identical( + as.integer(manifest$summary$network_edges), + as.integer(igraph::ecount(graph)) ), - call. = FALSE - ) -} - -comparison_status <- system2( - command = rscript, - args = c( - shQuote( - file.path( - project_root, - "tools", "development", "reproducibility", "compare_reference_case.R" - ) + collision_counts_match = + identical( + as.integer(mapping_values[["STRING_mapping_collision_proteins"]]), + as.integer(manifest$input$STRING_mapping_collision_proteins) + ) && + identical( + as.integer(mapping_values[["STRING_mapping_collision_rows_dropped"]]), + as.integer(manifest$input$STRING_mapping_collision_rows_dropped) ), - shQuote(baseline_root), - shQuote(results_root), - "R01", - "Genes_R", - "r01_smoke_validation" - ) + enrichment_mode_matches_manifest = + isTRUE(manifest$analysis$local_enrichment_enabled) && + length(run_configuration) == 1L && + grepl("offline_enrichment=TRUE", run_configuration, fixed = TRUE), + provenance_checks_pass = all(provenance$status == "PASS") +) + +validation <- data.frame( + check_id = names(checks), + status = ifelse(checks, "PASS", "FAIL"), + stringsAsFactors = FALSE ) -if (!identical(as.integer(comparison_status), 0L)) { +print(validation, row.names = FALSE) + +if (!all(checks)) { stop( - paste0( - "R01 baseline comparison failed with exit code ", - comparison_status, - "." - ), + "Synthetic smoke validation failed: ", + paste(names(checks)[!checks], collapse = ", "), call. = FALSE ) } -summary_file <- file.path( - results_root, - "comparison", - "r01_smoke_validation_summary.csv" -) - -summary_table <- utils::read.csv( - summary_file, - stringsAsFactors = FALSE -) - -stopifnot( - nrow(summary_table) == 1L, - isTRUE(summary_table$strict_regression_core_match[[1L]]), - summary_table$strict_sheets_compared[[1L]] == 12L, - summary_table$strict_sheets_identical[[1L]] == 12L +cat( + "\nCANCERPPIR SYNTHETIC SMOKE TEST: PASSED\n", + "Output: ", normalizePath(case_dir, winslash = "/"), "\n", + sep = "" ) - -cat("CANCERPPIR R01 SMOKE TEST PASSED: 12/12 STRICT SHEETS\n") diff --git a/tests/testthat/test-analytical-workbook.R b/tests/testthat/test-analytical-workbook.R index d0f49d3..3e7cc89 100644 --- a/tests/testthat/test-analytical-workbook.R +++ b/tests/testthat/test-analytical-workbook.R @@ -676,6 +676,39 @@ testthat::test_that( } ) +testthat::test_that( + "executive summary records the actual enrichment mode", + { + fixture <- analytical_workbook_test_fixture() + + for (enabled in c(TRUE, FALSE)) { + report <- build_analytical_workbook( + input_rows = 10L, + mapped_proteins = 6L, + unmapped_input_rows = 4L, + mapping_rate_percent = 60, + graph_summary = fixture$graph_summary, + score_threshold = 400L, + top_n = 6L, + degree_distribution = fixture$degree_distribution, + biological_evidence = fixture$biological_evidence, + run_enrichment = enabled + ) + + summary <- report$sheets[["Executive summary"]] + configuration <- summary$value[ + summary$item == "run_configuration" + ] + + testthat::expect_match( + configuration, + paste0("offline_enrichment=", as.character(enabled)), + fixed = TRUE + ) + } + } +) + testthat::test_that( "candidate score components reconstruct the production score", { diff --git a/tests/testthat/test-pipeline-integration.R b/tests/testthat/test-pipeline-integration.R new file mode 100644 index 0000000..b08837a --- /dev/null +++ b/tests/testthat/test-pipeline-integration.R @@ -0,0 +1,157 @@ +cancerppir_write_synthetic_gzip <- function(path, lines) { + connection <- gzfile(path, open = "wt", encoding = "UTF-8") + on.exit(close(connection), add = TRUE) + writeLines(lines, connection, useBytes = TRUE) +} + +testthat::test_that( + "synthetic STRING resources exercise the complete production pipeline", + { + required_packages <- c( + "HGNChelper", "STRINGdb", "igraph", "openxlsx", "dplyr", + "tibble", "curl", "sna", "jsonlite", "digest" + ) + + for (package in required_packages) { + testthat::skip_if_not_installed(package) + } + + fixture_root <- tempfile(pattern = "cancerppir_pipeline_integration_") + cache_dir <- file.path(fixture_root, "string_cache") + results_root <- file.path(fixture_root, "results") + dir.create(cache_dir, recursive = TRUE) + + on.exit(unlink(fixture_root, recursive = TRUE, force = TRUE), add = TRUE) + + genes <- c( + "CDK1", "CCNB1", "TOP2A", "CDC20", "BIRC5", "AURKB", + "PTPRC", "TYROBP", "HLA-DRA", "CD74", "C1QA", "C1QB" + ) + protein_ids <- paste0("9606.ENSPTEST", sprintf("%04d", seq_along(genes))) + + cancerppir_write_synthetic_gzip( + file.path(cache_dir, "9606.protein.info.v12.0.txt.gz"), + c( + "#string_protein_id\tpreferred_name\tprotein_size\tannotation", + paste(protein_ids, genes, "100", "Synthetic protein", sep = "\t") + ) + ) + + alias_ids <- c(protein_ids, protein_ids[[6L]]) + alias_genes <- c(genes, "AURKA") + + cancerppir_write_synthetic_gzip( + file.path(cache_dir, "9606.protein.aliases.v12.0.txt.gz"), + c( + "#string_protein_id\talias\tsource", + paste(alias_ids, alias_genes, "Ensembl_HGNC_symbol", sep = "\t") + ) + ) + + first_clique <- utils::combn(protein_ids[1:6], 2L) + second_clique <- utils::combn(protein_ids[7:12], 2L) + edges <- cbind( + first_clique, + second_clique, + c(protein_ids[[1L]], protein_ids[[7L]]) + ) + + cancerppir_write_synthetic_gzip( + file.path(cache_dir, "9606.protein.links.v12.0.txt.gz"), + c( + "protein1 protein2 combined_score", + paste(edges[1L, ], edges[2L, ], "900") + ) + ) + + term_ids <- rep(c("GO:SYNTHETIC_CELL", "GO:SYNTHETIC_IMMUNE"), each = 6L) + term_names <- rep(c("mitotic cell cycle", "immune response"), each = 6L) + + cancerppir_write_synthetic_gzip( + file.path(cache_dir, "9606.protein.enrichment.terms.v12.0.txt.gz"), + c( + "#string_protein_id\tcategory\tterm\tdescription", + paste( + protein_ids, + "Biological Process (Gene Ontology)", + term_ids, + term_names, + sep = "\t" + ) + ) + ) + + input_file <- file.path(fixture_root, "synthetic_input.csv") + utils::write.csv( + data.frame( + gene = alias_genes, + logFC = c(seq(2.4, 1.3, length.out = 12L), 3), + pvalue = c(seq(0.001, 0.012, length.out = 12L), 1e-8), + stringsAsFactors = FALSE + ), + input_file, + row.names = FALSE, + quote = TRUE + ) + + result <- suppressMessages( + run_cancerppir( + input_file = input_file, + results_root = results_root, + cache_dir = cache_dir, + score_threshold = 400L, + top_n = 12L, + run_enrichment = TRUE, + case_id = "SYNTHETIC01" + ) + ) + + expected_files <- c( + "CancerPPIr_Analytical_Report.xlsx", + "CancerPPIr_Technical_Report.xlsx", + "Network_for_Cytoscape.graphml", + "STRING_links.txt", + "CancerPPIr_Output_Manifest.json", + "CancerPPIr_Output_Checksums.sha256" + ) + + testthat::expect_s3_class(result, "cancerppir_result") + testthat::expect_true(all(file.exists(file.path(result$output_dir, expected_files)))) + + graph <- igraph::read_graph( + file.path(result$output_dir, "Network_for_Cytoscape.graphml"), + format = "graphml" + ) + manifest <- jsonlite::read_json( + file.path(result$output_dir, "CancerPPIr_Output_Manifest.json"), + simplifyVector = FALSE + ) + + testthat::expect_identical(as.integer(igraph::vcount(graph)), 12L) + testthat::expect_identical(as.integer(manifest$input$input_rows), 13L) + testthat::expect_identical(as.integer(manifest$input$unique_mapped_proteins), 12L) + testthat::expect_identical( + as.integer(manifest$input$STRING_mapping_collision_proteins), + 1L + ) + testthat::expect_identical( + as.integer(manifest$input$STRING_mapping_collision_rows_dropped), + 1L + ) + testthat::expect_identical(as.character(manifest$input$case_id), "SYNTHETIC01") + testthat::expect_identical( + as.character(manifest$software$version), + cancerppir_product_version() + ) + + provenance <- cancerppir_validate_output_provenance( + manifest_file = file.path(result$output_dir, expected_files[[5L]]), + checksums_file = file.path(result$output_dir, expected_files[[6L]]), + output_dir = result$output_dir, + forbidden_paths = c(cache_dir, results_root) + ) + + testthat::expect_true(all(provenance$status == "PASS")) + testthat::expect_true(any(result$biological_evidence$validation$status == "PASS")) + } +) diff --git a/tests/testthat/test-smoke-validation.R b/tests/testthat/test-smoke-validation.R new file mode 100644 index 0000000..b6a12b0 --- /dev/null +++ b/tests/testthat/test-smoke-validation.R @@ -0,0 +1,86 @@ +testthat::test_that( + "supported smoke command uses a synthetic current-contract workflow", + { + project_root <- Sys.getenv("CANCERPPIR_PROJECT_ROOT") + script <- file.path(project_root, "scripts", "run_smoke_test.R") + output <- suppressWarnings( + system2( + command = Sys.which("Rscript"), + args = c(shQuote(script), "--help"), + stdout = TRUE, + stderr = TRUE + ) + ) + status <- attr(output, "status") + + if (is.null(status)) status <- 0L + + testthat::expect_identical(as.integer(status), 0L) + testthat::expect_true( + any(grepl("STRING_CACHE OUTPUT_ROOT", output, fixed = TRUE)) + ) + testthat::expect_true( + any(grepl("never runs clinical cases", output, fixed = TRUE)) + ) + + source_text <- paste( + readLines(script, warn = FALSE, encoding = "UTF-8"), + collapse = "\n" + ) + + testthat::expect_true( + grepl( + "cancerppir_log_has_completion_marker(log_lines)", + source_text, + fixed = TRUE + ) + ) + testthat::expect_false( + grepl("compare_reference_case.R", source_text, fixed = TRUE) + ) + testthat::expect_false( + grepl("Genes_R.csv", source_text, fixed = TRUE) + ) + } +) + +testthat::test_that( + "historical reference comparison accepts current timed completion logs", + { + project_root <- Sys.getenv("CANCERPPIR_PROJECT_ROOT") + script <- file.path( + project_root, + "tools", + "development", + "reproducibility", + "compare_reference_case.R" + ) + expressions <- parse(script, keep.source = FALSE) + matches <- vapply( + expressions, + function(expression) { + is.call(expression) && + identical(as.character(expression[[1L]]), "<-") && + identical(as.character(expression[[2L]]), "log_completed") + }, + logical(1) + ) + + testthat::expect_equal(sum(matches), 1L) + + isolated <- new.env(parent = baseenv()) + eval(expressions[[which(matches)]], envir = isolated) + + log_path <- tempfile(fileext = ".log") + on.exit(unlink(log_path), add = TRUE) + + writeLines("[CancerPPIr] [+00:00:03] Done.", log_path) + testthat::expect_true(isolated$log_completed(log_path)) + + writeLines("[CancerPPIr] Done.", log_path) + testthat::expect_true(isolated$log_completed(log_path)) + + writeLines("[CancerPPIr] [+00:00:03] Not done.", log_path) + testthat::expect_false(isolated$log_completed(log_path)) + } +) diff --git a/tools/development/reproducibility/compare_reference_case.R b/tools/development/reproducibility/compare_reference_case.R index 6a0726b..013c8a6 100644 --- a/tools/development/reproducibility/compare_reference_case.R +++ b/tools/development/reproducibility/compare_reference_case.R @@ -413,9 +413,13 @@ log_completed <- function(path) { any( grepl( - "[CancerPPIr] Done.", + paste0( + "^\\[CancerPPIr\\]", + "(?: \\[\\+[0-9]+:[0-9]{2}:[0-9]{2}\\])?", + " Done\\.$" + ), lines, - fixed = TRUE + perl = TRUE ) ) } @@ -983,4 +987,4 @@ message( message( "[reference comparison] Strict regression core passed." -) \ No newline at end of file +)