Merge pull request #522 from stan-dev/bugfix_clear_stdout_stderr_on_finish

Bugfix clearing stdout stderr on finish & cleanup

Author: jgabry

NEWS.md

@@ -1,5 +1,12 @@
 # cmdstanr 0.4.0.9000
 
+### Bug fixes
+
+* Fixed bug that caused stdour/stderr not being read at the end of
+optimization. (#522)
+
+### New features
+
 * Default directory changed to `.cmdstan` instead of `.cmdstanr` so that
 CmdStanPy and CmdStanR can use the same CmdStan installations. Using `.cmdstanr`
 will continue to be supported until version 1.0 but `install_cmdstan()` will now

R/data.R

@@ -243,10 +243,7 @@ process_fitted_params <- function(fitted_params) {
       }
     )
     sampler_diagnostics <- tryCatch(
-      fitted_params$sampler_diagnostics(),
-      error = function(cond) {
-        NULL
-      }
+      fitted_params$sampler_diagnostics()
     )
     paths <- draws_to_csv(draws, sampler_diagnostics)
   } else if (checkmate::test_r6(fitted_params, "CmdStanVB")) {

R/install.R

@@ -154,7 +154,7 @@ install_cmdstan <- function(dir = NULL,
   cmdstan_make_local(dir = dir_cmdstan, cpp_options = cpp_options, append = TRUE)
   version <- read_cmdstan_version(dir_cmdstan)
   if (os_is_windows()) {
-    if (version >= "2.24" && R.version$major >= "4") {
+    if (version >= "2.24" && R.version$major >= "4" && !("PRECOMPILED_HEADERS" %in% toupper(names(cpp_options)))) {
       # cmdstan 2.24 can use precompiled headers with RTools 4.0 to speedup compiling
       cmdstan_make_local(
         dir = dir_cmdstan,
@@ -371,36 +371,6 @@ build_cmdstan <- function(dir,
   )
 }
 
-# Removes files that are used to simplify switching to using threading, opencl or mpi.
-clean_compile_helper_files <- function() {
-  # remove main_.*.o files and model_header_.*.hpp.gch files
-  files_to_remove <- c(
-    list.files(
-      path = file.path(cmdstan_path(), "src", "cmdstan"),
-      pattern = "main.*\\.o$",
-      full.names = TRUE
-    ),
-    list.files(
-      path = file.path(cmdstan_path(), "src", "cmdstan"),
-      pattern = "main.*\\.d$",
-      full.names = TRUE
-    ),
-    list.files(
-      path = file.path(cmdstan_path(), "stan", "src", "stan", "model"),
-      pattern = "model_header.*\\.hpp.gch$",
-      full.names = TRUE
-    ),
-    list.files(
-      path = file.path(cmdstan_path(), "stan", "src", "stan", "model"),
-      pattern = "model_header.*\\.d$",
-      full.names = TRUE
-    )
-  )
-  if (!is.null(files_to_remove)) {
-    file.remove(files_to_remove)
-  }
-}
-
 clean_cmdstan <- function(dir = cmdstan_path(),
                           cores = getOption("mc.cores", 2),
                           quiet = FALSE) {
@@ -414,13 +384,12 @@ clean_cmdstan <- function(dir = cmdstan_path(),
     error_on_status = FALSE,
     stderr_callback = function(x, p) { if (quiet) message(x) }
   )
-  clean_compile_helper_files()
 }
 
 build_example <- function(dir, cores, quiet, timeout) {
   processx::run(
     make_cmd(),
-    args = c(paste0("-j", cores), cmdstan_ext("examples/bernoulli/bernoulli")),
+    args = c(paste0("-j", cores), cmdstan_ext(file.path("examples", "bernoulli", "bernoulli"))),
     wd = dir,
     echo_cmd = is_verbose_mode(),
     echo = !quiet || is_verbose_mode(),

R/model.R

@@ -457,18 +457,7 @@ compile <- function(quiet = TRUE,
     }
   }
 
-  stancflags_val <- ""
-  if (!is.null(include_paths)) {
-    checkmate::assert_directory_exists(include_paths, access = "r")
-    include_paths <- absolute_path(include_paths)
-    include_paths <- paste0(include_paths, collapse = ",")
-    if (cmdstan_version() >= "2.24") {
-      include_paths_flag <- " --include-paths="
-    } else {
-      include_paths_flag <- " --include_paths="
-    }
-    stancflags_val <- paste0(stancflags_val, include_paths_flag, include_paths, " ")
-  }
+  stancflags_val <- include_paths_stanc3_args(include_paths)
 
   if (pedantic) {
     stanc_options[["warn-pedantic"]] <- TRUE
@@ -491,7 +480,7 @@ compile <- function(quiet = TRUE,
       stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", "'", stanc_options[[i]], "'"))
     }
   }
-  stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(stanc_built_options, collapse = " "))
+  stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stanc_built_options, collapse = " "))
   run_log <- processx::run(
     command = make_cmd(),
     args = c(tmp_exe,
@@ -612,18 +601,7 @@ check_syntax <- function(pedantic = FALSE,
     stanc_options[["warn-pedantic"]] <- TRUE
   }
 
-  stancflags_val <- NULL
-  if (!is.null(include_paths)) {
-    checkmate::assert_directory_exists(include_paths, access = "r")
-    include_paths <- absolute_path(include_paths)
-    include_paths <- paste0(include_paths, collapse = ",")
-    if (cmdstan_version() >= "2.24") {
-      include_paths_flag <- " --include-paths="
-    } else {
-      include_paths_flag <- " --include_paths="
-    }
-    stancflags_val <- trimws(paste0(include_paths_flag, include_paths, " "))
-  }
+  stancflags_val <- include_paths_stanc3_args(include_paths)
 
   if (is.null(stanc_options[["name"]])) {
     stanc_options[["name"]] <- paste0(self$model_name(), "_model")
@@ -1394,3 +1372,19 @@ cpp_options_to_compile_flags <- function(cpp_options) {
   }
   cpp_built_options
 }
+
+include_paths_stanc3_args <- function(include_paths = NULL) {
+  stancflags <- NULL
+  if (!is.null(include_paths)) {
+    checkmate::assert_directory_exists(include_paths, access = "r")
+    include_paths <- absolute_path(include_paths)
+    include_paths <- paste0(include_paths, collapse = ",")
+    if (cmdstan_version() >= "2.24") {
+      include_paths_flag <- "--include-paths="
+    } else {
+      include_paths_flag <- "--include_paths="
+    }
+    stancflags <- paste0(stancflags, include_paths_flag, include_paths)
+  }
+  stancflags
+}

R/run.R

@@ -364,10 +364,8 @@ check_target_exe <- function(exe) {
       procs$poll(0)
       for (chain_id in chains) {
         if (!procs$is_queued(chain_id)) {
-          output <- procs$get_proc(chain_id)$read_output_lines()
-          procs$process_output(output, chain_id)
-          error_output <- procs$get_proc(chain_id)$read_error_lines()
-          procs$process_error_output(error_output, chain_id)
+          procs$process_output(chain_id)
+          procs$process_error_output(chain_id)
         }
       }
       procs$set_active_procs(procs$num_alive())
@@ -424,10 +422,8 @@ CmdStanRun$set("private", name = "run_sample_", value = .run_sample)
       procs$poll(0)
       for (chain_id in chains) {
         if (!procs$is_queued(chain_id)) {
-          output <- procs$get_proc(chain_id)$read_output_lines()
-          procs$process_output(output, chain_id)
-          error_output <- procs$get_proc(chain_id)$read_error_lines()
-          procs$process_error_output(error_output, chain_id)
+          procs$process_output(chain_id)
+          procs$process_error_output(chain_id)
         }
       }
       procs$set_active_procs(procs$num_alive())
@@ -460,13 +456,13 @@ CmdStanRun$set("private", name = "run_generate_quantities_", value = .run_genera
     procs$wait(0.1)
     procs$poll(0)
     if (!procs$is_queued(id)) {
-      output <- procs$get_proc(id)$read_output_lines()
-      procs$process_output(output, id)
-      error_output <- procs$get_proc(id)$read_error_lines()
-      procs$process_error_output(error_output, id)
+      procs$process_output(id)
+      procs$process_error_output(id)
     }
     procs$set_active_procs(procs$num_alive())
   }
+  procs$process_output(id)
+  procs$process_error_output(id)
   successful_fit <- FALSE
   if (self$method() == "optimize") {
     if (procs$proc_state(id = id) > 3) {
@@ -651,10 +647,8 @@ CmdStanProcs <- R6::R6Class(
         if (self$is_still_working(id) && !self$is_queued(id) && !self$is_alive(id)) {
           # if the process just finished make sure we process all
           # input and mark the process finished
-          output <- self$get_proc(id)$read_output_lines()
-          self$process_output(output, id)
-          error_output <- self$get_proc(id)$read_error_lines()
-          self$process_error_output(error_output, id)
+          self$process_output(id)
+          self$process_error_output(id)
           self$mark_proc_stop(id)
           self$report_time(id)
         }
@@ -723,7 +717,8 @@ CmdStanProcs <- R6::R6Class(
       (grepl("A method must be specified!", line, perl = TRUE)) ||
       (grepl("is not a valid value for", line, perl = TRUE))
     },
-    process_error_output = function(err_out, id) {
+    process_error_output = function(id) {
+      err_out <- self$get_proc(id)$read_error_lines()
       if (length(err_out)) {
         for (err_line in err_out) {
           private$proc_output_[[id]] <- c(private$proc_output_[[id]], err_line)
@@ -733,7 +728,8 @@ CmdStanProcs <- R6::R6Class(
         }
       }
     },
-    process_output = function(out, id) {
+    process_output = function(id) {
+      out <- self$get_proc(id)$read_output_lines()
       if (length(out) == 0) {
         return(NULL)
       }
@@ -809,7 +805,8 @@ CmdStanMCMCProcs <- R6::R6Class(
   classname = "CmdStanMCMCProcs",
   inherit = CmdStanProcs,
   public = list(
-    process_output = function(out, id) {
+    process_output = function(id) {
+      out <- self$get_proc(id)$read_output_lines()
       if (length(out) == 0) {
         return(invisible(NULL))
       }
@@ -843,7 +840,7 @@ CmdStanMCMCProcs <- R6::R6Class(
             next_state <- 3
           }
           if (state < 3 && grepl("Elapsed Time:", line, perl = TRUE)) {
-            state <- 5 # 5 = end of samp+ling
+            state <- 5 # 5 = end of sampling
             next_state <- 5
           }
           if (private$proc_state_[[id]] == 3 &&
@@ -968,7 +965,8 @@ CmdStanGQProcs <- R6::R6Class(
       }
       invisible(self)
     },
-    process_output = function(out, id) {
+    process_output = function(id) {
+      out <- self$get_proc(id)$read_output_lines()
       if (length(out) == 0) {
         return(NULL)
       }

R/utils.R

@@ -60,9 +60,7 @@ is_rosetta2 <- function() {
 
 # Returns the type of make command to use to compile depending on the OS
 make_cmd <- function() {
-  # CmdStan 2.21 introduced TBB that requires mingw32-make on Windows
-  ver <- .cmdstanr$VERSION
-  if (os_is_windows() && (is.null(ver) || ver >= "2.21")) {
+  if (os_is_windows()) {
     "mingw32-make.exe"
   } else {
     "make"

tests/testthat/test-model-compile.R

@@ -277,7 +277,7 @@ test_that("compiling stops on hyphens in stanc_options", {
 test_that("compiling works with only names in list", {
   skip_on_cran()
   stan_file <- testing_stan_file("bernoulli")
-  mod <- cmdstan_model(stan_file, stanc_options = list("warn-pedantic"), force_recompile = TRUE, quiet = FALSE)
+  mod <- cmdstan_model(stan_file, stanc_options = list("warn-pedantic"), force_recompile = TRUE)
   checkmate::expect_r6(
     mod,
     "CmdStanModel"
@@ -461,3 +461,24 @@ test_that("cpp_options_to_compile_flags() works", {
   options = list()
   expect_equal(cpp_options_to_compile_flags(options), NULL)
 })
+
+test_that("include_paths_stanc3_args() works", {
+  expect_equal(include_paths_stanc3_args(), NULL)
+  path_1 <- file.path(tempdir(), "folder1")
+  if (!dir.exists(path_1)) {
+    dir.create(path_1)
+  }
+  path_1 <- repair_path(path_1)
+  expect_equal(include_paths_stanc3_args(path_1), paste0("--include-paths=", path_1))
+  path_2 <- file.path(tempdir(), "folder2")
+  if (!dir.exists(path_2)) {
+    dir.create(path_2)
+  }
+  path_2 <- repair_path(path_2)
+  expect_equal(
+    include_paths_stanc3_args(c(path_1, path_2)),
+    c(
+      paste0("--include-paths=", path_1, ",", path_2)
+    )
+  )
+})