From 85f8b4014291eef887a2d48bb13e9b34b1716ef0 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Thu, 30 May 2024 18:33:05 +0100 Subject: [PATCH] Fix truncation around the test suite --- tests/testthat/helper-outpack.R | 5 +++++ tests/testthat/test-location.R | 3 ++- tests/testthat/test-outpack-packet.R | 9 ++------- tests/testthat/test-run.R | 2 +- tests/testthat/test-validate.R | 15 +++++++++------ 5 files changed, 19 insertions(+), 15 deletions(-) diff --git a/tests/testthat/helper-outpack.R b/tests/testthat/helper-outpack.R index 12eff2a5..14f87981 100644 --- a/tests/testthat/helper-outpack.R +++ b/tests/testthat/helper-outpack.R @@ -174,3 +174,8 @@ outpack_packet_start_quietly <- function(...) { outpack_packet_end_quietly <- function(...) { suppressMessages(outpack_packet_end(...)) } + +forcibly_truncate_file <- function(path) { + fs::file_chmod(path, "a+w") + file.create(path) +} diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index 9f260cf4..bf9ebb6f 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -433,7 +433,8 @@ test_that("detect and avoid modified files in source repository", { orderly_location_pull_metadata(root = root$dst) ## Corrupt the file in the first id by truncating it: - file.create(file.path(root$src$path, "archive", "data", id[[1]], "a.rds")) + forcibly_truncate_file( + file.path(root$src$path, "archive", "data", id[[1]], "a.rds")) ## Then pull res <- testthat::evaluate_promise( diff --git a/tests/testthat/test-outpack-packet.R b/tests/testthat/test-outpack-packet.R index b0e7e359..faa158f1 100644 --- a/tests/testthat/test-outpack-packet.R +++ b/tests/testthat/test-outpack-packet.R @@ -268,13 +268,8 @@ test_that("validate dependencies from archive", { outpack_packet_run(p1, "script.R") outpack_packet_end_quietly(p1) - # Change the value here. The archive is intentionally read-only, so chmod it - # first. - data_path <- file.path(root$path, "archive", "a", id1, "data.csv") - fs::file_chmod(data_path, "a+w") - write.csv(data.frame(x = 1:10, y = runif(10)), - data_path, - row.names = FALSE) + ## Corrupt the file here. + forcibly_truncate_file(file.path(root$path, "archive", "a", id1, "data.csv")) p2 <- outpack_packet_start_quietly(path_src2, "b", root = root) id2 <- p2$id diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R index dcad6f34..a0f3ff7c 100644 --- a/tests/testthat/test-run.R +++ b/tests/testthat/test-run.R @@ -1191,7 +1191,7 @@ test_that("cope with corrupted packets, exclude from deps", { }) id <- ids[[3]] - file.create(file.path(path, "archive", "data", id, "data.rds")) # truncate + forcibly_truncate_file(file.path(path, "archive", "data", id, "data.rds")) err <- expect_error( orderly_run_quietly("depends", root = path, envir = new.env()), diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index 23e366d8..9dd14428 100644 --- a/tests/testthat/test-validate.R +++ b/tests/testthat/test-validate.R @@ -11,7 +11,7 @@ test_that("Can validate a packet that is invalid", { root <- create_temporary_root() id <- create_random_packet(root = root) path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise(orderly_validate_archive(id, root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE) expect_equal(res$result, id) @@ -25,7 +25,7 @@ test_that("Can orphan an invalid packet", { ids <- replicate(3, create_random_packet(root = root)) id <- ids[[2]] path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise( orderly_validate_archive(id, action = "orphan", root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE) @@ -41,7 +41,7 @@ test_that("Can delete an invalid packet", { ids <- replicate(3, create_random_packet(root = root)) id <- ids[[2]] path <- file.path(root$path, "archive", "data", id, "data.rds") - file.create(path) # truncate file + forcibly_truncate_file(path) res <- evaluate_promise( orderly_validate_archive(action = "delete", root = root)) expect_match(res$messages, sprintf("%s (data) is invalid", id), fixed = TRUE, @@ -65,7 +65,8 @@ test_that("recursively validate, errors in upstream are a problem", { root <- create_temporary_root(require_complete_tree = TRUE) ids <- create_random_packet_chain(5, root = root) - file.create(file.path(root$path, "archive", "c", ids[["c"]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "c", ids[["c"]], "data.rds")) res <- evaluate_promise( orderly_validate_archive(ids[["d"]], root = root)) @@ -108,7 +109,8 @@ test_that("invalidate all children of corrupt parent", { evaluate_promise(orderly_validate_archive(id3, root = root)), res) - file.create(file.path(root$path, "archive", "child", id2[[1]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "child", id2[[1]], "data.rds")) res <- evaluate_promise(orderly_validate_archive(id3, root = root)) expect_match(res$messages[c(1, 3, 4)], re, all = TRUE) expect_match(res$messages[[2]], @@ -137,7 +139,8 @@ test_that("don't invalidate children when complete tree off", { expect_length(res$messages, 1) ## We no longer know, or care, if this is invalid due to children - file.create(file.path(root$path, "archive", "child", id2[[1]], "data.rds")) + forcibly_truncate_file( + file.path(root$path, "archive", "child", id2[[1]], "data.rds")) expect_equal( evaluate_promise(orderly_validate_archive(id3, root = root)), res)