From f054aa6e7be77b8154c45ee6c4155d6332b3a302 Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 5 Aug 2024 17:02:11 +0200 Subject: [PATCH 01/19] Add testcases for Issue #765 * Model objects from exe file compiled with opencl fail to sample. * stan_threads set in makefile not respected --- tests/testthat/test-opencl.R | 10 ++++++++++ tests/testthat/test-threads.R | 19 +++++++++++++++++++ 2 files changed, 29 insertions(+) diff --git a/tests/testthat/test-opencl.R b/tests/testthat/test-opencl.R index 3949e4a1..240ca8f9 100644 --- a/tests/testthat/test-opencl.R +++ b/tests/testthat/test-opencl.R @@ -151,3 +151,13 @@ test_that("error for runtime selection of OpenCL devices if version less than 2. ) reset_cmdstan_version(mod) }) + +test_that("model from exe_file retains open_cl option", { + skip_if_not(Sys.getenv("CMDSTANR_OPENCL_TESTS") %in% c("1", "true")) + stan_file <- testing_stan_file("bernoulli") + mod <- cmdstan_model(stan_file = stan_file, cpp_options = list(stan_opencl = TRUE)) + mod_from_exe <- cmdstan_model(exe_file = mod$exe_file()) + expect_sample_output( + fit <- mod_from_exe$sample(data = testing_data("bernoulli"), opencl_ids = c(0, 0), chains = 1) + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-threads.R b/tests/testthat/test-threads.R index fb5eec61..fdabadd1 100644 --- a/tests/testthat/test-threads.R +++ b/tests/testthat/test-threads.R @@ -182,3 +182,22 @@ test_that("correct output when stan_threads not TRUE", { fixed = TRUE ) }) + +test_that('correct output when stan threads set via make local',{ + #TODO clean this up so no leftover changes to make local + file.copy( + file.path(cmdstan_path(), 'make', 'local'), + file.path(cmdstan_path(), 'make', 'local.save') + ) + on.exit(file.rename( + file.path(cmdstan_path(), 'make', 'local.save'), + file.path(cmdstan_path(), 'make', 'local') + ), add = TRUE, after = FALSE) + cmdstan_make_local(cpp_options = list(stan_threads = TRUE)) + mod <- cmdstan_model(stan_program, force_recompile = TRUE) + expect_output( + f <- mod$sample(data = data_file_json, parallel_chains = 4, threads_per_chain = 1), + "Running MCMC with 4 parallel chains, with 1 thread(s) per chain..", + fixed = TRUE + ) +}) From e81f137f1e9f214b7ecbc0d10acef6ddce86849e Mon Sep 17 00:00:00 2001 From: Brock Date: Thu, 8 Aug 2024 15:12:58 +0200 Subject: [PATCH 02/19] Fix Issue #765 --- R/cpp_opts.R | 15 ++++++++++++--- R/model.R | 1 - tests/testthat/test-model-compile.R | 6 ++++-- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 3626f2e2..9d95e13f 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -52,8 +52,17 @@ parse_exe_info_string <- function(ret_stdout) { model_compile_info <- function(exe_file, version) { info <- NULL if (version > "2.26.1") { - - ret <- run_info_cli(exe_file) + withr::with_path( + c( + toolchain_PATH_env_var(), + tbb_path() + ), + ret <- wsl_compatible_run( + command = wsl_safe_path(exe_file), + args = "info", + error_on_status = FALSE + ) + ) if (ret$status == 0) { info <- list() info_raw <- strsplit(strsplit(ret$stdout, "\n")[[1]], "=") @@ -64,7 +73,7 @@ model_compile_info <- function(exe_file, version) { if (!is.na(as.logical(val))) { val <- as.logical(val) } - info[[toupper(key_val[1])]] <- val + info[[tolower(key_val[1])]] <- val } } info[["STAN_VERSION"]] <- paste0(info[["STAN_VERSION_MAJOR"]], ".", info[["STAN_VERSION_MINOR"]], ".", info[["STAN_VERSION_PATCH"]]) diff --git a/R/model.R b/R/model.R index 1fe14615..cb315151 100644 --- a/R/model.R +++ b/R/model.R @@ -2334,7 +2334,6 @@ model_variables <- function(stan_file, include_paths = NULL, allow_undefined = F variables } - is_variables_method_supported <- function(mod) { cmdstan_version() >= "2.27.0" && mod$has_stan_file() && file.exists(mod$stan_file()) } diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index 9517aeab..a23114e8 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -496,7 +496,7 @@ test_that("cpp_options work with settings in make/local", { rebuild_cmdstan() mod <- cmdstan_model(stan_file = stan_program) - expect_null(mod$cpp_options()$STAN_THREADS) + expect_null(mod$cpp_options()$stan_threads) file.remove(mod$exe_file()) @@ -504,7 +504,7 @@ test_that("cpp_options work with settings in make/local", { file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") mod <- cmdstan_model(file) - expect_true(mod$cpp_options()$STAN_THREADS) + expect_true(mod$cpp_options()$stan_threads) file.remove(mod$exe_file()) @@ -789,6 +789,8 @@ test_that("overwrite_file works with format()", { } " stan_file_tmp <- write_stan_file(code) + on.exit(file.remove(stan_file_tmp)) + mod_1 <- cmdstan_model(stan_file_tmp, compile = FALSE) expect_false( any( From 6d5c9b1d4335beea1e9c670e34e119496964a371 Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 21 Aug 2024 10:45:58 +0200 Subject: [PATCH 03/19] Handle stan_threads cpp option consistent with cmdstan * mod$cpp_options() now shows options as false if unset (same as the `info` cli command). Previously, this was inconsistent: sometimes showing the user-provided arg and sometimes showing the output of `info` * tests now match expected behavior of cmdstan --- R/cpp_opts.R | 1 + tests/testthat/test-threads.R | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 9d95e13f..06e20325 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -51,6 +51,7 @@ parse_exe_info_string <- function(ret_stdout) { # old (current) parser model_compile_info <- function(exe_file, version) { info <- NULL + if(is.null(version)) return(NULL) if (version > "2.26.1") { withr::with_path( c( diff --git a/tests/testthat/test-threads.R b/tests/testthat/test-threads.R index fdabadd1..8667c617 100644 --- a/tests/testthat/test-threads.R +++ b/tests/testthat/test-threads.R @@ -158,20 +158,20 @@ test_that("threading works with generate_quantities()", { expect_equal(f_gq$metadata()$threads_per_chain, 4) }) -test_that("correct output when stan_threads not TRUE", { - mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = FALSE), force_recompile = TRUE) +test_that("correct output when stan_threads unset", { + mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = NULL), force_recompile = TRUE) expect_output( mod$sample(data = data_file_json), "Running MCMC with 4 sequential chains", fixed = TRUE ) mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = "dummy string"), force_recompile = TRUE) - expect_output( + expect_error( mod$sample(data = data_file_json), - "Running MCMC with 4 sequential chains", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads_per_chain' was not set!", fixed = TRUE ) - mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = FALSE), force_recompile = TRUE) + mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = NULL), force_recompile = TRUE) expect_output( expect_warning( mod$sample(data = data_file_json, threads_per_chain = 4), From cbfbdde7e5b567c784108689622c3e389f6dae1a Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 21 Aug 2024 12:34:43 +0200 Subject: [PATCH 04/19] Improve Docs and Warnings around cpp_options :star: Make it more clear that setting cpp_options = list(OPTION = FALSE) results in OPTION being set (turned on) rather than unset (turned off). --- R/args.R | 6 - R/cpp_opts.R | 94 ++++++-- R/model.R | 209 +++++++++++++----- R/path.R | 4 +- man/model-method-compile.Rd | 7 +- tests/testthat/helper-custom-expectations.R | 5 +- tests/testthat/helper-models.R | 5 + tests/testthat/test-model-check_syntax.R | 9 + .../testthat/test-model-compile-user_header.R | 48 +++- tests/testthat/test-model-compile.R | 39 +++- tests/testthat/test-model-helpers.R | 34 +++ tests/testthat/test-model-recompile-logic.R | 203 +++++++++++++++-- tests/testthat/test-threads.R | 10 +- 13 files changed, 546 insertions(+), 127 deletions(-) create mode 100644 tests/testthat/test-model-check_syntax.R create mode 100644 tests/testthat/test-model-helpers.R diff --git a/R/args.R b/R/args.R index 6373eb07..ffc50654 100644 --- a/R/args.R +++ b/R/args.R @@ -715,12 +715,6 @@ validate_cmdstan_args <- function(self) { } validate_init(self$init, num_inits) validate_seed(self$seed, num_procs) - if (!is.null(self$opencl_ids)) { - if (cmdstan_version() < "2.26") { - stop("Runtime selection of OpenCL devices is only supported with CmdStan version 2.26 or newer.", call. = FALSE) - } - checkmate::assert_vector(self$opencl_ids, len = 2) - } invisible(TRUE) } diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 06e20325..b961871c 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -49,7 +49,7 @@ parse_exe_info_string <- function(ret_stdout) { } # old (current) parser -model_compile_info <- function(exe_file, version) { +model_compile_info_legacy <- function(exe_file, version) { info <- NULL if(is.null(version)) return(NULL) if (version > "2.26.1") { @@ -145,41 +145,87 @@ validate_cpp_options <- function(cpp_options) { # no type checking for opencl_ids # cpp_options must be a list # opencl_ids returned unchanged -assert_valid_opencl <- function(opencl_ids, cpp_options) { - if (is.null(cpp_options[["stan_opencl"]]) - && !is.null(opencl_ids)) { +assert_valid_opencl <- function( + opencl_ids, + exe_info, + fallback_exe_info = list('stan_version' = '2.0.0', 'stan_opencl' = FALSE) +) { + if (is.null(opencl_ids)) return(invisible(opencl_ids)) + + fallback <- is.null(exe_info) + if(fallback) exe_info <- fallback_exe_info + # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis + # the user should have been warned about this in initialize(), so no need to re-warn here. + if(fallback) stop <- warning + + if (exe_info[['stan_version']] < "2.26.0") { + stop("Runtime selection of OpenCL devices is only supported with CmdStan version 2.26 or newer.", call. = FALSE) + } + + if (isFALSE(exe_info[["stan_opencl"]])) { stop("'opencl_ids' is set but the model was not compiled for use with OpenCL.", "\nRecompile the model with 'cpp_options = list(stan_opencl = TRUE)'", call. = FALSE) } + checkmate::assert_vector(opencl_ids, len = 2) invisible(opencl_ids) } # cpp_options must be a list -assert_valid_threads <- function(threads, cpp_options, multiple_chains = FALSE) { +assert_valid_threads <- function(threads, exe_info, fallback_exe_info, multiple_chains = FALSE) { + + fallback <- is.null(exe_info) + if(fallback) exe_info <- fallback_exe_info + # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis + # the user should have been warned about this in initialize(), so no need to re-warn here. + if(fallback) stop <- warning + threads_arg <- if (multiple_chains) "threads_per_chain" else "threads" checkmate::assert_integerish(threads, .var.name = threads_arg, null.ok = TRUE, lower = 1, len = 1) - if (is.null(cpp_options[["stan_threads"]]) || !isTRUE(cpp_options[["stan_threads"]])) { - if (!is.null(threads)) { - warning( - "'", threads_arg, "' is set but the model was not compiled with ", - "'cpp_options = list(stan_threads = TRUE)' ", - "so '", threads_arg, "' will have no effect!", - call. = FALSE - ) - threads <- NULL - } - } else if (isTRUE(cpp_options[["stan_threads"]]) && is.null(threads)) { + if (isTRUE(exe_info[["stan_threads"]]) && is.null(threads)) { stop( "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' ", - "but '", threads_arg, "' was not set!", + "or equivalent, but '", threads_arg, "' was not set!", + call. = FALSE + ) + } else if (!is.null(threads)) { + warning( + "'", threads_arg, "' is set but the model was not compiled with ", + "'cpp_options = list(stan_threads = TRUE)' or equivalent ", + "so '", threads_arg, "' will have no effect!", call. = FALSE ) + if (!fallback) threads <- NULL } invisible(threads) } +validate_precompile_cpp_options <- function(cpp_options) { + if(is.null(cpp_options) || length(cpp_options) == 0) return(list()) + + if (!is.null(cpp_options[["user_header"]]) && !is.null(cpp_options[['USER_HEADER']])) { + warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) + } + + names(cpp_options) <- tolower(names(cpp_options)) + flags_set_if_defined <- c( + # cmdstan + "stan_threads", "stan_mpi", "stan_opencl", "stan_no_range_checks", "stan_cpp_optims", + # stan math + "integrated_opencl", "tbb_lib", "tbb_inc", "tbb_interface_new" + ) + for (flag in flags_set_if_defined) { + if (isFALSE(cpp_options[[flag]])) warning( + flag, " set to ", cpp_options[flag], " Since this is a non-empty value, ", + "it will result in the corresponding ccp option being turned ON. To turn this", + " option off, use cpp_options = list(", tolower(flag), " = NULL)." + ) + } + cpp_options +} + + # For two functions below # both styles are lists which should have flag names in lower case as names of the list # cpp_options style means is NULL or empty string @@ -215,3 +261,17 @@ exe_info_reflects_cpp_options <- function(exe_info, cpp_options) { cpp_options[overlap] ) } + +# check for flags that an R user may interpret as false but will +# be interpretted as true/set by compiler +assert_no_falsy_flags <- function(cpp_options) { + names(cpp_options) <- toupper(names(cpp_options)) + flags <- c("STAN_THREADS", "STAN_MPI", "STAN_OPENCL", "INTEGRATED_OPENCL") + for (flag in flags) { + if (isFALSE(cpp_options[[flag]])) warning( + flag, " set to ", cpp_options[flag], " Since this is a non-empty value, ", + "it will result in the corresponding ccp option being turned ON. To turn this", + " option off, use cpp_options = list(", tolower(flag), " = NULL)." + ) + } +} \ No newline at end of file diff --git a/R/model.R b/R/model.R index cb315151..07a343b1 100644 --- a/R/model.R +++ b/R/model.R @@ -1,3 +1,4 @@ + #' Create a new CmdStanModel object #' #' @description \if{html}{\figure{logo.png}{options: width=25}} @@ -230,10 +231,12 @@ CmdStanModel <- R6::R6Class( stanc_options_ = list(), include_paths_ = NULL, using_user_header_ = FALSE, - precompile_cpp_options_ = NULL, + precompile_cpp_options_ = list(), precompile_stanc_options_ = NULL, precompile_include_paths_ = NULL, variables_ = NULL, + exe_info_ = list(), + # intentionally only set at compile(), not initialize() cmdstan_version_ = NULL ), public = list( @@ -249,7 +252,7 @@ CmdStanModel <- R6::R6Class( private$stan_file_ <- absolute_path(stan_file) private$stan_code_ <- readLines(stan_file) private$model_name_ <- sub(" ", "_", strip_ext(basename(private$stan_file_))) - private$precompile_cpp_options_ <- args$cpp_options %||% list() + private$precompile_cpp_options_ <- validate_precompile_cpp_options(args$cpp_options) %||% list() private$precompile_stanc_options_ <- assert_valid_stanc_options(args$stanc_options) %||% list() if (!is.null(args$user_header) || !is.null(args$cpp_options[["USER_HEADER"]]) || !is.null(args$cpp_options[["user_header"]])) { @@ -271,6 +274,29 @@ CmdStanModel <- R6::R6Class( } if (!is.null(stan_file) && compile) { self$compile(...) + } else { + # set exe path, same logic as in compile9) + if(!is.null(private$dir_)){ + dir <- repair_path(absolute_path(private$dir_)) + assert_dir_exists(dir, access = "rw") + if (length(self$exe_file()) != 0) { + self$exe_file(file.path(dir, basename(self$exe_file()))) + } + } + if (length(self$exe_file()) == 0) { + if (is.null(private$dir_)) { + exe_base <- self$stan_file() + } else { + exe_base <- file.path(private$dir_, basename(self$stan_file())) + } + self$exe_file(cmdstan_ext(strip_ext(exe_base))) + if (dir.exists(self$exe_file())) { + stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE) + } + } + + # exe_info is updated inside the compile method (if compile command is run) + exe_info <- self$exe_info(update = TRUE) } # for now, set this based on current version @@ -279,20 +305,17 @@ CmdStanModel <- R6::R6Class( # as the version the model was compiled with private$cmdstan_version_ <- cmdstan_version() if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { - cpp_options <- model_compile_info(self$exe_file(), self$cmdstan_version()) - for (cpp_option_name in names(cpp_options)) { - if (cpp_option_name != "stan_version" && - (!is.logical(cpp_options[[cpp_option_name]]) || isTRUE(cpp_options[[cpp_option_name]]))) { - private$cpp_options_[[cpp_option_name]] <- cpp_options[[cpp_option_name]] - } - } + private$cpp_options_ <- model_compile_info_legacy(self$exe_file(), self$cmdstan_version()) } invisible(self) }, include_paths = function() { - if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { + # checks whether a compile has occurred since object creation + if (!is.null(private$cmdstan_version_)) { + # yes, compile occurred return(private$include_paths_) } else { + # no, compile did not occur return(private$precompile_include_paths_) } }, @@ -335,12 +358,72 @@ CmdStanModel <- R6::R6Class( } private$exe_file_ }, - cmdstan_version = function() { - private$cmdstan_version_ + exe_info = function(update = FALSE) { + if (update) { + if (!file.exists(private$exe_file_)) return(NULL) + ret <- run_info_cli(private$exe_file_) + # Above command will return non-zero if + # cmdstan version < "2.26.1" + + cli_info_success <- !is.null(ret$status) && ret$status == 0 + exe_info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() + cpp_options <- exe_info_style_cpp_options(private$precompile_cpp_options_) + compiled_with_cpp_options <- !is.null(private$cmdstan_version_) + + private$exe_info_ <- if (compiled_with_cpp_options) { + # recompile has occurred since the CmdStanModel was created + # cpp_options as were used as configured + c( + # info cli as source of truth + exe_info, + # use cpp_options for options not provided in info + cpp_options[names(cpp_options) %in% names(exe_info)] + ) + } else if (cli_info_success) { + # no compile/recompile has occurred, we only trust info cli + # don't know if other cpp_options were applied, so skip them + exe_info + } else { + # info cli failure + no compile/recompile has occurred + warning( + 'Retrieving exe_file info failed. Recompiling is recommended. ', + 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' + ) + NULL + } + } + private$exe_info_ + }, + exe_info_fallback = function() { + c( + # current cmdstan_version, may or may not be compiled with this version + list(stan_version = cmdstan_version()), + + # user provided args, may or may not match binary + exe_info_style_cpp_options(private$precompile_cpp_options_) + ) + }, + cmdstan_version = function(fallback = TRUE) { + # this is intentionally not self$cmdstan_version_ + # because that value is only set if model has been recomplied + # since CmdStanModel instantiation + if (!fallback) self$exe_info()[['stan_version']] + for (candidate in c( + self$exe_info()[['stan_version']], + self$exe_info_fallback()[['stan_version']] + )) if (!is.null(candidate)) return (candidate) }, cpp_options = function() { + warning( + 'mod$cpp_options() will be deprecated in the next major version of cmdstanr. ', + 'Use mod$exe_info() to see options from last compilation. ', + 'Use mod$precompile_cpp_options() to see default options for next compilation.' + ) private$cpp_options_ }, + precompile_cpp_options = function() { + private$precompile_cpp_options_ + }, hpp_file = function() { if (!length(private$hpp_file_)) { stop("The .hpp file does not exists. Please (re)compile the model.", call. = FALSE) @@ -408,10 +491,11 @@ CmdStanModel <- R6::R6Class( #' program. #' @param user_header (string) The path to a C++ file (with a .hpp extension) #' to compile with the Stan model. -#' @param cpp_options (list) Any makefile options to be used when compiling the +#' @param cpp_options (list) Makefile options to be used when compiling the #' model (`STAN_THREADS`, `STAN_MPI`, `STAN_OPENCL`, etc.). Anything you would -#' otherwise write in the `make/local` file. For an example of using threading -#' see the Stan case study +#' otherwise write in the `make/local` file. Setting a value to `NULL` or `""` +#' within the list unsets the flag. +#' For an example of using threading see the Stan case study. #' [Reduce Sum: A Minimal Example](https://mc-stan.org/users/documentation/case-studies/reduce_sum_tutorial.html). #' @param stanc_options (list) Any Stan-to-C++ transpiler options to be used #' when compiling the model. See the **Examples** section below as well as the @@ -488,14 +572,21 @@ compile <- function(quiet = TRUE, #deprecated compile_hessian_method = FALSE, threads = FALSE) { - if (length(self$stan_file()) == 0) { stop("'$compile()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE) } assert_stan_file_exists(self$stan_file()) + + if (!is.null(user_header) && ( + !is.null(cpp_options[["USER_HEADER"]]) || !is.null(cpp_options[["user_header"]]) + )) warning("User header specified both via user_header argument and via cpp_options arguments") + if (length(cpp_options) == 0 && !is.null(private$precompile_cpp_options_)) { cpp_options <- private$precompile_cpp_options_ } + cpp_options_legacy <- cpp_options + cpp_options <- validate_precompile_cpp_options(cpp_options) + if (length(stanc_options) == 0 && !is.null(private$precompile_stanc_options_)) { stanc_options <- private$precompile_stanc_options_ } @@ -539,44 +630,41 @@ compile <- function(quiet = TRUE, stanc_options[["use-opencl"]] <- TRUE } - # Note that unlike cpp_options["USER_HEADER"], the user_header variable is deliberately - # not transformed with wsl_safe_path() as that breaks the check below on WSLv1 if (!is.null(user_header)) { - if (!is.null(cpp_options[["USER_HEADER"]]) || !is.null(cpp_options[["user_header"]])) { - warning("User header specified both via user_header argument and via cpp_options arguments") - } - - cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(user_header)) + cpp_options_legacy[["USER_HEADER"]] <- wsl_safe_path(absolute_path(user_header)) + cpp_options[["user_header"]] <- wsl_safe_path(absolute_path(user_header)) + # Brock 2025 - unsure why this allow-undefined is set + # only if user_header is passed as an arg, not if passed as a cpp_opt + # but leaving as-is stanc_options[["allow-undefined"]] <- TRUE private$using_user_header_ <- TRUE - } else if (!is.null(cpp_options[["USER_HEADER"]])) { - if (!is.null(cpp_options[["user_header"]])) { - warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) - } - - user_header <- cpp_options[["USER_HEADER"]] - cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(cpp_options[["USER_HEADER"]])) - private$using_user_header_ <- TRUE } else if (!is.null(cpp_options[["user_header"]])) { - user_header <- cpp_options[["user_header"]] cpp_options[["user_header"]] <- wsl_safe_path(absolute_path(cpp_options[["user_header"]])) private$using_user_header_ <- TRUE } - - if (!is.null(user_header)) { - user_header <- absolute_path(user_header) # As mentioned above, just absolute, not wsl_safe_path() - if (!file.exists(user_header)) { - stop(paste0("User header file '", user_header, "' does not exist."), call. = FALSE) + if (!is.null(cpp_options[["user_header"]])) { + # Transform back to non-wsl version to check for existance + # this is needed for WSv1 + non_wsl_user_header <- wsl_safe_path(cpp_options[["user_header"]], revert=TRUE) + if (!file.exists(non_wsl_user_header)) { + stop(paste0("User header file '", non_wsl_user_header, "' does not exist."), call. = FALSE) } } + # can be deleted when mod$cpp_options() is actually removed >>> + if (!is.null(cpp_options_legacy[["USER_HEADER"]])) { + cpp_options_legacy[["USER_HEADER"]] <- wsl_safe_path(absolute_path(cpp_options_legacy[["USER_HEADER"]])) + } else if (!is.null(cpp_options_legacy[["user_header"]])) { + cpp_options_legacy[["user_header"]] <- wsl_safe_path(absolute_path(cpp_options_legacy[["user_header"]])) + } + # <<< + # compile if: # - the user forced compilation, # - the executable does not exist # - the stan model was changed since last compilation # - a user header is used and the user header changed since last compilation (#813) - self$exe_file(exe) if (!file.exists(exe)) { force_recompile <- TRUE } else if (file.exists(self$stan_file()) @@ -588,15 +676,18 @@ compile <- function(quiet = TRUE, force_recompile <- TRUE } - if (!force_recompile) { - if (rlang::is_interactive()) { - message("Model executable is up to date!") - } + if ((!force_recompile) && rlang::is_interactive()) { + message("Model executable is up to date!") + } + + if ((!force_recompile)) { private$cpp_options_ <- cpp_options - private$precompile_cpp_options_ <- NULL + private$precompile_cpp_options_ <- cpp_options private$precompile_stanc_options_ <- NULL private$precompile_include_paths_ <- NULL self$functions$existing_exe <- TRUE + self$exe_file(exe) + self$exe_info(update = TRUE) return(invisible(self)) } else { if (rlang::is_interactive()) { @@ -737,10 +828,14 @@ compile <- function(quiet = TRUE, private$cmdstan_version_ <- cmdstan_version() private$exe_file_ <- exe - private$cpp_options_ <- cpp_options - private$precompile_cpp_options_ <- NULL + private$cpp_options_ <- cpp_options_legacy + private$precompile_cpp_options_ <- cpp_options private$precompile_stanc_options_ <- NULL private$precompile_include_paths_ <- NULL + + # Must be run after private$cmdstan_version_, private$exe_file_, and private$precompiled_cpp_options_ + # are all up to date + self$exe_info(update=TRUE) if(!dry_run) { if (compile_model_methods) { @@ -1224,7 +1319,7 @@ sample <- function(data = NULL, procs <- CmdStanMCMCProcs$new( num_procs = checkmate::assert_integerish(chains, lower = 1, len = 1), parallel_procs = checkmate::assert_integerish(parallel_chains, lower = 1, null.ok = TRUE), - threads_per_proc = assert_valid_threads(threads_per_chain, self$cpp_options(), multiple_chains = TRUE), + threads_per_proc = assert_valid_threads(threads_per_chain, self$exe_info(), self$exe_info_fallback(), multiple_chains = TRUE), show_stderr_messages = show_exceptions, show_stdout_messages = show_messages ) @@ -1268,7 +1363,7 @@ sample <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1525,7 +1620,7 @@ optimize <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$cpp_options()) + threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1560,7 +1655,7 @@ optimize <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1665,7 +1760,7 @@ laplace <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$cpp_options()) + threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1727,7 +1822,7 @@ laplace <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1815,7 +1910,7 @@ variational <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$cpp_options()) + threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1850,7 +1945,7 @@ variational <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1960,7 +2055,7 @@ pathfinder <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(num_threads, self$cpp_options()) + threads_per_proc = assert_valid_threads(num_threads, self$exe_info(), self$exe_info_fallback()) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -2000,7 +2095,7 @@ pathfinder <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables, num_threads = num_threads, save_cmdstan_config = save_cmdstan_config @@ -2097,7 +2192,7 @@ generate_quantities <- function(fitted_params, procs <- CmdStanGQProcs$new( num_procs = length(fitted_params_files), parallel_procs = checkmate::assert_integerish(parallel_chains, lower = 1, null.ok = TRUE), - threads_per_proc = assert_valid_threads(threads_per_chain, self$cpp_options(), multiple_chains = TRUE) + threads_per_proc = assert_valid_threads(threads_per_chain, self$exe_info(), self$exe_info_fallback(), multiple_chains = TRUE) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -2118,7 +2213,7 @@ generate_quantities <- function(fitted_params, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$cpp_options()), + opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), model_variables = model_variables ) runset <- CmdStanRun$new(args, procs) diff --git a/R/path.R b/R/path.R index 4353d7b1..da2fc128 100644 --- a/R/path.R +++ b/R/path.R @@ -234,9 +234,9 @@ unset_cmdstan_path <- function() { } # fake a cmdstan version (only used in tests) -fake_cmdstan_version <- function(version, mod = NULL) { +fake_cmdstan_version <- function(version, mod=NULL) { .cmdstanr$VERSION <- version - if (!is.null(mod)) { + if(!is.null(mod)) { if (!is.null(mod$.__enclos_env__$private$exe_info_)) { mod$.__enclos_env__$private$exe_info_$stan_version <- version } diff --git a/man/model-method-compile.Rd b/man/model-method-compile.Rd index c92f2704..40e0f41e 100644 --- a/man/model-method-compile.Rd +++ b/man/model-method-compile.Rd @@ -45,10 +45,11 @@ program.} \item{user_header}{(string) The path to a C++ file (with a .hpp extension) to compile with the Stan model.} -\item{cpp_options}{(list) Any makefile options to be used when compiling the +\item{cpp_options}{(list) Makefile options to be used when compiling the model (\code{STAN_THREADS}, \code{STAN_MPI}, \code{STAN_OPENCL}, etc.). Anything you would -otherwise write in the \code{make/local} file. For an example of using threading -see the Stan case study +otherwise write in the \code{make/local} file. Setting a value to \code{NULL} or \code{""} +within the list unsets the flag. +For an example of using threading see the Stan case study. \href{https://mc-stan.org/users/documentation/case-studies/reduce_sum_tutorial.html}{Reduce Sum: A Minimal Example}.} \item{stanc_options}{(list) Any Stan-to-C++ transpiler options to be used diff --git a/tests/testthat/helper-custom-expectations.R b/tests/testthat/helper-custom-expectations.R index 47a6e38b..c4de9e4c 100644 --- a/tests/testthat/helper-custom-expectations.R +++ b/tests/testthat/helper-custom-expectations.R @@ -34,7 +34,7 @@ expect_call_compilation <- function(constructor_call) { #' @param ... arguments passed to mod$compile() expect_no_recompilation <- function(mod, ...) { if(length(mod$exe_file()) == 0 || !file.exists(mod$exe_file())) { - fail(sprint("Model executable '%s' does not exist, cannot test if recompilation is triggerred.", mod$exe_file())) + fail(sprint("Model executable '%s' does not exist, cannot test if recompilation is triggerred.", mod$exe_file())) } before_mtime <- file.mtime(mod$exe_file()) @@ -54,6 +54,9 @@ expect_sample_output <- function(object, num_chains = NULL) { output <- paste(output, num_chains, "sequential chain") } } + # DONT MERGE WITH THIS LINE + cat <- base::cat + # ^ Workaround for: https://github.com/ManuelHentschel/vscDebugger/issues/196 expect_output(object, output) } diff --git a/tests/testthat/helper-models.R b/tests/testthat/helper-models.R index b0773e8b..0ffdfc61 100644 --- a/tests/testthat/helper-models.R +++ b/tests/testthat/helper-models.R @@ -14,6 +14,11 @@ cmdstan_example_file <- function() { file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") } +cmdstan_example_exe_file <- function() { + # stan program in different directory from the others + file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") +} + testing_model <- function(name) { cmdstan_model(stan_file = testing_stan_file(name)) } diff --git a/tests/testthat/test-model-check_syntax.R b/tests/testthat/test-model-check_syntax.R new file mode 100644 index 00000000..3afef850 --- /dev/null +++ b/tests/testthat/test-model-check_syntax.R @@ -0,0 +1,9 @@ +test_that("include_paths set on compiled model with mocks", { + stan_program_w_include <- testing_stan_file("bernoulli_include") + + with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_message({ + mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE, + include_paths = test_path("resources", "stan")) + }, message = 'mock-compile-was-called')) + expect_true(mod_w_include$check_syntax()) +}) \ No newline at end of file diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 8f549953..6cbcda04 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -154,10 +154,14 @@ test_that("wsl path conversion is done as expected", { } ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # USER_HEADER is converted # user_header is NULL - expect_equal(mod$cpp_options()[['USER_HEADER']], w_path(tmp_file)) - expect_true(is.null(mod$cpp_options()[['user_header']])) + expect_equal(cpp_options[['USER_HEADER']], w_path(tmp_file)) + expect_true(is.null(cpp_options[['user_header']])) # Case 2: cpp opt USER_HEADER with_mocked_cli( @@ -174,10 +178,14 @@ test_that("wsl path conversion is done as expected", { } ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # USER_HEADER is converted # user_header is unconverted - expect_equal(mod$cpp_options()[['USER_HEADER']], w_path(tmp_file)) - expect_true(is.null(mod$cpp_options()[['user_header']])) + expect_equal(cpp_options[['USER_HEADER']], w_path(tmp_file)) + expect_true(is.null(cpp_options[['user_header']])) # Case # 3: only user_header opt with_mocked_cli( @@ -195,10 +203,14 @@ test_that("wsl path conversion is done as expected", { ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # In other cases, in the *output* USER_HEADER is windows style user_header is not. # In this case, USER_HEADER is null. - expect_true(is.null(mod$cpp_options()[['USER_HEADER']])) - expect_equal(mod$cpp_options()[['user_header']], w_path(tmp_file)) + expect_true(is.null(cpp_options[['USER_HEADER']])) + expect_equal(cpp_options[['user_header']], w_path(tmp_file)) }) test_that("user_header precedence order is correct", { @@ -224,16 +236,20 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # In this case: # cpp_options[['USER_HEADER']] == tmp_files[1] <- actually used # cpp_options[['user_header']] == tmp_files[3] <- ignored # tmp_files[2] is not stored expect_equal( - match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)), + match(cpp_options[['USER_HEADER']], w_path(tmp_files)), 1 ) expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), + match(cpp_options[['user_header']], tmp_files), 3 ) @@ -252,16 +268,20 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # In this case: # cpp_options[['USER_HEADER']] == tmp_files[2] # cpp_options[['user_header']] == tmp_files[3] # tmp_files[2] is not stored expect_equal( - match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)), + match(cpp_options[['USER_HEADER']], w_path(tmp_files)), 2 ) expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), + match(cpp_options[['user_header']], tmp_files), 3 ) @@ -280,13 +300,17 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) + cpp_options <- expect_warning( + mod$cpp_options(), + 'will be deprecated' + ) # Same as Case #2 expect_equal( - match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)), + match(cpp_options[['USER_HEADER']], w_path(tmp_files)), 2 ) expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), + match(cpp_options[['user_header']], tmp_files), 3 ) }) diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index a23114e8..64945478 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -2,12 +2,19 @@ context("model-compile") set_cmdstan_path() stan_program <- cmdstan_example_file() +exe <- cmdstan_ext(strip_ext(stan_program)) +if (file.exists(exe)) file.remove(exe) + mod <- cmdstan_model(stan_file = stan_program, compile = FALSE) + +make_local_orig <- cmdstan_make_local() cmdstan_make_local(cpp_options = list("PRECOMPILED_HEADERS"="false")) +on.exit(cmdstan_make_local(cpp_options = make_local_orig, append = FALSE), add = TRUE, after = FALSE) test_that("object initialized correctly", { expect_equal(mod$stan_file(), stan_program) - expect_equal(mod$exe_file(), character(0)) + expect_equal(mod$exe_file(), exe) + expect_false(file.exists(mod$exe_file())) expect_error( mod$hpp_file(), "The .hpp file does not exists. Please (re)compile the model.", @@ -25,7 +32,6 @@ test_that("error if no compile() before model fitting", { test_that("compile() method works", { # remove executable if exists - exe <- cmdstan_ext(strip_ext(mod$stan_file())) if (file.exists(exe)) { file.remove(exe) } @@ -82,6 +88,9 @@ test_that("compile() method overwrites binaries", { expect_gt(file.mtime(mod$exe_file()), old_time) }) + +# Test with Side Effect ----- + test_that("compilation works with include_paths", { stan_program_w_include <- testing_stan_file("bernoulli_include") exe <- cmdstan_ext(strip_ext(stan_program_w_include)) @@ -112,6 +121,8 @@ test_that("compilation works with include_paths", { ) }) + + test_that("name in STANCFLAGS is set correctly", { out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE)) if(os_is_windows() && !os_is_wsl()) { @@ -381,7 +392,6 @@ test_that("check_syntax() works with pedantic=TRUE", { fixed = TRUE ) }) - test_that("check_syntax() works with include_paths", { stan_program_w_include <- testing_stan_file("bernoulli_include") @@ -391,15 +401,20 @@ test_that("check_syntax() works with include_paths", { }) + +# Test Failing Due to Side effect ----- + test_that("check_syntax() works with include_paths on compiled model", { stan_program_w_include <- testing_stan_file("bernoulli_include") mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE, - include_paths = test_path("resources", "stan")) + include_paths = test_path("resources", "stan"), + force_recompile = TRUE) expect_true(mod_w_include$check_syntax()) }) + test_that("check_syntax() works with pedantic=TRUE", { model_code <- " transformed data { @@ -496,7 +511,11 @@ test_that("cpp_options work with settings in make/local", { rebuild_cmdstan() mod <- cmdstan_model(stan_file = stan_program) - expect_null(mod$cpp_options()$stan_threads) + expect_null( + expect_warning(mod$cpp_options()$stan_threads, "Use mod\\$exe_info()") + ) + expect_false(mod$exe_info()$stan_threads) + expect_null(mod$precompile_cpp_options()$stan_threads) file.remove(mod$exe_file()) @@ -504,7 +523,10 @@ test_that("cpp_options work with settings in make/local", { file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan") mod <- cmdstan_model(file) - expect_true(mod$cpp_options()$stan_threads) + expect_true( + expect_warning(mod$cpp_options()$stan_threads, "Use mod\\$exe_info()") + ) + expect_true(mod$exe_info()$stan_threads) file.remove(mod$exe_file()) @@ -761,7 +783,8 @@ test_that("format() works with include_paths on compiled model", { stan_program_w_include <- testing_stan_file("bernoulli_include") mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE, - include_paths = test_path("resources", "stan")) + include_paths = test_path("resources", "stan"), + force_recompile = TRUE) expect_output( mod_w_include$format(), "#include ", @@ -854,4 +877,4 @@ test_that("STANCFLAGS included from make/local", { } expect_output(print(out), out_w_flags) cmdstan_make_local(cpp_options = make_local_old, append = FALSE) -}) +}) \ No newline at end of file diff --git a/tests/testthat/test-model-helpers.R b/tests/testthat/test-model-helpers.R new file mode 100644 index 00000000..b3ead5c3 --- /dev/null +++ b/tests/testthat/test-model-helpers.R @@ -0,0 +1,34 @@ +test_that("test parse_exe_info_string", { + expect_equal_ignore_order( + parse_exe_info_string(" + stan_version_major = 2 + stan_version_minor = 38 + stan_version_patch = 0 + STAN_THREADS=false + STAN_MPI=false + STAN_OPENCL=true + STAN_NO_RANGE_CHECKS=false + STAN_CPP_OPTIMS=false + "), + list( + stan_version = '2.38.0', + stan_threads = FALSE, + stan_mpi = FALSE, + stan_opencl = TRUE, + stan_no_range_checks = FALSE, + stan_cpp_optims = FALSE + ) + ) +}) + +test_that("test validate_precompile_cpp_options", { + expect_equal_ignore_order( + validate_precompile_cpp_options(list(Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE)), + list( + stan_threads = TRUE, + stan_opencl = NULL, + abc = FALSE + ) + ) + expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL= FALSE))) +}) \ No newline at end of file diff --git a/tests/testthat/test-model-recompile-logic.R b/tests/testthat/test-model-recompile-logic.R index caac4f13..41123516 100644 --- a/tests/testthat/test-model-recompile-logic.R +++ b/tests/testthat/test-model-recompile-logic.R @@ -7,10 +7,7 @@ withr::defer( teardown_env() ) -skip_message <- "To be fixed in a later version." - -test_that("warning when no recompile and no info", { - skip(skip_message) +test_that("warning when no recompile and no info", with_mocked_cli( compile_ret = list(), info_ret = list(status = 1), @@ -22,7 +19,7 @@ test_that("warning when no recompile and no info", { ) }, "Recompiling is recommended.") ) -}) +) test_that("recompiles when force_recompile flag set", with_mocked_cli( @@ -54,35 +51,203 @@ test_that("no mismatch results in no recompile", with_mocked_cli( }) )) -test_that("mismatch results in recompile.", { - skip(skip_message) +test_that("mismatch results in recompile.", with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 0, + stdout = " + stan_version_major = 2 + stan_version_minor = 35 + stan_version_patch = 0 + STAN_THREADS=false + STAN_MPI=false + STAN_OPENCL=false + STAN_NO_RANGE_CHECKS=false + STAN_CPP_OPTIMS=false + " + ), + code = expect_mock_compile({ + mod <- cmdstan_model( + stan_file = stan_program, + exe_file = file_that_exists, + cpp_options = list(stan_threads = TRUE) + ) + }) +)) +test_that( + "$exe_info(), $precompile_cpp_options() return expected data without recompile", with_mocked_cli( compile_ret = list(status = 0), info_ret = list( status = 0, - stdout = " + stdout = " stan_version_major = 2 - stan_version_minor = 35 + stan_version_minor = 38 stan_version_patch = 0 STAN_THREADS=false STAN_MPI=false - STAN_OPENCL=false + STAN_OPENCL=true STAN_NO_RANGE_CHECKS=false STAN_CPP_OPTIMS=false " ), - code = expect_mock_compile({ - mod <- cmdstan_model( - stan_file = stan_program, - exe_file = file_that_exists, - cpp_options = list(stan_threads = TRUE) + code = { + file.create(file_that_exists) + expect_no_mock_compile({ + mod <- cmdstan_model( + stan_file = stan_program, + exe_file = file_that_exists, + compile = FALSE, + cpp_options = list(Stan_Threads = TRUE, stan_opencl = NULL, aBc = FALSE) + ) + }) + expect_equal_ignore_order( + mod$exe_info(), + list( + stan_version = "2.38.0", + stan_threads = FALSE, + stan_mpi = FALSE, + stan_opencl = TRUE, + stan_no_range_checks = FALSE, + stan_cpp_optims = FALSE + ) ) - }) + expect_equal_ignore_order( + mod$precompile_cpp_options(), + list( + stan_threads = TRUE, + stan_opencl = NULL, + abc = FALSE + ) + ) + } + ) +) + +test_that("$exe_info_fallback() logic works as expected with cpp_options", + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 1, + stdout = "" + ), + code = { + file.create(file_that_exists) + expect_warning( + expect_no_mock_compile({ + mod <- cmdstan_model( + stan_file = stan_program, + exe_file = file_that_exists, + compile = FALSE, + cpp_options = list( + Stan_Threads = TRUE, + stan_Opencl = NULL, + aBc = FALSE, + dEf = NULL + ) + ) + }), + "Retrieving exe_file info failed" + ) + # cmdstan_model call same as above + # Because we use testthat 3e, cannot nest expect_warning() with itself + file.create(file_that_exists) + expect_warning( + expect_no_mock_compile({ + mod <- cmdstan_model( + stan_file = stan_program, + exe_file = file_that_exists, + compile = FALSE, + cpp_options = list( + Stan_Threads = TRUE, + stan_Opencl = NULL, + aBc = FALSE, + dEf = NULL + ) + ) + }), + "Recompiling is recommended" + ) + expect_equal( + mod$exe_info(), + list() + ) + expect_equal_ignore_order( + mod$exe_info_fallback(), + list( + stan_version = cmdstan_version(), + stan_threads = TRUE, + stan_mpi = FALSE, + stan_opencl = FALSE, + stan_no_range_checks = FALSE, + stan_cpp_optims = FALSE, + abc = FALSE, + def = NULL + ) + ) + expect_equal_ignore_order( + mod$precompile_cpp_options(), + list( + stan_threads = TRUE, + stan_opencl = NULL, + abc = FALSE, + def = NULL + ) + ) + } ) -}) +) + +test_that("$exe_info_fallback() logic works as expected without cpp_options", + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 1, + stdout = "" + ), + code = { + expect_warning( + expect_no_mock_compile({ + mod <- cmdstan_model( + exe_file = file_that_exists + ) + }), + "Retrieving exe_file info failed" + ) + # cmdstan_model call same as above + # Because we use testthat 3e, cannot nest expect_warning() with itself + expect_warning( + expect_no_mock_compile({ + mod <- cmdstan_model( + exe_file = file_that_exists + ) + }), + "Recompiling is recommended" + ) + expect_equal( + mod$exe_info(), + list() + ) + expect_equal_ignore_order( + mod$exe_info_fallback(), + list( + stan_version = cmdstan_version(), + stan_threads = FALSE, + stan_mpi = FALSE, + stan_opencl = FALSE, + stan_no_range_checks = FALSE, + stan_cpp_optims = FALSE + ) + ) + expect_equal_ignore_order( + mod$precompile_cpp_options(), + list() + ) + } + ) +) -test_that("recompile when cpp args don't match binary", { - skip(skip_message) +test_that("Recompile when cpp args don't match binary", { with_mocked_cli( compile_ret = list(status = 0), info_ret = list( diff --git a/tests/testthat/test-threads.R b/tests/testthat/test-threads.R index 8667c617..c4b1973d 100644 --- a/tests/testthat/test-threads.R +++ b/tests/testthat/test-threads.R @@ -15,7 +15,7 @@ test_that("using threads_per_chain without stan_threads set in compile() warns", "Running MCMC with 4 sequential chains", fixed = TRUE ), - "'threads_per_chain' is set but the model was not compiled with 'cpp_options = list(stan_threads = TRUE)' so 'threads_per_chain' will have no effect!", + "'threads_per_chain' is set but the model was not compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent so 'threads_per_chain' will have no effect!", fixed = TRUE) }) @@ -175,12 +175,18 @@ test_that("correct output when stan_threads unset", { expect_output( expect_warning( mod$sample(data = data_file_json, threads_per_chain = 4), - "'threads_per_chain' is set but the model was not compiled with 'cpp_options = list(stan_threads = TRUE)' so 'threads_per_chain' will have no effect!", + "'threads_per_chain' is set but the model was not compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent so 'threads_per_chain' will have no effect!", fixed = TRUE ), "Running MCMC with 4 sequential chains", fixed = TRUE ) + + expect_warning( + cmdstan_model(stan_program, cpp_options = list(stan_threads = FALSE), force_recompile = TRUE), + "STAN_THREADS set to FALSE Since this is a non-empty value, it will result in the corresponding ccp option being turned ON. To turn this option off, use cpp_options = list(stan_threads = NULL).", + fixed = TRUE + ) }) test_that('correct output when stan threads set via make local',{ From ce68d007dc87e291864bed7242055543e256e9c3 Mon Sep 17 00:00:00 2001 From: Brock Date: Fri, 9 May 2025 18:27:25 +0200 Subject: [PATCH 05/19] Add tests of new user_header logic --- R/cpp_opts.R | 1 + .../testthat/test-model-compile-user_header.R | 89 +++++++++++-------- 2 files changed, 54 insertions(+), 36 deletions(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index b961871c..20114033 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -206,6 +206,7 @@ validate_precompile_cpp_options <- function(cpp_options) { if (!is.null(cpp_options[["user_header"]]) && !is.null(cpp_options[['USER_HEADER']])) { warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) + cpp_options[["user_header"]] <- NULL } names(cpp_options) <- tolower(names(cpp_options)) diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 6cbcda04..918cc0f7 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -153,15 +153,16 @@ test_that("wsl path conversion is done as expected", { ) } ) - - cpp_options <- expect_warning( - mod$cpp_options(), - 'will be deprecated' - ) + # --Old Logic, not used-- # USER_HEADER is converted # user_header is NULL - expect_equal(cpp_options[['USER_HEADER']], w_path(tmp_file)) - expect_true(is.null(cpp_options[['user_header']])) + legacy_cpp_options <- expect_warning(mod$cpp_options(), 'will be deprecated') + expect_equal(legacy_cpp_options[['USER_HEADER']], w_path(tmp_file)) + expect_true(is.null(legacy_cpp_options[['user_header']])) + # --New Logic, used -- + # options are stored lowercase and converted + expect_equal(mod$precompile_cpp_options()[['user_header']], w_path(tmp_file)) + expect_true(is.null(mod$precompile_cpp_options()[['USER_HEADER']])) # Case 2: cpp opt USER_HEADER with_mocked_cli( @@ -177,15 +178,16 @@ test_that("wsl path conversion is done as expected", { ) } ) - - cpp_options <- expect_warning( - mod$cpp_options(), - 'will be deprecated' - ) + # --Old Logic, not used-- # USER_HEADER is converted # user_header is unconverted - expect_equal(cpp_options[['USER_HEADER']], w_path(tmp_file)) - expect_true(is.null(cpp_options[['user_header']])) + legacy_cpp_options <- expect_warning(mod$cpp_options(), 'will be deprecated') + expect_equal(legacy_cpp_options[['USER_HEADER']], w_path(tmp_file)) + expect_true(is.null(legacy_cpp_options[['user_header']])) + # --New Logic, used -- + # options are stored lowercase and converted + expect_equal(mod$precompile_cpp_options()[['user_header']], w_path(tmp_file)) + expect_true(is.null(mod$precompile_cpp_options()[['USER_HEADER']])) # Case # 3: only user_header opt with_mocked_cli( @@ -201,16 +203,16 @@ test_that("wsl path conversion is done as expected", { ) } ) - - - cpp_options <- expect_warning( - mod$cpp_options(), - 'will be deprecated' - ) + # --Old Logic, not used-- # In other cases, in the *output* USER_HEADER is windows style user_header is not. # In this case, USER_HEADER is null. - expect_true(is.null(cpp_options[['USER_HEADER']])) - expect_equal(cpp_options[['user_header']], w_path(tmp_file)) + legacy_cpp_options <- expect_warning(mod$cpp_options(), 'will be deprecated') + expect_true(is.null(legacy_cpp_options[['USER_HEADER']])) + expect_equal(legacy_cpp_options[['user_header']], w_path(tmp_file)) + # --New Logic, used -- + # options are stored lowercase and converted + expect_equal(mod$precompile_cpp_options()[['user_header']], w_path(tmp_file)) + expect_true(is.null(mod$precompile_cpp_options()[['USER_HEADER']])) }) test_that("user_header precedence order is correct", { @@ -236,22 +238,25 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) - cpp_options <- expect_warning( - mod$cpp_options(), - 'will be deprecated' - ) + # --Old Logic-- # In this case: - # cpp_options[['USER_HEADER']] == tmp_files[1] <- actually used - # cpp_options[['user_header']] == tmp_files[3] <- ignored + # cpp_options[['USER_HEADER']] == tmp_files[1] <- previously actually used + # cpp_options[['user_header']] == tmp_files[3] <- always ignored # tmp_files[2] is not stored + legacy_cpp_options <- expect_warning(mod$cpp_options(), 'will be deprecated') expect_equal( - match(cpp_options[['USER_HEADER']], w_path(tmp_files)), + match(legacy_cpp_options[['USER_HEADER']], w_path(tmp_files)), 1 ) expect_equal( - match(cpp_options[['user_header']], tmp_files), + match(legacy_cpp_options[['user_header']], tmp_files), 3 ) + # --New Logic-- + expect_equal( + match(mod$precompile_cpp_options()[['user_header']], w_path(tmp_files)), + 1 + ) # Case # 2: Both opts, but no arg with_mocked_cli( @@ -268,7 +273,8 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) - cpp_options <- expect_warning( + # --Old Logic-- + legacy_cpp_options <- expect_warning( mod$cpp_options(), 'will be deprecated' ) @@ -277,13 +283,18 @@ test_that("user_header precedence order is correct", { # cpp_options[['user_header']] == tmp_files[3] # tmp_files[2] is not stored expect_equal( - match(cpp_options[['USER_HEADER']], w_path(tmp_files)), + match(legacy_cpp_options[['USER_HEADER']], w_path(tmp_files)), 2 ) expect_equal( - match(cpp_options[['user_header']], tmp_files), + match(legacy_cpp_options[['user_header']], tmp_files), 3 ) + # --New Logic-- + expect_equal( + match(mod$precompile_cpp_options()[['user_header']], tmp_files), + 2 + ) # Case # 3: Both opts, other order with_mocked_cli( @@ -300,17 +311,23 @@ test_that("user_header precedence order is correct", { ) }, "User header specified both") ) - cpp_options <- expect_warning( + legacy_cpp_options <- expect_warning( mod$cpp_options(), 'will be deprecated' ) + # --Old Logic-- # Same as Case #2 expect_equal( - match(cpp_options[['USER_HEADER']], w_path(tmp_files)), + match(legacy_cpp_options[['USER_HEADER']], w_path(tmp_files)), 2 ) expect_equal( - match(cpp_options[['user_header']], tmp_files), + match(legacy_cpp_options[['user_header']], tmp_files), 3 ) + # --New Logic-- + expect_equal( + match(mod$precompile_cpp_options()[['user_header']], tmp_files), + 2 + ) }) From 9ffb67f70af4616739182e7daf1280bd0231b2e0 Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 11 Sep 2024 17:47:23 +0200 Subject: [PATCH 06/19] squash some bugs --- R/cpp_opts.R | 13 ++--- R/model.R | 38 ++++++------- tests/testthat/helper-custom-expectations.R | 5 +- .../testthat/test-model-compile-user_header.R | 23 +++++--- tests/testthat/test-model-compile.R | 6 -- .../testthat/test-model-generate_quantities.R | 9 ++- tests/testthat/test-model-internal.R | 55 +++++++++++++++++++ tests/testthat/test-threads.R | 10 ++-- 8 files changed, 106 insertions(+), 53 deletions(-) create mode 100644 tests/testthat/test-model-internal.R diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 20114033..5e38b462 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -152,7 +152,7 @@ assert_valid_opencl <- function( ) { if (is.null(opencl_ids)) return(invisible(opencl_ids)) - fallback <- is.null(exe_info) + fallback <- length(exe_info) == 0 if(fallback) exe_info <- fallback_exe_info # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis # the user should have been warned about this in initialize(), so no need to re-warn here. @@ -173,8 +173,7 @@ assert_valid_opencl <- function( # cpp_options must be a list assert_valid_threads <- function(threads, exe_info, fallback_exe_info, multiple_chains = FALSE) { - - fallback <- is.null(exe_info) + fallback <- length(exe_info) == 0 if(fallback) exe_info <- fallback_exe_info # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis # the user should have been warned about this in initialize(), so no need to re-warn here. @@ -189,7 +188,7 @@ assert_valid_threads <- function(threads, exe_info, fallback_exe_info, multiple_ "or equivalent, but '", threads_arg, "' was not set!", call. = FALSE ) - } else if (!is.null(threads)) { + } else if (!exe_info[["stan_threads"]] && !is.null(threads)) { warning( "'", threads_arg, "' is set but the model was not compiled with ", "'cpp_options = list(stan_threads = TRUE)' or equivalent ", @@ -218,20 +217,18 @@ validate_precompile_cpp_options <- function(cpp_options) { ) for (flag in flags_set_if_defined) { if (isFALSE(cpp_options[[flag]])) warning( - flag, " set to ", cpp_options[flag], " Since this is a non-empty value, ", + toupper(flag), " set to ", cpp_options[flag], " Since this is a non-empty value, ", "it will result in the corresponding ccp option being turned ON. To turn this", - " option off, use cpp_options = list(", tolower(flag), " = NULL)." + " option off, use cpp_options = list(", flag, " = NULL)." ) } cpp_options } - # For two functions below # both styles are lists which should have flag names in lower case as names of the list # cpp_options style means is NULL or empty string # exe_info style means off is FALSE - exe_info_style_cpp_options <- function(cpp_options) { if(is.null(cpp_options)) cpp_options <- list() names(cpp_options) <- tolower(names(cpp_options)) diff --git a/R/model.R b/R/model.R index 07a343b1..497a93fd 100644 --- a/R/model.R +++ b/R/model.R @@ -275,7 +275,7 @@ CmdStanModel <- R6::R6Class( if (!is.null(stan_file) && compile) { self$compile(...) } else { - # set exe path, same logic as in compile9) + # set exe path, same logic as in compile if(!is.null(private$dir_)){ dir <- repair_path(absolute_path(private$dir_)) assert_dir_exists(dir, access = "rw") @@ -297,13 +297,8 @@ CmdStanModel <- R6::R6Class( # exe_info is updated inside the compile method (if compile command is run) exe_info <- self$exe_info(update = TRUE) + if(file.exists(self$exe_file())) exe_info_reflects_cpp_options(self$exe_info(), args$cpp_options) } - - # for now, set this based on current version - # at initialize so its never null - # in the future, will be set only if/when we have a binary - # as the version the model was compiled with - private$cmdstan_version_ <- cmdstan_version() if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { private$cpp_options_ <- model_compile_info_legacy(self$exe_file(), self$cmdstan_version()) } @@ -366,6 +361,10 @@ CmdStanModel <- R6::R6Class( # cmdstan version < "2.26.1" cli_info_success <- !is.null(ret$status) && ret$status == 0 + if(!cli_info_success) warning( + 'Retrieving exe_file info failed. ', + 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' + ) exe_info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() cpp_options <- exe_info_style_cpp_options(private$precompile_cpp_options_) compiled_with_cpp_options <- !is.null(private$cmdstan_version_) @@ -377,7 +376,7 @@ CmdStanModel <- R6::R6Class( # info cli as source of truth exe_info, # use cpp_options for options not provided in info - cpp_options[names(cpp_options) %in% names(exe_info)] + cpp_options[!names(cpp_options) %in% names(exe_info)] ) } else if (cli_info_success) { # no compile/recompile has occurred, we only trust info cli @@ -385,11 +384,7 @@ CmdStanModel <- R6::R6Class( exe_info } else { # info cli failure + no compile/recompile has occurred - warning( - 'Retrieving exe_file info failed. Recompiling is recommended. ', - 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' - ) - NULL + list() } } private$exe_info_ @@ -404,7 +399,7 @@ CmdStanModel <- R6::R6Class( ) }, cmdstan_version = function(fallback = TRUE) { - # this is intentionally not self$cmdstan_version_ + # this is intentionally not private$cmdstan_version_ # because that value is only set if model has been recomplied # since CmdStanModel instantiation if (!fallback) self$exe_info()[['stan_version']] @@ -643,6 +638,7 @@ compile <- function(quiet = TRUE, private$using_user_header_ <- TRUE } + if (!is.null(cpp_options[["user_header"]])) { # Transform back to non-wsl version to check for existance # this is needed for WSv1 @@ -665,6 +661,9 @@ compile <- function(quiet = TRUE, # - the executable does not exist # - the stan model was changed since last compilation # - a user header is used and the user header changed since last compilation (#813) + self$exe_file(exe) + self$exe_info(update = TRUE) + if (!file.exists(exe)) { force_recompile <- TRUE } else if (file.exists(self$stan_file()) @@ -674,20 +673,20 @@ compile <- function(quiet = TRUE, && file.exists(user_header) && file.mtime(exe) < file.mtime(user_header)) { force_recompile <- TRUE + } else if (!isTRUE(exe_info_reflects_cpp_options(self$exe_info(), cpp_options))) { + force_recompile <- TRUE } - if ((!force_recompile) && rlang::is_interactive()) { + if (!force_recompile && rlang::is_interactive()) { message("Model executable is up to date!") } - if ((!force_recompile)) { + if (!force_recompile) { private$cpp_options_ <- cpp_options private$precompile_cpp_options_ <- cpp_options private$precompile_stanc_options_ <- NULL private$precompile_include_paths_ <- NULL self$functions$existing_exe <- TRUE - self$exe_file(exe) - self$exe_info(update = TRUE) return(invisible(self)) } else { if (rlang::is_interactive()) { @@ -743,7 +742,6 @@ compile <- function(quiet = TRUE, self$functions$existing_exe <- FALSE stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " ")) - if (!dry_run) { if (compile_standalone) { @@ -2466,4 +2464,4 @@ resolve_exe_path <- function( exe <- self_exe_file } exe -} \ No newline at end of file +} diff --git a/tests/testthat/helper-custom-expectations.R b/tests/testthat/helper-custom-expectations.R index c4de9e4c..47a6e38b 100644 --- a/tests/testthat/helper-custom-expectations.R +++ b/tests/testthat/helper-custom-expectations.R @@ -34,7 +34,7 @@ expect_call_compilation <- function(constructor_call) { #' @param ... arguments passed to mod$compile() expect_no_recompilation <- function(mod, ...) { if(length(mod$exe_file()) == 0 || !file.exists(mod$exe_file())) { - fail(sprint("Model executable '%s' does not exist, cannot test if recompilation is triggerred.", mod$exe_file())) + fail(sprint("Model executable '%s' does not exist, cannot test if recompilation is triggerred.", mod$exe_file())) } before_mtime <- file.mtime(mod$exe_file()) @@ -54,9 +54,6 @@ expect_sample_output <- function(object, num_chains = NULL) { output <- paste(output, num_chains, "sequential chain") } } - # DONT MERGE WITH THIS LINE - cat <- base::cat - # ^ Workaround for: https://github.com/ManuelHentschel/vscDebugger/issues/196 expect_output(object, output) } diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 918cc0f7..42ada48f 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -2,7 +2,11 @@ skip_if(os_is_macos()) file_that_exists <- "placeholder_exists" file_that_doesnt_exist <- "placeholder_doesnt_exist" -withr::local_file(file_that_exists) +file.create(file_that_exists) +withr::defer( + if (file.exists(file_that_exists)) file.remove(file_that_exists), + teardown_env() +) w_path <- function(f) { x <- sapply(f, function(fi) wsl_safe_path(absolute_path(fi))) @@ -42,10 +46,15 @@ test_that("cmdstan_model works with user_header with mock", { compile_ret = list(status = 0), info_ret = list(), code = expect_mock_compile( - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), - exe_file = file_that_exists, - user_header = tmpfile + expect_warning( + expect_no_warning({ + mod <- cmdstan_model( + stan_file = testing_stan_file("bernoulli_external"), + exe_file = file_that_exists, + user_header = tmpfile + ) + }, message = 'Recompiling is recommended'), # this warning should not occur because recompile happens automatically + 'Retrieving exe_file info failed' # this warning should occur ) ) ) @@ -67,7 +76,7 @@ test_that("cmdstan_model works with user_header with mock", { file.create(file_that_exists) with_mocked_cli( compile_ret = list(status = 0), - info_ret = list(), + info_ret = list(status = 0, stdout = ""), code = expect_no_mock_compile({ mod$compile(quiet = TRUE, user_header = tmpfile) }) @@ -76,7 +85,7 @@ test_that("cmdstan_model works with user_header with mock", { Sys.setFileTime(tmpfile, Sys.time() + 1) # touch file to trigger recompile with_mocked_cli( compile_ret = list(status = 0), - info_ret = list(), + info_ret = list(status = 0, stdout = ""), code = expect_mock_compile({ mod$compile(quiet = TRUE, user_header = tmpfile) }) diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index 64945478..c5ce0d21 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -21,7 +21,6 @@ test_that("object initialized correctly", { fixed = TRUE ) }) - test_that("error if no compile() before model fitting", { expect_error( mod$sample(), @@ -88,9 +87,6 @@ test_that("compile() method overwrites binaries", { expect_gt(file.mtime(mod$exe_file()), old_time) }) - -# Test with Side Effect ----- - test_that("compilation works with include_paths", { stan_program_w_include <- testing_stan_file("bernoulli_include") exe <- cmdstan_ext(strip_ext(stan_program_w_include)) @@ -121,8 +117,6 @@ test_that("compilation works with include_paths", { ) }) - - test_that("name in STANCFLAGS is set correctly", { out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE)) if(os_is_windows() && !os_is_wsl()) { diff --git a/tests/testthat/test-model-generate_quantities.R b/tests/testthat/test-model-generate_quantities.R index 7df7f2b7..9f5ec1fb 100644 --- a/tests/testthat/test-model-generate_quantities.R +++ b/tests/testthat/test-model-generate_quantities.R @@ -21,7 +21,6 @@ bad_arg_values <- list( parallel_chains = -20 ) - test_that("generate_quantities() method runs when all arguments specified validly", { # specifying all arguments validly expect_gq_output(fit1 <- do.call(mod_gq$generate_quantities, ok_arg_values)) @@ -52,7 +51,11 @@ test_that("generate_quantities work for different chains and parallel_chains", { expect_gq_output( mod_gq$generate_quantities(data = data_list, fitted_params = fit, parallel_chains = 4) ) - mod_gq <- cmdstan_model(testing_stan_file("bernoulli_ppc"), cpp_options = list(stan_threads = TRUE)) + + expect_call_compilation({ + mod_gq <- cmdstan_model(testing_stan_file("bernoulli_ppc"), cpp_options = list(stan_threads = TRUE)) + }) + expect_gq_output( mod_gq$generate_quantities(data = data_list, fitted_params = fit_1_chain, threads_per_chain = 2) ) @@ -91,4 +94,4 @@ test_that("generate_quantities() warns if threads specified but not enabled", { expect_gq_output(fit_gq <- mod_gq$generate_quantities(data = data_list, fitted_params = fit, threads_per_chain = 4)), "'threads_per_chain' will have no effect" ) -}) +}) \ No newline at end of file diff --git a/tests/testthat/test-model-internal.R b/tests/testthat/test-model-internal.R new file mode 100644 index 00000000..24c42fad --- /dev/null +++ b/tests/testthat/test-model-internal.R @@ -0,0 +1,55 @@ +test_that("parse_exe_info_string works", { + expect_equal_ignore_order( + parse_exe_info_string(" + stan_version_major = 2 + stan_version_minor = 38 + stan_version_patch = 0 + STAN_THREADS=false + STAN_MPI=false + STAN_OPENCL=true + STAN_NO_RANGE_CHECKS=false + STAN_CPP_OPTIMS=false + "), + list( + stan_version = '2.38.0', + stan_threads = FALSE, + stan_mpi = FALSE, + stan_opencl = TRUE, + stan_no_range_checks = FALSE, + stan_cpp_optims = FALSE + ) + ) +}) + +test_that("validate_precompile_cpp_options works", { + expect_equal_ignore_order( + validate_precompile_cpp_options(list(Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE)), + list( + stan_threads = TRUE, + stan_opencl = NULL, + abc = FALSE + ) + ) + expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL= FALSE))) +}) + + +test_that('exe_info cpp_options comparison works', { + exe_info_all_flags_off <- exe_info_style_cpp_options(list()) + exe_info_all_flags_off[['stan_version']] <- '35.0.0' + + expect_true(exe_info_reflects_cpp_options(exe_info_all_flags_off, list())) + expect_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE), list(stan_opencl = NULL))) + expect_not_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE), list(stan_opencl = FALSE))) + expect_not_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE, stan_threads = FALSE), list(stan_opencl = NULL, stan_threads = TRUE))) + expect_not_true(exe_info_reflects_cpp_options( + list(stan_opencl = FALSE, stan_threads = FALSE), + list(stan_opencl = NULL, stan_threads = TRUE, EXTRA_ARG = TRUE) + )) + + # no exe_info -> no recompile based on cpp info + expect_warning( + expect_true(exe_info_reflects_cpp_options(list(), list())), + 'Recompiling is recommended' + ) +}) \ No newline at end of file diff --git a/tests/testthat/test-threads.R b/tests/testthat/test-threads.R index c4b1973d..ec7b48a3 100644 --- a/tests/testthat/test-threads.R +++ b/tests/testthat/test-threads.R @@ -24,7 +24,7 @@ test_that("threading works with sample()", { expect_error( mod$sample(data = data_file_json), - "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads_per_chain' was not set!", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent, but 'threads_per_chain' was not set!", fixed = TRUE ) @@ -57,7 +57,7 @@ test_that("threading works with optimize()", { expect_error( mod$optimize(data = data_file_json), - "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads' was not set!", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent, but 'threads' was not set!", fixed = TRUE ) @@ -91,7 +91,7 @@ test_that("threading works with variational()", { expect_error( mod$variational(data = data_file_json), - "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads' was not set!", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent, but 'threads' was not set!", fixed = TRUE ) @@ -130,7 +130,7 @@ test_that("threading works with generate_quantities()", { ) expect_error( mod_gq$generate_quantities(fitted_params = f, data = data_file_json), - "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads_per_chain' was not set!", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent, but 'threads_per_chain' was not set!", fixed = TRUE ) expect_output( @@ -168,7 +168,7 @@ test_that("correct output when stan_threads unset", { mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = "dummy string"), force_recompile = TRUE) expect_error( mod$sample(data = data_file_json), - "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' but 'threads_per_chain' was not set!", + "The model was compiled with 'cpp_options = list(stan_threads = TRUE)' or equivalent, but 'threads_per_chain' was not set!", fixed = TRUE ) mod <- cmdstan_model(stan_program, cpp_options = list(stan_threads = NULL), force_recompile = TRUE) From a137c7f52b06c8cb368310d6e89f436011dc5efd Mon Sep 17 00:00:00 2001 From: Brock Date: Tue, 17 Dec 2024 10:54:58 +0100 Subject: [PATCH 07/19] defaults list()-> NULL --- R/cpp_opts.R | 31 +++++++++++-------------------- R/model.R | 4 ++-- 2 files changed, 13 insertions(+), 22 deletions(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 5e38b462..cbe1950f 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -35,12 +35,7 @@ parse_exe_info_string <- function(ret_stdout) { } } - info[["stan_version"]] <- paste0( - info[["stan_version_major"]], - ".", - info[["stan_version_minor"]], - ".", info[["stan_version_patch"]] - ) + info[["stan_version"]] <- paste0(info[["stan_version_major"]], ".", info[["stan_version_minor"]], ".", info[["stan_version_patch"]]) info[["stan_version_major"]] <- NULL info[["stan_version_minor"]] <- NULL info[["stan_version_patch"]] <- NULL @@ -74,13 +69,11 @@ model_compile_info_legacy <- function(exe_file, version) { if (!is.na(as.logical(val))) { val <- as.logical(val) } - info[[tolower(key_val[1])]] <- val + if (!is.logical(val) || isTRUE(val)) { + info[[tolower(key_val[1])]] <- val + } } } - info[["STAN_VERSION"]] <- paste0(info[["STAN_VERSION_MAJOR"]], ".", info[["STAN_VERSION_MINOR"]], ".", info[["STAN_VERSION_PATCH"]]) - info[["STAN_VERSION_MAJOR"]] <- NULL - info[["STAN_VERSION_MINOR"]] <- NULL - info[["STAN_VERSION_PATCH"]] <- NULL } } info @@ -225,6 +218,7 @@ validate_precompile_cpp_options <- function(cpp_options) { cpp_options } + # For two functions below # both styles are lists which should have flag names in lower case as names of the list # cpp_options style means is NULL or empty string @@ -233,28 +227,25 @@ exe_info_style_cpp_options <- function(cpp_options) { if(is.null(cpp_options)) cpp_options <- list() names(cpp_options) <- tolower(names(cpp_options)) flags_reported_in_exe_info <- c( - "stan_threads", "stan_mpi", "stan_opencl", - "stan_no_range_checks", "stan_cpp_optims" + "stan_threads", "stan_mpi", "stan_opencl", "stan_no_range_checks", "stan_cpp_optims" ) for (flag in flags_reported_in_exe_info) { - cpp_options[[flag]] <- !( - is.null(cpp_options[[flag]]) || cpp_options[[flag]] == "" - ) + cpp_options[[flag]] <- !(is.null(cpp_options[[flag]]) || cpp_options[[flag]] == '') } cpp_options } exe_info_reflects_cpp_options <- function(exe_info, cpp_options) { - if (length(exe_info) == 0) { - warning("Recompiling is recommended due to missing exe_info.") + if(length(exe_info) == 0) { + warning('Recompiling is recommended due to missing exe_info.') return(TRUE) } - if (is.null(cpp_options)) return(TRUE) + if(is.null(cpp_options)) return(TRUE) cpp_options <- exe_info_style_cpp_options(cpp_options)[tolower(names(cpp_options))] overlap <- names(cpp_options)[names(cpp_options) %in% names(exe_info)] - if (length(overlap) == 0) TRUE else all.equal( + if(length(overlap) == 0) TRUE else all.equal( exe_info[overlap], cpp_options[overlap] ) diff --git a/R/model.R b/R/model.R index 497a93fd..48e630eb 100644 --- a/R/model.R +++ b/R/model.R @@ -231,11 +231,11 @@ CmdStanModel <- R6::R6Class( stanc_options_ = list(), include_paths_ = NULL, using_user_header_ = FALSE, - precompile_cpp_options_ = list(), + precompile_cpp_options_ = NULL, precompile_stanc_options_ = NULL, precompile_include_paths_ = NULL, variables_ = NULL, - exe_info_ = list(), + exe_info_ = NULL, # intentionally only set at compile(), not initialize() cmdstan_version_ = NULL ), From 4c8fbd8516629eb9f2c4fe7b48655e3ecabbf768 Mon Sep 17 00:00:00 2001 From: Brock Date: Tue, 17 Dec 2024 10:59:26 +0100 Subject: [PATCH 08/19] remove/rename exe_info variable --- R/model.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/model.R b/R/model.R index 48e630eb..ee1bb735 100644 --- a/R/model.R +++ b/R/model.R @@ -296,7 +296,7 @@ CmdStanModel <- R6::R6Class( } # exe_info is updated inside the compile method (if compile command is run) - exe_info <- self$exe_info(update = TRUE) + self$exe_info(update = TRUE) if(file.exists(self$exe_file())) exe_info_reflects_cpp_options(self$exe_info(), args$cpp_options) } if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { @@ -365,7 +365,7 @@ CmdStanModel <- R6::R6Class( 'Retrieving exe_file info failed. ', 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' ) - exe_info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() + info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() cpp_options <- exe_info_style_cpp_options(private$precompile_cpp_options_) compiled_with_cpp_options <- !is.null(private$cmdstan_version_) @@ -374,14 +374,14 @@ CmdStanModel <- R6::R6Class( # cpp_options as were used as configured c( # info cli as source of truth - exe_info, + info, # use cpp_options for options not provided in info - cpp_options[!names(cpp_options) %in% names(exe_info)] + cpp_options[!names(cpp_options) %in% names(info)] ) } else if (cli_info_success) { # no compile/recompile has occurred, we only trust info cli # don't know if other cpp_options were applied, so skip them - exe_info + info } else { # info cli failure + no compile/recompile has occurred list() From bc1d9af1545bb12c912c28e1a3eacc4c92ad4d8d Mon Sep 17 00:00:00 2001 From: Brock Date: Tue, 17 Dec 2024 11:01:10 +0100 Subject: [PATCH 09/19] small format change Co-authored-by: Steve Bronder --- R/model.R | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/R/model.R b/R/model.R index ee1bb735..f5ef17a7 100644 --- a/R/model.R +++ b/R/model.R @@ -297,7 +297,9 @@ CmdStanModel <- R6::R6Class( # exe_info is updated inside the compile method (if compile command is run) self$exe_info(update = TRUE) - if(file.exists(self$exe_file())) exe_info_reflects_cpp_options(self$exe_info(), args$cpp_options) + if(file.exists(self$exe_file())) { + exe_info_reflects_cpp_options(self$exe_info(), args$cpp_options) + } } if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { private$cpp_options_ <- model_compile_info_legacy(self$exe_file(), self$cmdstan_version()) @@ -368,7 +370,10 @@ CmdStanModel <- R6::R6Class( info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() cpp_options <- exe_info_style_cpp_options(private$precompile_cpp_options_) compiled_with_cpp_options <- !is.null(private$cmdstan_version_) - + if(!cli_info_success) warning( + 'Retrieving exe_file info failed. ', + 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' + ) private$exe_info_ <- if (compiled_with_cpp_options) { # recompile has occurred since the CmdStanModel was created # cpp_options as were used as configured @@ -402,7 +407,9 @@ CmdStanModel <- R6::R6Class( # this is intentionally not private$cmdstan_version_ # because that value is only set if model has been recomplied # since CmdStanModel instantiation - if (!fallback) self$exe_info()[['stan_version']] + if (!fallback) { + return(self$exe_info()[['stan_version']]) + } for (candidate in c( self$exe_info()[['stan_version']], self$exe_info_fallback()[['stan_version']] From 767ede9473fd4dfa64a6eedb2d547fdca20b6246 Mon Sep 17 00:00:00 2001 From: Brock Date: Tue, 17 Dec 2024 11:48:01 +0100 Subject: [PATCH 10/19] add verbose arg to info call --- R/cpp_opts.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index cbe1950f..8a0b8098 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -19,7 +19,7 @@ run_info_cli <- function(exe_file) { ret } -# new (future) parser +# new parser # Parse the string output of `info` into an R object (list) parse_exe_info_string <- function(ret_stdout) { info <- list() From 6cce506f4832cefc15c8eb237c9dc139075b503c Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 18 Dec 2024 08:17:10 +0100 Subject: [PATCH 11/19] move exe file path resolution to separate function --- R/model.R | 35 ++++------------------------------- 1 file changed, 4 insertions(+), 31 deletions(-) diff --git a/R/model.R b/R/model.R index f5ef17a7..c9b785c4 100644 --- a/R/model.R +++ b/R/model.R @@ -275,25 +275,9 @@ CmdStanModel <- R6::R6Class( if (!is.null(stan_file) && compile) { self$compile(...) } else { - # set exe path, same logic as in compile - if(!is.null(private$dir_)){ - dir <- repair_path(absolute_path(private$dir_)) - assert_dir_exists(dir, access = "rw") - if (length(self$exe_file()) != 0) { - self$exe_file(file.path(dir, basename(self$exe_file()))) - } - } - if (length(self$exe_file()) == 0) { - if (is.null(private$dir_)) { - exe_base <- self$stan_file() - } else { - exe_base <- file.path(private$dir_, basename(self$stan_file())) - } - self$exe_file(cmdstan_ext(strip_ext(exe_base))) - if (dir.exists(self$exe_file())) { - stop("There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again.", call. = FALSE) - } - } + # resolve exe path with dir + exe <- resolve_exe_path(args$dir, private$dir_, self$exe_file(), self$stan_file()) + self$exe_file(exe) # exe_info is updated inside the compile method (if compile command is run) self$exe_info(update = TRUE) @@ -597,18 +581,6 @@ compile <- function(quiet = TRUE, include_paths <- private$precompile_include_paths_ } private$include_paths_ <- include_paths - if (is.null(dir) && !is.null(private$dir_)) { - dir <- absolute_path(private$dir_) - } else if (!is.null(dir)) { - dir <- absolute_path(dir) - } - if (!is.null(dir)) { - dir <- repair_path(dir) - assert_dir_exists(dir, access = "rw") - if (length(self$exe_file()) != 0) { - private$exe_file_ <- file.path(dir, basename(self$exe_file())) - } - } # temporary deprecation warnings if (isTRUE(threads)) { @@ -2437,6 +2409,7 @@ model_variables <- function(stan_file, include_paths = NULL, allow_undefined = F is_variables_method_supported <- function(mod) { cmdstan_version() >= "2.27.0" && mod$has_stan_file() && file.exists(mod$stan_file()) } + resolve_exe_path <- function( dir = NULL, private_dir = NULL, self_exe_file = NULL, self_stan_file = NULL ) { From de8563c93782685afd521f58f25f6f0be7769989 Mon Sep 17 00:00:00 2001 From: Brock Date: Wed, 18 Dec 2024 16:34:14 +0100 Subject: [PATCH 12/19] lint --- R/cpp_opts.R | 92 ++++++++-------- R/model.R | 102 +++++++++++++----- R/path.R | 4 +- tests/testthat/helper-custom-expectations.R | 2 +- .../testthat/test-model-compile-user_header.R | 6 +- tests/testthat/test-model-compile.R | 11 +- .../testthat/test-model-generate_quantities.R | 5 +- tests/testthat/test-model-internal.R | 44 +++++--- tests/testthat/test-opencl.R | 6 +- 9 files changed, 176 insertions(+), 96 deletions(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 8a0b8098..3178dbf9 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -21,6 +21,7 @@ run_info_cli <- function(exe_file) { # new parser # Parse the string output of `info` into an R object (list) + parse_exe_info_string <- function(ret_stdout) { info <- list() info_raw <- strsplit(strsplit(ret_stdout, "\n")[[1]], "=") @@ -35,7 +36,12 @@ parse_exe_info_string <- function(ret_stdout) { } } - info[["stan_version"]] <- paste0(info[["stan_version_major"]], ".", info[["stan_version_minor"]], ".", info[["stan_version_patch"]]) + info[["stan_version"]] <- paste0( + info[["stan_version_major"]], + ".", + info[["stan_version_minor"]], + ".", info[["stan_version_patch"]] + ) info[["stan_version_major"]] <- NULL info[["stan_version_minor"]] <- NULL info[["stan_version_patch"]] <- NULL @@ -110,9 +116,10 @@ validate_cpp_options <- function(cpp_options) { ) { warning( "User header specified both via cpp_options[[\"USER_HEADER\"]] ", - "and cpp_options[[\"user_header\"]]. Please only specify your user header in one location", + "and cpp_options[[\"user_header\"]].", call. = FALSE ) + cpp_options[["user_header"]] <- NULL } names(cpp_options) <- tolower(names(cpp_options)) @@ -141,18 +148,24 @@ validate_cpp_options <- function(cpp_options) { assert_valid_opencl <- function( opencl_ids, exe_info, - fallback_exe_info = list('stan_version' = '2.0.0', 'stan_opencl' = FALSE) + fallback_exe_info = list("stan_version" = "2.0.0", "stan_opencl" = FALSE) ) { if (is.null(opencl_ids)) return(invisible(opencl_ids)) - - fallback <- length(exe_info) == 0 - if(fallback) exe_info <- fallback_exe_info - # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis - # the user should have been warned about this in initialize(), so no need to re-warn here. - if(fallback) stop <- warning + + fallback <- length(exe_info) == 0 + if (fallback) exe_info <- fallback_exe_info + # If we're unsure if this info is accurate, + # we shouldn't stop the user from attempting on that basis + # the user should have been warned about this in initialize(), + # so no need to re-warn here. + if (fallback) stop <- warning if (exe_info[['stan_version']] < "2.26.0") { - stop("Runtime selection of OpenCL devices is only supported with CmdStan version 2.26 or newer.", call. = FALSE) + stop( + "Runtime selection of OpenCL devices is only supported ", + "with CmdStan version 2.26 or newer.", + call. = FALSE + ) } if (isFALSE(exe_info[["stan_opencl"]])) { @@ -165,12 +178,19 @@ assert_valid_opencl <- function( } # cpp_options must be a list -assert_valid_threads <- function(threads, exe_info, fallback_exe_info, multiple_chains = FALSE) { - fallback <- length(exe_info) == 0 - if(fallback) exe_info <- fallback_exe_info - # If we're unsure if this info is accurate, we shouldn't stop the user from attempting on that basis - # the user should have been warned about this in initialize(), so no need to re-warn here. - if(fallback) stop <- warning +assert_valid_threads <- function( + threads, + exe_info, + fallback_exe_info, + multiple_chains = FALSE +) { + fallback <- length(exe_info) == 0 + if (fallback) exe_info <- fallback_exe_info + # If we're unsure if this info is accurate, + # we shouldn't stop the user from attempting on that basis + # the user should have been warned about this in initialize(), + # so no need to re-warn here. + if (fallback) stop <- warning threads_arg <- if (multiple_chains) "threads_per_chain" else "threads" checkmate::assert_integerish(threads, .var.name = threads_arg, @@ -193,59 +213,39 @@ assert_valid_threads <- function(threads, exe_info, fallback_exe_info, multiple_ invisible(threads) } -validate_precompile_cpp_options <- function(cpp_options) { - if(is.null(cpp_options) || length(cpp_options) == 0) return(list()) - - if (!is.null(cpp_options[["user_header"]]) && !is.null(cpp_options[['USER_HEADER']])) { - warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) - cpp_options[["user_header"]] <- NULL - } - - names(cpp_options) <- tolower(names(cpp_options)) - flags_set_if_defined <- c( - # cmdstan - "stan_threads", "stan_mpi", "stan_opencl", "stan_no_range_checks", "stan_cpp_optims", - # stan math - "integrated_opencl", "tbb_lib", "tbb_inc", "tbb_interface_new" - ) - for (flag in flags_set_if_defined) { - if (isFALSE(cpp_options[[flag]])) warning( - toupper(flag), " set to ", cpp_options[flag], " Since this is a non-empty value, ", - "it will result in the corresponding ccp option being turned ON. To turn this", - " option off, use cpp_options = list(", flag, " = NULL)." - ) - } - cpp_options -} # For two functions below # both styles are lists which should have flag names in lower case as names of the list # cpp_options style means is NULL or empty string # exe_info style means off is FALSE + exe_info_style_cpp_options <- function(cpp_options) { if(is.null(cpp_options)) cpp_options <- list() names(cpp_options) <- tolower(names(cpp_options)) flags_reported_in_exe_info <- c( - "stan_threads", "stan_mpi", "stan_opencl", "stan_no_range_checks", "stan_cpp_optims" + "stan_threads", "stan_mpi", "stan_opencl", + "stan_no_range_checks", "stan_cpp_optims" ) for (flag in flags_reported_in_exe_info) { - cpp_options[[flag]] <- !(is.null(cpp_options[[flag]]) || cpp_options[[flag]] == '') + cpp_options[[flag]] <- !( + is.null(cpp_options[[flag]]) || cpp_options[[flag]] == "" + ) } cpp_options } exe_info_reflects_cpp_options <- function(exe_info, cpp_options) { - if(length(exe_info) == 0) { - warning('Recompiling is recommended due to missing exe_info.') + if (length(exe_info) == 0) { + warning("Recompiling is recommended due to missing exe_info.") return(TRUE) } - if(is.null(cpp_options)) return(TRUE) + if (is.null(cpp_options)) return(TRUE) cpp_options <- exe_info_style_cpp_options(cpp_options)[tolower(names(cpp_options))] overlap <- names(cpp_options)[names(cpp_options) %in% names(exe_info)] - if(length(overlap) == 0) TRUE else all.equal( + if (length(overlap) == 0) TRUE else all.equal( exe_info[overlap], cpp_options[overlap] ) diff --git a/R/model.R b/R/model.R index c9b785c4..041efc73 100644 --- a/R/model.R +++ b/R/model.R @@ -1,4 +1,3 @@ - #' Create a new CmdStanModel object #' #' @description \if{html}{\figure{logo.png}{options: width=25}} @@ -252,7 +251,7 @@ CmdStanModel <- R6::R6Class( private$stan_file_ <- absolute_path(stan_file) private$stan_code_ <- readLines(stan_file) private$model_name_ <- sub(" ", "_", strip_ext(basename(private$stan_file_))) - private$precompile_cpp_options_ <- validate_precompile_cpp_options(args$cpp_options) %||% list() + private$precompile_cpp_options_ <- validate_cpp_options(args$cpp_options) %||% list() private$precompile_stanc_options_ <- assert_valid_stanc_options(args$stanc_options) %||% list() if (!is.null(args$user_header) || !is.null(args$cpp_options[["USER_HEADER"]]) || !is.null(args$cpp_options[["user_header"]])) { @@ -392,18 +391,20 @@ CmdStanModel <- R6::R6Class( # because that value is only set if model has been recomplied # since CmdStanModel instantiation if (!fallback) { - return(self$exe_info()[['stan_version']]) + return(self$exe_info()[["stan_version"]]) } for (candidate in c( - self$exe_info()[['stan_version']], - self$exe_info_fallback()[['stan_version']] - )) if (!is.null(candidate)) return (candidate) + self$exe_info()[["stan_version"]], + self$exe_info_fallback()[["stan_version"]] + )) if (!is.null(candidate)) return(candidate) }, cpp_options = function() { warning( - 'mod$cpp_options() will be deprecated in the next major version of cmdstanr. ', - 'Use mod$exe_info() to see options from last compilation. ', - 'Use mod$precompile_cpp_options() to see default options for next compilation.' + "mod$cpp_options() will be deprecated ", + "in the next major version of cmdstanr. ", + "Use mod$exe_info() to see options from last compilation. ", + "Use mod$precompile_cpp_options() ", + "to see default options for next compilation." ) private$cpp_options_ }, @@ -565,13 +566,16 @@ compile <- function(quiet = TRUE, if (!is.null(user_header) && ( !is.null(cpp_options[["USER_HEADER"]]) || !is.null(cpp_options[["user_header"]]) - )) warning("User header specified both via user_header argument and via cpp_options arguments") + )) warning( + "User header specified both via user_header argument ", + "and via cpp_options arguments" + ) if (length(cpp_options) == 0 && !is.null(private$precompile_cpp_options_)) { cpp_options <- private$precompile_cpp_options_ } cpp_options_legacy <- cpp_options - cpp_options <- validate_precompile_cpp_options(cpp_options) + cpp_options <- validate_cpp_options(cpp_options) if (length(stanc_options) == 0 && !is.null(private$precompile_stanc_options_)) { stanc_options <- private$precompile_stanc_options_ @@ -810,7 +814,10 @@ compile <- function(quiet = TRUE, private$precompile_stanc_options_ <- NULL private$precompile_include_paths_ <- NULL - # Must be run after private$cmdstan_version_, private$exe_file_, and private$precompiled_cpp_options_ + # Must be run after + # - private$cmdstan_version_ + # - private$exe_file_ + # - private$precompiled_cpp_options_ # are all up to date self$exe_info(update=TRUE) @@ -1340,7 +1347,11 @@ sample <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1597,7 +1608,11 @@ optimize <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) + threads_per_proc = assert_valid_threads( + threads, + self$exe_info(), + self$exe_info_fallback() + ) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1632,7 +1647,11 @@ optimize <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1737,7 +1756,11 @@ laplace <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) + threads_per_proc = assert_valid_threads( + threads, + self$exe_info(), + self$exe_info_fallback() + ) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1799,7 +1822,11 @@ laplace <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -1887,7 +1914,11 @@ variational <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(threads, self$exe_info(), self$exe_info_fallback()) + threads_per_proc = assert_valid_threads( + threads, + self$exe_info(), + self$exe_info_fallback() + ) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -1922,7 +1953,11 @@ variational <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables, save_cmdstan_config = save_cmdstan_config ) @@ -2032,7 +2067,11 @@ pathfinder <- function(data = NULL, num_procs = 1, show_stderr_messages = show_exceptions, show_stdout_messages = show_messages, - threads_per_proc = assert_valid_threads(num_threads, self$exe_info(), self$exe_info_fallback()) + threads_per_proc = assert_valid_threads( + num_threads, + self$exe_info(), + self$exe_info_fallback() + ) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -2072,7 +2111,11 @@ pathfinder <- function(data = NULL, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables, num_threads = num_threads, save_cmdstan_config = save_cmdstan_config @@ -2169,7 +2212,12 @@ generate_quantities <- function(fitted_params, procs <- CmdStanGQProcs$new( num_procs = length(fitted_params_files), parallel_procs = checkmate::assert_integerish(parallel_chains, lower = 1, null.ok = TRUE), - threads_per_proc = assert_valid_threads(threads_per_chain, self$exe_info(), self$exe_info_fallback(), multiple_chains = TRUE) + threads_per_proc = assert_valid_threads( + threads_per_chain, + self$exe_info(), + self$exe_info_fallback(), + multiple_chains = TRUE + ) ) model_variables <- NULL if (is_variables_method_supported(self)) { @@ -2190,7 +2238,11 @@ generate_quantities <- function(fitted_params, output_dir = output_dir, output_basename = output_basename, sig_figs = sig_figs, - opencl_ids = assert_valid_opencl(opencl_ids, self$exe_info(), self$exe_info_fallback()), + opencl_ids = assert_valid_opencl( + opencl_ids, + self$exe_info(), + self$exe_info_fallback() + ), model_variables = model_variables ) runset <- CmdStanRun$new(args, procs) @@ -2407,7 +2459,9 @@ model_variables <- function(stan_file, include_paths = NULL, allow_undefined = F } is_variables_method_supported <- function(mod) { - cmdstan_version() >= "2.27.0" && mod$has_stan_file() && file.exists(mod$stan_file()) + cmdstan_version() >= "2.27.0" && + mod$has_stan_file() && + file.exists(mod$stan_file()) } resolve_exe_path <- function( diff --git a/R/path.R b/R/path.R index da2fc128..4353d7b1 100644 --- a/R/path.R +++ b/R/path.R @@ -234,9 +234,9 @@ unset_cmdstan_path <- function() { } # fake a cmdstan version (only used in tests) -fake_cmdstan_version <- function(version, mod=NULL) { +fake_cmdstan_version <- function(version, mod = NULL) { .cmdstanr$VERSION <- version - if(!is.null(mod)) { + if (!is.null(mod)) { if (!is.null(mod$.__enclos_env__$private$exe_info_)) { mod$.__enclos_env__$private$exe_info_$stan_version <- version } diff --git a/tests/testthat/helper-custom-expectations.R b/tests/testthat/helper-custom-expectations.R index 47a6e38b..b0d22a96 100644 --- a/tests/testthat/helper-custom-expectations.R +++ b/tests/testthat/helper-custom-expectations.R @@ -107,4 +107,4 @@ expect_equal_ignore_order <- function(object, expected, ...) { expect_equal(object, expected, ...) } -expect_not_true <- function(...) expect_false(isTRUE(...)) +expect_not_true <- function(...) expect_false(isTRUE(...)) \ No newline at end of file diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 42ada48f..00e815fd 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -53,8 +53,10 @@ test_that("cmdstan_model works with user_header with mock", { exe_file = file_that_exists, user_header = tmpfile ) - }, message = 'Recompiling is recommended'), # this warning should not occur because recompile happens automatically - 'Retrieving exe_file info failed' # this warning should occur + }, message = "Recompiling is recommended"), + # ^ this warning should not occur because recompile happens automatically + "Retrieving exe_file info failed" + # ^ this warning should occur ) ) ) diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index c5ce0d21..79cefa1c 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -9,7 +9,11 @@ mod <- cmdstan_model(stan_file = stan_program, compile = FALSE) make_local_orig <- cmdstan_make_local() cmdstan_make_local(cpp_options = list("PRECOMPILED_HEADERS"="false")) -on.exit(cmdstan_make_local(cpp_options = make_local_orig, append = FALSE), add = TRUE, after = FALSE) +on.exit( + cmdstan_make_local(cpp_options = make_local_orig, append = FALSE), + add = TRUE, + after = FALSE +) test_that("object initialized correctly", { expect_equal(mod$stan_file(), stan_program) @@ -21,6 +25,7 @@ test_that("object initialized correctly", { fixed = TRUE ) }) + test_that("error if no compile() before model fitting", { expect_error( mod$sample(), @@ -395,9 +400,6 @@ test_that("check_syntax() works with include_paths", { }) - -# Test Failing Due to Side effect ----- - test_that("check_syntax() works with include_paths on compiled model", { stan_program_w_include <- testing_stan_file("bernoulli_include") @@ -408,7 +410,6 @@ test_that("check_syntax() works with include_paths on compiled model", { }) - test_that("check_syntax() works with pedantic=TRUE", { model_code <- " transformed data { diff --git a/tests/testthat/test-model-generate_quantities.R b/tests/testthat/test-model-generate_quantities.R index 9f5ec1fb..9db95e9b 100644 --- a/tests/testthat/test-model-generate_quantities.R +++ b/tests/testthat/test-model-generate_quantities.R @@ -53,7 +53,10 @@ test_that("generate_quantities work for different chains and parallel_chains", { ) expect_call_compilation({ - mod_gq <- cmdstan_model(testing_stan_file("bernoulli_ppc"), cpp_options = list(stan_threads = TRUE)) + mod_gq <- cmdstan_model( + testing_stan_file("bernoulli_ppc"), + cpp_options = list(stan_threads = TRUE) + ) }) expect_gq_output( diff --git a/tests/testthat/test-model-internal.R b/tests/testthat/test-model-internal.R index 24c42fad..cf50954a 100644 --- a/tests/testthat/test-model-internal.R +++ b/tests/testthat/test-model-internal.R @@ -11,7 +11,7 @@ test_that("parse_exe_info_string works", { STAN_CPP_OPTIMS=false "), list( - stan_version = '2.38.0', + stan_version = "2.38.0", stan_threads = FALSE, stan_mpi = FALSE, stan_opencl = TRUE, @@ -20,36 +20,52 @@ test_that("parse_exe_info_string works", { ) ) }) - + test_that("validate_precompile_cpp_options works", { expect_equal_ignore_order( - validate_precompile_cpp_options(list(Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE)), + validate_precompile_cpp_options(list( + Stan_Threads = TRUE, + STAN_OPENCL = NULL, + aBc = FALSE + )), list( stan_threads = TRUE, - stan_opencl = NULL, + stan_opencl = NULL, abc = FALSE ) ) - expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL= FALSE))) + expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL = FALSE))) }) -test_that('exe_info cpp_options comparison works', { +test_that("exe_info cpp_options comparison works", { exe_info_all_flags_off <- exe_info_style_cpp_options(list()) - exe_info_all_flags_off[['stan_version']] <- '35.0.0' + exe_info_all_flags_off[["stan_version"]] <- "35.0.0" - expect_true(exe_info_reflects_cpp_options(exe_info_all_flags_off, list())) - expect_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE), list(stan_opencl = NULL))) - expect_not_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE), list(stan_opencl = FALSE))) - expect_not_true(exe_info_reflects_cpp_options(list(stan_opencl = FALSE, stan_threads = FALSE), list(stan_opencl = NULL, stan_threads = TRUE))) + expect_true(exe_info_reflects_cpp_options( + exe_info_all_flags_off, + list() + )) + expect_true(exe_info_reflects_cpp_options( + list(stan_opencl = FALSE), + list(stan_opencl = NULL) + )) + expect_not_true(exe_info_reflects_cpp_options( + list(stan_opencl = FALSE), + list(stan_opencl = FALSE) + )) + expect_not_true(exe_info_reflects_cpp_options( + list(stan_opencl = FALSE, stan_threads = FALSE), + list(stan_opencl = NULL, stan_threads = TRUE) + )) expect_not_true(exe_info_reflects_cpp_options( - list(stan_opencl = FALSE, stan_threads = FALSE), - list(stan_opencl = NULL, stan_threads = TRUE, EXTRA_ARG = TRUE) + list(stan_opencl = FALSE, stan_threads = FALSE), + list(stan_opencl = NULL, stan_threads = TRUE, EXTRA_ARG = TRUE) )) # no exe_info -> no recompile based on cpp info expect_warning( expect_true(exe_info_reflects_cpp_options(list(), list())), - 'Recompiling is recommended' + "Recompiling is recommended" ) }) \ No newline at end of file diff --git a/tests/testthat/test-opencl.R b/tests/testthat/test-opencl.R index 240ca8f9..a6680176 100644 --- a/tests/testthat/test-opencl.R +++ b/tests/testthat/test-opencl.R @@ -158,6 +158,10 @@ test_that("model from exe_file retains open_cl option", { mod <- cmdstan_model(stan_file = stan_file, cpp_options = list(stan_opencl = TRUE)) mod_from_exe <- cmdstan_model(exe_file = mod$exe_file()) expect_sample_output( - fit <- mod_from_exe$sample(data = testing_data("bernoulli"), opencl_ids = c(0, 0), chains = 1) + fit <- mod_from_exe$sample( + data = testing_data("bernoulli"), + opencl_ids = c(0, 0), + chains = 1 + ) ) }) \ No newline at end of file From a013456d1f1cc01017c345ddf5928f2265b3e184 Mon Sep 17 00:00:00 2001 From: Brock Date: Thu, 19 Dec 2024 10:27:44 +0100 Subject: [PATCH 13/19] fix incomplete method renaming --- R/model.R | 7 ++++--- tests/testthat/test-model-internal.R | 6 +++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/model.R b/R/model.R index 041efc73..614564be 100644 --- a/R/model.R +++ b/R/model.R @@ -353,9 +353,10 @@ CmdStanModel <- R6::R6Class( info <- if (cli_info_success) parse_exe_info_string(ret$stdout) else list() cpp_options <- exe_info_style_cpp_options(private$precompile_cpp_options_) compiled_with_cpp_options <- !is.null(private$cmdstan_version_) - if(!cli_info_success) warning( - 'Retrieving exe_file info failed. ', - 'This may be due to running a model that was compiled with pre-2.26.1 cmdstan.' + if (!cli_info_success) warning( + "Retrieving exe_file info failed. ", + "This may be due to running a model that was compiled ", + "with pre-2.26.1 cmdstan." ) private$exe_info_ <- if (compiled_with_cpp_options) { # recompile has occurred since the CmdStanModel was created diff --git a/tests/testthat/test-model-internal.R b/tests/testthat/test-model-internal.R index cf50954a..9d5e2000 100644 --- a/tests/testthat/test-model-internal.R +++ b/tests/testthat/test-model-internal.R @@ -21,9 +21,9 @@ test_that("parse_exe_info_string works", { ) }) -test_that("validate_precompile_cpp_options works", { +test_that("validate_cpp_options works", { expect_equal_ignore_order( - validate_precompile_cpp_options(list( + validate_cpp_options(list( Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE @@ -34,7 +34,7 @@ test_that("validate_precompile_cpp_options works", { abc = FALSE ) ) - expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL = FALSE))) + expect_warning(validate_cpp_options(list(STAN_OPENCL = FALSE))) }) From e073e11d2190f77a9dc11e342ff3dd018b846d8d Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 11:39:30 +0200 Subject: [PATCH 14/19] make tests consistent with renaming --- tests/testthat/test-model-helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-model-helpers.R b/tests/testthat/test-model-helpers.R index b3ead5c3..8880bce8 100644 --- a/tests/testthat/test-model-helpers.R +++ b/tests/testthat/test-model-helpers.R @@ -23,12 +23,12 @@ test_that("test parse_exe_info_string", { test_that("test validate_precompile_cpp_options", { expect_equal_ignore_order( - validate_precompile_cpp_options(list(Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE)), + validate_cpp_options(list(Stan_Threads = TRUE, STAN_OPENCL = NULL, aBc = FALSE)), list( stan_threads = TRUE, stan_opencl = NULL, abc = FALSE ) ) - expect_warning(validate_precompile_cpp_options(list(STAN_OPENCL= FALSE))) + expect_warning(validate_cpp_options(list(STAN_OPENCL= FALSE))) }) \ No newline at end of file From da2b04ebbb797a295038d24b1218111ad3a4e6c6 Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 11:46:20 +0200 Subject: [PATCH 15/19] update check_syntax test --- tests/testthat/test-model-check_syntax.R | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-model-check_syntax.R b/tests/testthat/test-model-check_syntax.R index 3afef850..b9a507a7 100644 --- a/tests/testthat/test-model-check_syntax.R +++ b/tests/testthat/test-model-check_syntax.R @@ -1,9 +1,15 @@ test_that("include_paths set on compiled model with mocks", { stan_program_w_include <- testing_stan_file("bernoulli_include") - - with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_message({ - mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE, - include_paths = test_path("resources", "stan")) - }, message = 'mock-compile-was-called')) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0), + code = expect_mock_compile({ + mod_w_include <- cmdstan_model( + stan_file = stan_program_w_include, + compile = TRUE, + include_paths = test_path("resources", "stan") + ) + }) + ) expect_true(mod_w_include$check_syntax()) }) \ No newline at end of file From 8302fb313db7d7bc3ca6240fd0a4ef6af2a34533 Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 12:17:15 +0200 Subject: [PATCH 16/19] tiny update to recompile test --- tests/testthat/test-model-recompile-logic.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-model-recompile-logic.R b/tests/testthat/test-model-recompile-logic.R index 41123516..b4a8f02b 100644 --- a/tests/testthat/test-model-recompile-logic.R +++ b/tests/testthat/test-model-recompile-logic.R @@ -24,7 +24,7 @@ test_that("warning when no recompile and no info", test_that("recompiles when force_recompile flag set", with_mocked_cli( compile_ret = list(status = 0), - info_ret = list(), + info_ret = list(status = 0), code = expect_mock_compile({ mod <- cmdstan_model(stan_file = stan_program, force_recompile = TRUE) }) From 80da13617654f82664c4028b9d8891d27c0fea9e Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 12:18:28 +0200 Subject: [PATCH 17/19] cpp_opts eof --- R/cpp_opts.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cpp_opts.R b/R/cpp_opts.R index 3178dbf9..4a6ece79 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -263,4 +263,4 @@ assert_no_falsy_flags <- function(cpp_options) { " option off, use cpp_options = list(", tolower(flag), " = NULL)." ) } -} \ No newline at end of file +} From 3a9e0621dade01c10ed59d9d76f9cb77007308bb Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 14:48:33 +0200 Subject: [PATCH 18/19] give mocks default args --- R/model.R | 22 ++++++++++----- tests/testthat/helper-mock-cli.R | 6 ++++- tests/testthat/test-model-check_syntax.R | 18 +++++-------- .../testthat/test-model-compile-user_header.R | 27 +++++++++---------- tests/testthat/test-model-recompile-logic.R | 17 +++--------- 5 files changed, 43 insertions(+), 47 deletions(-) diff --git a/R/model.R b/R/model.R index 614564be..37d9daf9 100644 --- a/R/model.R +++ b/R/model.R @@ -644,18 +644,28 @@ compile <- function(quiet = TRUE, # - the user forced compilation, # - the executable does not exist # - the stan model was changed since last compilation - # - a user header is used and the user header changed since last compilation (#813) + # - a user header is used and ( + # the user header changed since last compilation (#813) OR + # there is not record of having used user_header in past compilation OR + # the user_header is a different file from last compilation) self$exe_file(exe) self$exe_info(update = TRUE) if (!file.exists(exe)) { force_recompile <- TRUE - } else if (file.exists(self$stan_file()) - && file.mtime(exe) < file.mtime(self$stan_file())) { + } else if ( + file.exists(self$stan_file()) && + file.mtime(exe) < file.mtime(self$stan_file()) + ) { force_recompile <- TRUE - } else if (!is.null(user_header) - && file.exists(user_header) - && file.mtime(exe) < file.mtime(user_header)) { + } else if ( + !is.null(user_header) && + file.exists(user_header) && ( + file.mtime(exe) < file.mtime(user_header) || + is.null(self$precompile_cpp_options()[["user_header"]]) || + self$precompile_cpp_options()[["user_header"]] != user_header + ) + ) { force_recompile <- TRUE } else if (!isTRUE(exe_info_reflects_cpp_options(self$exe_info(), cpp_options))) { force_recompile <- TRUE diff --git a/tests/testthat/helper-mock-cli.R b/tests/testthat/helper-mock-cli.R index 60a9e52d..aabdcc19 100644 --- a/tests/testthat/helper-mock-cli.R +++ b/tests/testthat/helper-mock-cli.R @@ -1,6 +1,10 @@ real_wcr <- wsl_compatible_run -with_mocked_cli <- function(code, compile_ret, info_ret) { +with_mocked_cli <- function( + code, + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = "") +) { with_mocked_bindings( code, wsl_compatible_run = function(command, args, ...) { diff --git a/tests/testthat/test-model-check_syntax.R b/tests/testthat/test-model-check_syntax.R index b9a507a7..0f72cc3d 100644 --- a/tests/testthat/test-model-check_syntax.R +++ b/tests/testthat/test-model-check_syntax.R @@ -1,15 +1,11 @@ test_that("include_paths set on compiled model with mocks", { stan_program_w_include <- testing_stan_file("bernoulli_include") - with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(status = 0), - code = expect_mock_compile({ - mod_w_include <- cmdstan_model( - stan_file = stan_program_w_include, - compile = TRUE, - include_paths = test_path("resources", "stan") - ) - }) - ) + with_mocked_cli(expect_mock_compile({ + mod_w_include <- cmdstan_model( + stan_file = stan_program_w_include, + compile = TRUE, + include_paths = test_path("resources", "stan") + ) + })) expect_true(mod_w_include$check_syntax()) }) \ No newline at end of file diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index 00e815fd..53d50e39 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -1,10 +1,14 @@ skip_if(os_is_macos()) +og_wd <- getwd() -file_that_exists <- "placeholder_exists" +file_that_exists <- function() { + name <- file.path(og_wd, "placeholder_exists") + if(! file.exists(name)) file.create(name) + name +} file_that_doesnt_exist <- "placeholder_doesnt_exist" -file.create(file_that_exists) withr::defer( - if (file.exists(file_that_exists)) file.remove(file_that_exists), + file.remove(file_that_exists()), teardown_env() ) @@ -42,15 +46,17 @@ namespace bernoulli_external_model_namespace test_that("cmdstan_model works with user_header with mock", { tmpfile <- withr::local_tempfile(lines = hpp, fileext = ".hpp") + # Note to reviewer: I'm actually unsure what we want the behavior + # to be in this situation. Please advise. with_mocked_cli( compile_ret = list(status = 0), - info_ret = list(), + info_ret = list(status = 1), code = expect_mock_compile( expect_warning( expect_no_warning({ mod <- cmdstan_model( stan_file = testing_stan_file("bernoulli_external"), - exe_file = file_that_exists, + exe_file = file_that_exists(), user_header = tmpfile ) }, message = "Recompiling is recommended"), @@ -62,8 +68,6 @@ test_that("cmdstan_model works with user_header with mock", { ) with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(), code = expect_mock_compile({ mod_2 <- cmdstan_model( stan_file = testing_stan_file("bernoulli_external"), @@ -75,10 +79,8 @@ test_that("cmdstan_model works with user_header with mock", { ) # Check recompilation upon changing header - file.create(file_that_exists) + file_that_exists() with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(status = 0, stdout = ""), code = expect_no_mock_compile({ mod$compile(quiet = TRUE, user_header = tmpfile) }) @@ -86,8 +88,6 @@ test_that("cmdstan_model works with user_header with mock", { Sys.setFileTime(tmpfile, Sys.time() + 1) # touch file to trigger recompile with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(status = 0, stdout = ""), code = expect_mock_compile({ mod$compile(quiet = TRUE, user_header = tmpfile) }) @@ -98,8 +98,6 @@ test_that("cmdstan_model works with user_header with mock", { # Alternative spec of user header with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(), code = expect_no_mock_compile({ mod$compile( quiet = TRUE, @@ -112,7 +110,6 @@ test_that("cmdstan_model works with user_header with mock", { # Error/warning messages with_mocked_cli( compile_ret = list(status = 1), - info_ret = list(), code = expect_error( cmdstan_model( stan_file = testing_stan_file("bernoulli_external"), diff --git a/tests/testthat/test-model-recompile-logic.R b/tests/testthat/test-model-recompile-logic.R index b4a8f02b..f0d9b73b 100644 --- a/tests/testthat/test-model-recompile-logic.R +++ b/tests/testthat/test-model-recompile-logic.R @@ -9,7 +9,6 @@ withr::defer( test_that("warning when no recompile and no info", with_mocked_cli( - compile_ret = list(), info_ret = list(status = 1), code = expect_warning({ mod <- cmdstan_model( @@ -22,17 +21,12 @@ test_that("warning when no recompile and no info", ) test_that("recompiles when force_recompile flag set", - with_mocked_cli( - compile_ret = list(status = 0), - info_ret = list(status = 0), - code = expect_mock_compile({ - mod <- cmdstan_model(stan_file = stan_program, force_recompile = TRUE) - }) - ) + with_mocked_cli(expect_mock_compile({ + cmdstan_model(stan_file = stan_program, force_recompile = TRUE) + })) ) test_that("no mismatch results in no recompile", with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 0, stdout = " @@ -52,7 +46,6 @@ test_that("no mismatch results in no recompile", with_mocked_cli( )) test_that("mismatch results in recompile.", with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 0, stdout = " @@ -77,7 +70,6 @@ test_that("mismatch results in recompile.", with_mocked_cli( test_that( "$exe_info(), $precompile_cpp_options() return expected data without recompile", with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 0, stdout = " @@ -126,7 +118,6 @@ test_that( test_that("$exe_info_fallback() logic works as expected with cpp_options", with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 1, stdout = "" @@ -200,7 +191,6 @@ test_that("$exe_info_fallback() logic works as expected with cpp_options", test_that("$exe_info_fallback() logic works as expected without cpp_options", with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 1, stdout = "" @@ -249,7 +239,6 @@ test_that("$exe_info_fallback() logic works as expected without cpp_options", test_that("Recompile when cpp args don't match binary", { with_mocked_cli( - compile_ret = list(status = 0), info_ret = list( status = 0, stdout = " From edc400c5114a42ed56726a1bf88f14d27ef47917 Mon Sep 17 00:00:00 2001 From: Brock Date: Mon, 12 May 2025 16:07:28 +0200 Subject: [PATCH 19/19] make syntax test robust to other test side effects --- tests/testthat/test-model-check_syntax.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-model-check_syntax.R b/tests/testthat/test-model-check_syntax.R index 0f72cc3d..4e5e2615 100644 --- a/tests/testthat/test-model-check_syntax.R +++ b/tests/testthat/test-model-check_syntax.R @@ -3,7 +3,7 @@ test_that("include_paths set on compiled model with mocks", { with_mocked_cli(expect_mock_compile({ mod_w_include <- cmdstan_model( stan_file = stan_program_w_include, - compile = TRUE, + force_recompile = TRUE, include_paths = test_path("resources", "stan") ) }))