Fix truncation around the test suite

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)
+}

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(

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

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()),

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)