Merge pull request #325 from vimc/mrc-3949

Restore wd on bundle task failure

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly
 Title: Lightweight Reproducible Reporting
-Version: 1.6.0
+Version: 1.6.1
 Description: Order, create and store reports from R.  By defining a
     lightweight interface around the inputs and outputs of an
     analysis, a lot of the repetitive work for reproducible research

NEWS.md

@@ -1,3 +1,7 @@
+# orderly 1.6.1
+
+* Fix issue writing failure data from a failed orderly bundle.
+
 # orderly 1.5.0
 
 * Add `prepare_git_example_from_source` which can be used to generate a git controlled orderly directory

R/orderly_version.R

@@ -532,7 +532,10 @@ 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]]
       }

tests/testthat/test-bundle.R

@@ -321,6 +321,58 @@ test_that("failed bundle run writes out failed rds", {
                'stop\\("some error"\\)')
 })
 
+test_that("Failure output written if a bundle fails", {
+  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)
+
+  # Run a failing bundle
+  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_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(
+    withr::with_dir(
+      dirname(workdir),
+      orderly_bundle_run(bundle_path, basename(workdir), echo = FALSE)),
+    "Invalid parameter")
+
+  expect_true(file.exists(file.path(workdir, bundle$id, "pack",
+                                    "orderly_fail.rds")))
+})
 
 test_that("zip list helper safely lists", {
   skip_on_cran()