Merge pull request #1043 from stan-dev/reduce-test-output

Reduce console output in tests

Author: jgabry

tests/testthat/test-fit-init.R

@@ -5,6 +5,7 @@ set_cmdstan_path()
 data_list_schools <- testing_data("schools")
 data_list_logistic <- testing_data("logistic")
 test_inits <- function(mod, fit_init, data_list = NULL) {
+ utils::capture.output({
   fit_sample <- mod$sample(data = data_list, chains = 1, init = fit_init,
     iter_sampling = 100, iter_warmup = 100, refresh = 0, seed = 1234)
   fit_sample_multi <- mod$sample(data = data_list, chains = 5, init = fit_init,
@@ -20,6 +21,7 @@ test_inits <- function(mod, fit_init, data_list = NULL) {
   draws = posterior::as_draws_rvars(fit_init$draws())
   fit_sample_draws <- mod$sample(data = data_list, chains = 1, init = draws,
     iter_sampling = 100, iter_warmup = 100, refresh = 0, seed = 1234)
+ })
   return(0)
 }
 

tests/testthat/test-fit-laplace.R

@@ -1,4 +1,4 @@
-context("fitted-vb")
+context("fitted-laplace")
 
 set_cmdstan_path()
 fit_laplace <- testing_fit("logistic", method = "laplace", seed = 100)

tests/testthat/test-fit-shared.R

@@ -454,23 +454,27 @@ test_that("draws are returned for model with spaces", {
 test_that("sampling with inits works with include_paths", {
   stan_program_w_include <- testing_stan_file("bernoulli_include")
   exe <- cmdstan_ext(strip_ext(stan_program_w_include))
-  if(file.exists(exe)) {
+  if (file.exists(exe)) {
     file.remove(exe)
   }
 
-    mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, quiet = FALSE,
-                                   include_paths = test_path("resources", "stan"))
+  mod_w_include <- cmdstan_model(stan_file = stan_program_w_include,
+                                 include_paths = test_path("resources", "stan"))
 
   data_list <- list(N = 10, y = c(0,1,0,0,0,0,0,0,0,1))
-
-  fit <- mod_w_include$sample(
-    data = data_list,
-    seed = 123,
-    chains = 4,
-    parallel_chains = 4,
-    refresh = 500,
-    init = list(list(theta = 0.25), list(theta = 0.25), list(theta = 0.25), list(theta = 0.25))
-  )
+  expect_no_error(utils::capture.output(
+    fit <- mod_w_include$sample(
+      data = data_list,
+      seed = 123,
+      chains = 4,
+      parallel_chains = 4,
+      refresh = 500,
+      init = list(list(theta = 0.25),
+                  list(theta = 0.25),
+                  list(theta = 0.25),
+                  list(theta = 0.25))
+    )
+  ))
 })
 
 test_that("CmdStanModel created with exe_file works", {
@@ -548,8 +552,12 @@ test_that("code() warns if model not created with Stan file", {
   stan_program <- testing_stan_file("bernoulli")
   mod <- testing_model("bernoulli")
   mod_exe <- cmdstan_model(exe_file = mod$exe_file())
-  fit_exe <- mod_exe$sample(data = list(N = 10, y = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1)),
-                            refresh = 0)
+  utils::capture.output(
+    fit_exe <- mod_exe$sample(
+      data = list(N = 10, y = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1)),
+      refresh = 0
+    )
+  )
   expect_warning(
     expect_null(fit_exe$code()),
     "'$code()' will return NULL because the 'CmdStanModel' was not created with a Stan file",

tests/testthat/test-model-compile.R

@@ -837,7 +837,7 @@ test_that("dirname of stan_file is used as include path if no other paths suppli
 
   mod_tmp <- cmdstan_model(stan_file, compile = FALSE)
   expect_true(mod_tmp$check_syntax())
-  expect_true(mod_tmp$format())
+  utils::capture.output(expect_true(mod_tmp$format()))
   expect_s3_class(mod_tmp$compile(), "CmdStanModel")
 })
 

tests/testthat/test-model-expose-functions.R

@@ -80,11 +80,13 @@ stan_prog <- paste(function_decl,
 model <- write_stan_file(stan_prog)
 data_list <- testing_data("bernoulli")
 mod <- cmdstan_model(model, force_recompile = TRUE)
-fit <- mod$sample(data = data_list)
+utils::capture.output(
+  fit <- mod$sample(data = data_list)
+)
 
 
 test_that("Functions can be exposed in model object", {
-  expect_no_error(mod$expose_functions(verbose = TRUE))
+  expect_no_error(mod$expose_functions())
 })
 
 
@@ -260,7 +262,7 @@ test_that("Functions handle complex types correctly", {
 })
 
 test_that("Functions can be exposed in fit object", {
-  fit$expose_functions(verbose = TRUE)
+  fit$expose_functions()
 
   expect_equal(
     fit$functions$rtn_vec(c(1,2,3,4)),
@@ -284,7 +286,9 @@ test_that("Compiled functions can be copied to global environment", {
 
 test_that("Functions can be compiled with model", {
   mod <- cmdstan_model(model, force_recompile = TRUE, compile_standalone = TRUE)
-  fit <- mod$sample(data = data_list)
+  utils::capture.output(
+    fit <- mod$sample(data = data_list)
+  )
 
   expect_message(
     fit$expose_functions(),
@@ -344,9 +348,11 @@ test_that("rng functions can be exposed", {
   model <- write_stan_file(stan_prog)
   data_list <- testing_data("bernoulli")
   mod <- cmdstan_model(model, force_recompile = TRUE)
-  fit <- mod$sample(data = data_list)
+  utils::capture.output(
+    fit <- mod$sample(data = data_list)
+  )
 
-  fit$expose_functions(verbose = TRUE)
+  fit$expose_functions()
   set.seed(10)
   res1_1 <- fit$functions$wrap_normal_rng(5,10)
   res2_1 <- fit$functions$wrap_normal_rng(5,10)

tests/testthat/test-model-init.R

@@ -303,10 +303,12 @@ test_that("Initial values for single-element containers treated correctly", {
   "
   mod <- cmdstan_model(write_stan_file(modcode), force_recompile = TRUE)
   expect_no_error(
-    fit <- mod$sample(
-      data = list(y_mean = 0),
-      init = list(list(y = c(0))),
-      chains = 1
+    utils::capture.output(
+      fit <- mod$sample(
+        data = list(y_mean = 0),
+        init = list(list(y = c(0))),
+        chains = 1
+      )
     )
   )
 })
@@ -331,7 +333,13 @@ test_that("Pathfinder inits do not drop dimensions", {
   "
   mod <- cmdstan_model(write_stan_file(modcode), force_recompile = TRUE)
   data <- list(N = 100, y = rnorm(100))
-  pf <- mod$pathfinder(data = data, psis_resample = FALSE)
-  expect_no_error(fit <- mod$sample(data = data, init = pf, chains = 1,
-                                    iter_warmup = 100, iter_sampling = 100))
-})
+  utils::capture.output(
+    pf <- mod$pathfinder(data = data, psis_resample = FALSE)
+  )
+  expect_no_error(
+    utils::capture.output(
+      fit <- mod$sample(data = data, init = pf, chains = 1,
+                        iter_warmup = 100, iter_sampling = 100)
+    )
+  )
+})

tests/testthat/test-model-laplace.R

@@ -36,7 +36,9 @@ test_that("laplace() method errors for any invalid argument before calling cmdst
   for (nm in names(bad_arg_values)) {
     args <- ok_arg_values
     args[[nm]] <- bad_arg_values[[nm]]
-    expect_error(do.call(mod$laplace, args), regexp = nm, info = nm)
+    utils::capture.output(
+      expect_error(do.call(mod$laplace, args), regexp = nm, info = nm)
+    )
   }
   args <- ok_arg_values
   args$opt_args <- list(iter = "NOT_A_NUMBER")
@@ -63,10 +65,12 @@ test_that("laplace() runs when all arguments specified validly", {
 })
 
 test_that("laplace() all valid 'mode' inputs give same results", {
-  mode <- mod$optimize(data = data_list, jacobian = TRUE, seed = 100, refresh = 0)
-  fit1 <- mod$laplace(data = data_list, mode = mode, seed = 100, refresh = 0)
-  fit2 <- mod$laplace(data = data_list, mode = mode$output_files(), seed = 100, refresh = 0)
-  fit3 <- mod$laplace(data = data_list, mode = NULL, seed = 100, refresh = 0)
+  utils::capture.output({
+    mode <- mod$optimize(data = data_list, jacobian = TRUE, seed = 100, refresh = 0)
+    fit1 <- mod$laplace(data = data_list, mode = mode, seed = 100, refresh = 0)
+    fit2 <- mod$laplace(data = data_list, mode = mode$output_files(), seed = 100, refresh = 0)
+    fit3 <- mod$laplace(data = data_list, mode = NULL, seed = 100, refresh = 0)
+  })
 
   expect_is(fit1, "CmdStanLaplace")
   expect_is(fit2, "CmdStanLaplace")
@@ -85,17 +89,22 @@ test_that("laplace() all valid 'mode' inputs give same results", {
 })
 
 test_that("laplace() allows choosing number of draws", {
-  fit <- mod$laplace(data = data_list, draws = 10, refresh = 0)
+  utils::capture.output({
+    fit <- mod$laplace(data = data_list, draws = 10, refresh = 0)
+    fit2 <- mod$laplace(data = data_list, draws = 100, refresh = 0)
+  })
+
   expect_equal(fit$metadata()$draws, 10)
   expect_equal(posterior::ndraws(fit$draws()), 10)
 
-  fit2 <- mod$laplace(data = data_list, draws = 100, refresh = 0)
   expect_equal(fit2$metadata()$draws, 100)
   expect_equal(posterior::ndraws(fit2$draws()), 100)
 })
 
 test_that("laplace() errors if jacobian arg doesn't match what optimize used", {
-  fit <- mod$optimize(data = data_list, jacobian = FALSE, refresh = 0)
+  utils::capture.output(
+    fit <- mod$optimize(data = data_list, jacobian = FALSE, refresh = 0)
+  )
   expect_error(
     mod$laplace(data = data_list, mode = fit, jacobian = TRUE),
     "'jacobian' argument to optimize and laplace must match"
@@ -107,7 +116,9 @@ test_that("laplace() errors if jacobian arg doesn't match what optimize used", {
 })
 
 test_that("laplace() errors with bad combinations of arguments", {
-  fit <- mod$optimize(data = data_list, jacobian = TRUE, refresh = 0)
+  utils::capture.output(
+    fit <- mod$optimize(data = data_list, jacobian = TRUE, refresh = 0)
+  )
   expect_error(
     mod$laplace(data = data_list, mode = mod, opt_args = list(iter = 10)),
     "Cannot specify both 'opt_args' and 'mode' arguments."
@@ -120,14 +131,15 @@ test_that("laplace() errors with bad combinations of arguments", {
 
 test_that("laplace() errors if optimize() fails", {
   mod_schools <- testing_model("schools")
-  expect_error(
-    expect_warning(
-      expect_message(
-        mod_schools$laplace(data = testing_data("schools"), refresh = 0),
-        "Line search failed to achieve a sufficient decrease"
+  utils::capture.output(
+    expect_error(
+      expect_warning(
+        expect_message(
+          mod_schools$laplace(data = testing_data("schools"), refresh = 0),
+          "Line search failed to achieve a sufficient decrease"
+        ),
+        "Fitting finished unexpectedly"
       ),
-      "Fitting finished unexpectedly"
-    ),
-    "Optimization failed"
-  )
+      "Optimization failed"
+    ))
 })