add tests and vectorize repair_path

- the vectorization of repair_path was just so that the tests for config_files are easier to write

R/utils.R

@@ -103,7 +103,7 @@ stanc_cmd <- function() {
 
 # paths and extensions ----------------------------------------------------
 
-# Replace `\\` with `/` in a path
+# Replace `\\` with `/` in a vector of paths
 # Needed for windows if CmdStan version is < 2.21:
 # https://github.com/stan-dev/cmdstanr/issues/1#issuecomment-539118598
 repair_path <- function(path) {
@@ -114,10 +114,8 @@ repair_path <- function(path) {
   path <- gsub("\\\\", "/", path)
   # WSL cmdstan path is a network path and needs the leading //
   path <- gsub("//(?!wsl)", "/", path, perl = TRUE)
-  if (endsWith(path, "/")) {
-    # remove trailing "/"
-    path <- substr(path, 1, nchar(path) - 1)
-  }
+  # remove trailing "/"
+  path <- gsub("/$","", path)
   path
 }
 

tests/testthat/test-model-output_dir.R

@@ -8,20 +8,23 @@ if (getRversion() < '3.5.0') {
 }
 if (!dir.exists(sandbox)) {
   dir.create(sandbox)
+  on.exit(unlink(sandbox, recursive = TRUE))
 }
 
 test_that("all fitting methods work with output_dir", {
   for (method in c("sample", "optimize", "variational")) {
     method_dir <- file.path(sandbox, method)
     if (!dir.exists(method_dir)) {
       dir.create(method_dir)
+      on.exit(unlink(method_dir, recursive = TRUE))
     }
 
     # WSL models use internal WSL tempdir
     if (!os_is_wsl()) {
       # no output_dir means should use tempdir
       fit <- testing_fit("bernoulli", method = method, seed = 123)
       expect_equal(fit$runset$args$output_dir, absolute_path(tempdir()))
+      files <- list.files(method_dir)
     }
     # specifying output_dir
     fit <- testing_fit("bernoulli", method = method, seed = 123,
@@ -30,7 +33,20 @@ test_that("all fitting methods work with output_dir", {
     # from the original tempdir(), so need to normalise both for comparison
     expect_equal(normalizePath(fit$runset$args$output_dir),
                  normalizePath(method_dir))
-    expect_equal(length(list.files(method_dir)), fit$num_procs())
+    files <- list.files(method_dir, full.names = TRUE)
+    # in 2.34.0 we also save the config files for all methods and the metric
+    # for sample
+    if (cmdstan_version() < "2.34.0") {
+      mult <- 1
+    } else if (method == "sample") {
+      mult <- 3
+      expect_equal(repair_path(files[grepl("metric", files)]), fit$metric_files())
+      expect_equal(repair_path(files[grepl("config", files)]), fit$config_files())
+    } else {
+      mult <- 2
+      expect_equal(repair_path(files[grepl("config", files)]), fit$config_files())
+    }
+    expect_equal(length(list.files(method_dir)), mult * fit$num_procs())
 
 
     # specifying output_dir
@@ -87,5 +103,7 @@ test_that("output_dir works with trailing /", {
   )
   expect_equal(normalizePath(fit$runset$args$output_dir),
                normalizePath(test_dir))
-  expect_equal(length(list.files(test_dir)), fit$num_procs())
+  # in 2.34.0 we also save the metric and config files
+  mult <- if (cmdstan_version() >= "2.34.0") 3 else 1
+  expect_equal(length(list.files(test_dir)), mult * fit$num_procs())
 })

tests/testthat/test-model-sample.R

@@ -32,7 +32,9 @@ ok_arg_values <- list(
   save_latent_dynamics = FALSE,
   init_buffer = 20,
   term_buffer = 0,
-  window = 15
+  window = 15,
+  save_metric = TRUE,
+  save_cmdstan_config = TRUE
 )
 
 # using any one of these should cause sample() to error
@@ -56,7 +58,9 @@ bad_arg_values <- list(
   save_latent_dynamics = "NOT_LOGICAL",
   init_buffer = "NOT_INTEGER",
   term_buffer = "NOT_INTEGER",
-  window = "NOT_INTEGER"
+  window = "NOT_INTEGER",
+  save_metric = "NOT_LOGICAL",
+  save_cmdstan_config = "NOT_LOGICAL"
 )
 
 bad_arg_values_2 <- list(

tests/testthat/test-utils.R

@@ -150,6 +150,10 @@ test_that("repair_path works with zero length path or non-string path", {
   expect_equal(repair_path(5), 5)
 })
 
+test_that("repair_path works with multiple paths", {
+  expect_equal(repair_path(c("a//b\\c/", "d\\e//f")), c("a/b/c", "d/e/f"))
+})
+
 test_that("list_to_array works with empty list", {
   expect_equal(list_to_array(list()), NULL)
 })