Squash bug closer to the source

vimc · Feb 2, 2023 · 8ee1da0 · 8ee1da0
1 parent 3a4c51c
commit 8ee1da0
Show file tree

Hide file tree

Showing 2 changed files with 37 additions and 10 deletions.
diff --git a/R/orderly_version.R b/R/orderly_version.R
@@ -532,12 +532,14 @@ orderly_version <- R6::R6Class(
     bundle_run = function(recipe, info, echo = TRUE, envir = NULL) {
       private$recipe <- recipe
       private$envir <- orderly_environment(envir)
-      private$workdir <- recipe$path
+      ## We need to get the absolute path here so that the error
+      ## handling works as expected; it's quite possible that should
+      ## be done at the recipe level really.
+      private$workdir <- normalizePath(recipe$path, mustWork = TRUE)
       for (v in names(info)) {
         private[[v]] <- info[[v]]
       }
 
-      currentwd <- getwd()
       withCallingHandlers({
         ## Refetch the preflight info here: we want to keep git but
         ## replace everything else I think.  We might save the random
@@ -549,7 +551,6 @@ orderly_version <- R6::R6Class(
         self$run_execute(echo)
         self$run_cleanup()
       }, error = function(e) {
-        setwd(currentwd)
         self$run_failed_cleanup(e)
       })
     },

diff --git a/tests/testthat/test-bundle.R b/tests/testthat/test-bundle.R
@@ -326,25 +326,51 @@ test_that("Failure output written if a bundle fails", {
   on.exit(unlink(path, recursive = TRUE))
 
   # Make parameter less than zero cause a crash
-
   test_script <- file.path(path, "src", "other", "script.R")
   script <- readLines(test_script)
   script <- c("if (nmin < 0) stop('Invalid parameter')", script)
   writeLines(script, test_script)
 
   # Run a failing bundle
-
   path_bundles <- file.path(path, "bundles")
-  bundle <- orderly::orderly_bundle_pack(path_bundles, "other",
-                                         parameters = list(nmin = -1),
-                                         root = path)
+  bundle <- orderly_bundle_pack(path_bundles, "other",
+                                parameters = list(nmin = -1),
+                                root = path)
+  bundle_path <- file.path(path, "bundles", basename(bundle$path))
+  workdir <- tempfile()
+  expect_error(orderly_bundle_run(bundle_path, workdir, FALSE),
+               "Invalid parameter")
+
+  expect_true(file.exists(file.path(workdir, bundle$id, "pack",
+                                    "orderly_fail.rds")))
+})
+
+
+test_that("Failure output written if bundle fails in relative path", {
+  path <- test_prepare_orderly_example("demo")
+  on.exit(unlink(path, recursive = TRUE))
+
+  # Make parameter less than zero cause a crash
+  test_script <- file.path(path, "src", "other", "script.R")
+  script <- readLines(test_script)
+  script <- c("if (nmin < 0) stop('Invalid parameter')", script)
+  writeLines(script, test_script)
 
+  path_bundles <- file.path(path, "bundles")
+  bundle <- orderly_bundle_pack(path_bundles, "other",
+                                parameters = list(nmin = -1),
+                                root = path)
 
   bundle_path <- file.path(path, "bundles", basename(bundle$path))
+  workdir <- tempfile()
 
-  expect_error(orderly::orderly_bundle_run(bundle_path, "output"))
+  expect_error(
+    withr::with_dir(
+      dirname(workdir),
+      orderly_bundle_run(bundle_path, basename(workdir), echo = FALSE)),
+    "Invalid parameter")
 
-  expect_true(file.exists(file.path(getwd(), "output", bundle$id, "pack",
+  expect_true(file.exists(file.path(workdir, bundle$id, "pack",
                                     "orderly_fail.rds")))
 })