diff --git a/R/utils.R b/R/utils.R index 9764ec36..2420fd69 100644 --- a/R/utils.R +++ b/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 } diff --git a/tests/testthat/test-model-output_dir.R b/tests/testthat/test-model-output_dir.R index 4870051c..9160e019 100644 --- a/tests/testthat/test-model-output_dir.R +++ b/tests/testthat/test-model-output_dir.R @@ -8,6 +8,7 @@ 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", { @@ -15,6 +16,7 @@ test_that("all fitting methods work with output_dir", { 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 @@ -22,6 +24,7 @@ test_that("all fitting methods work with output_dir", { # 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()) }) diff --git a/tests/testthat/test-model-sample.R b/tests/testthat/test-model-sample.R index dbb691d0..67af824e 100644 --- a/tests/testthat/test-model-sample.R +++ b/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( diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 180f7ded..6beedc4f 100644 --- a/tests/testthat/test-utils.R +++ b/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) })