diff --git a/NEWS.md b/NEWS.md index 55224222f..584a6ea41 100644 --- a/NEWS.md +++ b/NEWS.md @@ -23,13 +23,89 @@ as of CmdStanR 1.0.0; use the lowercase `cmdstanr_no_ver_check` forms instead. `canonicalize`. The values were shell-quoted for Make and the same quoted strings were also passed to `stanc` directly, which rejected them. (#1227) * `$compile()` now enables `allow-undefined` for user headers supplied through -`cpp_options`, not just through the `user_header` argument. (#1227) +`cpp_options`, not just through the `user_header` argument. `$check_syntax()` +and `$format()` also now correctly enable `allow-undefined` for models that use +a user header. (#1227, #1234) * `stanc` failures during `$compile()` are now reported immediately, with the `stanc` error message. Previously they surfaced several steps later. (#1227) * Errors for include paths that do not exist now report the resolved absolute path. (#1227) * Numeric `stanc_options` values such as `list("max-line-length" = 78)` are no longer dropped. (#1233) +* `$compile()` now refreshes `$code()` and `$variables()` after a successful +compilation. (#1228) +* `$compile()` now discards standalone functions exposed from an earlier +version of the Stan program. They must be exposed again with +`$expose_functions()` after a recompilation. (#1228) +* `$compile()` now reuses the include paths and the user header of the previous +compilation when they are not supplied again. Recompiling a model that uses +`#include` directives or a user header through the same object previously +failed because those inputs were dropped. (#1234) +* `$compile()` now recompiles when `include_paths` change. Previously the model +went on using the executable built against the old paths while `$variables()` +and `$include_paths()` described the new ones, so data and initial values were +validated against a program that was not running. (#1235) +* A `user_header` supplied to `cmdstan_model()` is now used by a later +`$compile()`. Previously it was only honored when the model was compiled +immediately. (#1234) +* `$compile()` now accepts `user_header = NULL` to compile without a user +header. Previously a header, once supplied, could not be removed. (#1235) +* `$compile()` now recompiles when the user header changes. Previously a +different header was ignored if the executable was otherwise up to date. (#1235) +* `$compile()` now reduces duplicate `USER_HEADER`/`user_header` entries in +`cpp_options` to the one actually used, so `$cpp_options()` no longer reports +the ignored spelling after a successful compilation. (#1235) +* A `$compile()` call that finds the executable up to date no longer erases +`$cpp_options()`. (#1235) +* `$expose_functions()` now works after a `$compile()` call that found the +executable up to date. (#1235) +* A failed compilation no longer moves `$exe_file()` or replaces the generated +C++ used by `$hpp_file()` and `fit$init_model_methods()`. Previously a failure +at the C++ stage left the old executable paired with model methods generated +from the new program. (#1235) +* `$compile()` now warns when `cpp_options` are supplied but the existing +executable is up to date, so nothing is rebuilt and the options are not applied. +The check is best effort. For an executable the model object compiled itself it +compares the options passed to `Make` against those requested, and treats +anything the binary reports but was never passed as inherited from `make/local` +and so unchanged by a rebuild. For one adopted from an earlier session only the +few `STAN_*` flags the binary reports can be checked, and anything else passes +unremarked. It can also warn when nothing would in fact change: an option +inherited from `make/local` that the binary does not report looks like a request +the executable lacks, and one that was both passed explicitly and set in +`make/local` looks like something a rebuild would drop when it would be +inherited again. Use `force_recompile = TRUE` when a supplied option has to take +effect. (#1235) +* `$cpp_options()` now also reports options the executable was built with that +were never passed to `$compile()`, such as those inherited from `make/local`, +when the binary reports them. `$sample()` and friends previously refused +`threads_per_chain` for an executable that did have threading. (#1019, #1235) +* `$cpp_options()` no longer reports options the executable was not built with. +Previously a request that did not rebuild the model was recorded as though it +had, so `$sample()` could fail with "the model executable was built with +threading enabled" for a binary that had no threading. (#1019, #1235) +* `$format(overwrite_file = TRUE)` now refreshes `$variables()` along with +`$code()`, which previously kept describing the program as it was before +formatting. (#1235) +* `$compile()` now errors if the newly compiled executable cannot be installed, +restoring the previous executable. Previously the replacement was unchecked, so +a failure could silently leave the model with no executable at all. (#1235) +* `$compile()` now errors instead of installing an executable over a directory. +An executable path that names a directory, which `$exe_file()` and +`cmdstan_model(exe_file = )` both accept without checking, previously had that +directory renamed aside as though it were the old executable and a file put in +its place. (#1235) +* `$compile()` now checks that it can record the compiled model before replacing +the executable, so a failure at that point can no longer leave a new executable +on disk that the model object knows nothing about. (#1235) +* A duplicated `USER_HEADER` or `user_header` entry in `cpp_options` now selects +the last one, matching what `Make` does with repeated assignments. Previously +the first was compiled with and the rest were left in `cpp_options`. (#1235) +* A `USER_HEADER` or `user_header` entry in `cpp_options` set to `NULL` now +clears a previously configured user header instead of being ignored. It stands +for an explicit `USER_HEADER=`, which `Make` takes as clearing anything set +before it, so the model previously compiled with no header while continuing to +report the old one. (#1235) * CmdStanModel methods now correctly handle `#include` directories with spaces in their paths. (#820) * `$include_paths()` now returns absolute paths, and relative include paths are @@ -111,6 +187,7 @@ are recompiled lazily if needed. (#1158) - `stepsize` (`step_size`) + # cmdstanr 0.9.0 ## General Improvements/Changes diff --git a/R/cpp_opts.R b/R/cpp_opts.R index b13f0e3f5..215350f86 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -73,6 +73,59 @@ model_compile_info <- function(exe_file, version) { info } +# Merge build options reported by the executable. Ignore STAN_VERSION and false +# flags (passing FLAG=FALSE back to CmdStan can enable the flag). +merge_exe_info_cpp_options <- function(cpp_options, exe_info) { + for (option_name in names(exe_info)) { + value <- exe_info[[option_name]] + if (tolower(option_name) != "stan_version" && + (!is.logical(value) || isTRUE(value))) { + cpp_options[[option_name]] <- value + } + } + cpp_options +} + +# Normalize the flags sent to make. Assignment names are case-insensitive and +# the last value wins. Nonassignments keep their order. Headers are handled +# separately. +parsed_cpp_options <- function(cpp_options) { + assignments <- list() + opaque <- character() + for (flag in cpp_options_to_compile_flags(cpp_options)) { + if (!grepl("^[A-Za-z_][A-Za-z0-9_]*=", flag)) { + opaque <- c(opaque, flag) + next + } + option_name <- tolower(sub("=.*$", "", flag)) + if (option_name %in% c("user_header", "stan_version")) { + next + } + assignments[[option_name]] <- sub("^[^=]*=", "", flag) + } + list(assignments = assignments, opaque = opaque) +} + +normalized_cpp_options <- function(cpp_options) { + parsed <- parsed_cpp_options(cpp_options) + reduced <- character() + if (length(parsed$assignments) > 0) { + reduced <- paste0( + names(parsed$assignments), "=", + unlist(parsed$assignments, use.names = FALSE) + ) + } + c(sort(reduced), parsed$opaque) +} + +# Omitted recorded options count as changes because cpp_options are one-shot. +cpp_options_disagree <- function(requested, recorded) { + !identical( + normalized_cpp_options(requested), + normalized_cpp_options(recorded) + ) +} + # convert to compile flags -------------------- # from list(flag1=TRUE, flag2=FALSE) to "FLAG1=TRUE\nFLAG2=FALSE" cpp_options_to_compile_flags <- function(cpp_options) { @@ -128,6 +181,78 @@ validate_cpp_options <- function(cpp_options) { cpp_options } +# user headers --------------------------------------------------------- +# Resolve one header and remove both header spellings from cpp_options. +# Precedence is explicit user_header (including NULL), USER_HEADER, +# user_header, then previous. `supplied` distinguishes NULL from omission. +# `cpp_options_supplied` limits conflict warnings to this call. +resolve_user_header <- function(user_header, + supplied, + cpp_options, + cpp_options_supplied = TRUE, + previous = NULL) { + # Use positions so duplicate options follow make's last-value-wins behavior. + upper_at <- which(names(cpp_options) == "USER_HEADER") + lower_at <- which(names(cpp_options) == "user_header") + last_of <- function(positions) { + if (length(positions) == 0) { + NULL + } else { + cpp_options[[positions[[length(positions)]]]] + } + } + # NULL is still present here because it emits an empty USER_HEADER= assignment. + has_upper <- length(upper_at) > 0 + has_lower <- length(lower_at) > 0 + from_upper <- last_of(upper_at) + from_lower <- last_of(lower_at) + conflict <- NULL + spelling <- "USER_HEADER" + + if (supplied) { + if (cpp_options_supplied && (has_upper || has_lower)) { + conflict <- "argument" + } + header <- user_header + } else if (has_upper) { + if (has_lower) { + conflict <- "cpp_options" + } + header <- from_upper + } else if (has_lower) { + header <- from_lower + spelling <- "user_header" + } else { + header <- previous + } + + # Validate the value now and check file existence when compiling. + if (!is.null(header)) { + checkmate::assert_string(header, .var.name = "user_header") + } + # Guarded because x[-integer(0)] is empty. + header_at <- c(upper_at, lower_at) + if (length(header_at) > 0) { + cpp_options <- cpp_options[-header_at] + } + + list( + user_header = header, + spelling = spelling, + cpp_options = cpp_options, + conflict = conflict + ) +} + +warn_user_header_conflict <- function(conflict) { + if (identical(conflict, "argument")) { + warning("User header specified both via user_header argument and via cpp_options arguments") + } else if (identical(conflict, "cpp_options")) { + warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) + } + invisible(NULL) +} + # check specific options for validity --------------------------------- cpp_option_value <- function(cpp_options, option) { # CmdStanR input and executable metadata can use different casing. Prefer @@ -206,11 +331,17 @@ exe_info_reflects_cpp_options <- function(exe_info, cpp_options) { } 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)] + # Compare only options reported by the executable. Other options are unknown. + # Parse the emitted flags so duplicates and unnamed assignments match make. + assignments <- parsed_cpp_options(cpp_options)$assignments + reported <- intersect(names(assignments), tolower(names(exe_info))) - if (length(overlap) == 0) TRUE else all.equal( - exe_info[overlap], - cpp_options[overlap] - ) + for (option_name in reported) { + # CmdStan treats any nonempty make value as enabled. + requested <- nzchar(assignments[[option_name]]) + if (requested != isTRUE(cpp_option_value(exe_info, option_name))) { + return(FALSE) + } + } + TRUE } diff --git a/R/model.R b/R/model.R index 60269d2a8..d171d12b9 100644 --- a/R/model.R +++ b/R/model.R @@ -242,7 +242,14 @@ CmdStanModel <- R6::R6Class( cpp_options_ = list(), stanc_options_ = list(), include_paths_ = NULL, + user_header_ = NULL, using_user_header_ = FALSE, + # Build inputs that have changed since the current executable was produced. + user_header_dirty_ = FALSE, + include_paths_dirty_ = FALSE, + # Options this object passed to make. By contrast, cpp_options_ may also + # contain values discovered from executable metadata or make/local. + built_cpp_options_ = NULL, precompile_cpp_options_ = NULL, precompile_stanc_options_ = NULL, precompile_include_paths_ = NULL, @@ -262,12 +269,25 @@ CmdStanModel <- R6::R6Class( private$stan_file_ <- resolve_path(stan_file) private$stan_code_ <- readLines(stan_file) private$model_name_ <- gsub(" ", "_", strip_ext(basename(private$stan_file_))) - private$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"]])) { - private$using_user_header_ <- TRUE + # Resolve headers here so compile = FALSE preserves an explicit NULL. + # names(args) distinguishes NULL from an omitted argument. + resolved_header <- resolve_user_header( + user_header = args$user_header, + supplied = "user_header" %in% names(args), + cpp_options = args$cpp_options %||% list() + ) + if (!compile) { + # compile() reports this conflict when compilation is requested. + warn_user_header_conflict(resolved_header$conflict) } + # Keep only the host path here. Persisting the WSL path would break reuse + # on WSL1. + private$precompile_cpp_options_ <- resolved_header$cpp_options + # Use the header supplied to cmdstan_model() as the baseline for change + # detection. + private$user_header_ <- resolve_path(resolved_header$user_header) + private$using_user_header_ <- !is.null(resolved_header$user_header) if (is.null(args$include_paths) && any(grepl("#include" , private$stan_code_))) { private$precompile_include_paths_ <- dirname(private$stan_file_) } else { @@ -294,22 +314,15 @@ 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 (tolower(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_ <- merge_exe_info_cpp_options( + private$cpp_options_, + model_compile_info(self$exe_file(), self$cmdstan_version()) + ) } invisible(self) }, include_paths = function() { - if (length(self$exe_file()) > 0 && file.exists(self$exe_file())) { - return(private$include_paths_) - } else { - return(private$precompile_include_paths_) - } + private$include_paths_ %||% private$precompile_include_paths_ }, code = function() { if (length(private$stan_code_) == 0) { @@ -483,9 +496,18 @@ NULL #' program. Relative paths are resolved against the working directory when #' the model object is created (or when `$compile()` is called) and stored as #' absolute paths, so subsequent changes to the working directory do not -#' affect them. +#' affect them. If `$compile()` is called again without `include_paths`, the +#' most recently supplied paths are reused, and changing them forces +#' recompilation. Edits to the included files themselves do not; see +#' `force_recompile`. #' @param user_header (string) The path to a C++ file (with a .hpp extension) -#' to compile with the Stan model. +#' to compile with the Stan model. If `$compile()` is called again without +#' `user_header`, the most recently supplied header is reused, and changing +#' it forces recompilation. Pass `user_header = NULL` to compile without one. +#' A header can also be supplied via `cpp_options` as `USER_HEADER` or +#' `user_header`; the `user_header` argument takes precedence over both. +#' See `force_recompile` for the case of a header supplied for a program +#' whose executable is already up to date. #' @param cpp_options (list) Any 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 @@ -494,8 +516,10 @@ NULL #' **Note:** For historical reasons, CmdStan treats some options as enabled #' whenever their `Make` variable is non-empty. In particular, setting #' `stan_threads` to `FALSE` passes `STAN_THREADS=FALSE` to `Make`, which -#' still enables threading! To leave threading disabled, simply omit -#' `stan_threads` entirely or set it to `NULL`. +#' still enables threading! To leave threading disabled, either omit +#' `stan_threads` entirely, which leaves any setting in `make/local` in +#' place, or set it to `NULL`, which passes an empty `STAN_THREADS=` and so +#' overrides `make/local` too. #' @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 #' [`stanc` chapter of the CmdStan User's @@ -504,6 +528,15 @@ NULL #' @param force_recompile (logical) Should the model be recompiled even if it #' has not been modified since it was last compiled? The default is `FALSE`. #' Can also be set via a global `cmdstanr_force_recompile` option. +#' +#' Only the Stan program itself and the user header (if any) are checked for +#' modification. Files pulled in by `#include` directives are not, at any +#' depth, so editing an included file does not on its own trigger +#' recompilation. Use `force_recompile = TRUE` after changing one. Similarly, +#' when a model object is created for a Stan program whose executable already +#' exists and is up to date, CmdStanR cannot tell which `user_header` or +#' `include_paths` that executable was built with, so supplying different +#' ones does not force a rebuild. #' @param compile_model_methods (logical) Compile additional model methods #' (`log_prob()`, `grad_log_prob()`, `hessian()`, `constrain_variables()`, #' `unconstrain_variables()`, `unconstrain_draws()`, and @@ -568,6 +601,11 @@ NULL #' # same as mod <- cmdstan_model(file_pedantic, pedantic = TRUE) #' } #' +# Keep requested build inputs after a failure, but update executable-derived +# state only after installation succeeds. user_header_dirty_ and +# include_paths_dirty_ stay set until those inputs are compiled successfully. +# exe_file_ and cmdstan_version_ also describe dry runs. exe_file_ is updated +# on no-ops as well. compile <- function(quiet = TRUE, dir = NULL, pedantic = FALSE, @@ -587,17 +625,29 @@ compile <- function(quiet = TRUE, ) } assert_stan_file_exists(self$stan_file()) + # missing() distinguishes an omitted header from user_header = NULL. + user_header_supplied <- !missing(user_header) + cpp_options_supplied <- length(cpp_options) > 0 if (length(cpp_options) == 0 && !is.null(private$precompile_cpp_options_)) { cpp_options <- private$precompile_cpp_options_ } + # Precompile options still need mismatch checks even though they were not + # passed to this call. + cpp_options_available <- length(cpp_options) > 0 if (length(stanc_options) == 0 && !is.null(private$precompile_stanc_options_)) { stanc_options <- private$precompile_stanc_options_ } stanc_options <- assert_valid_stanc_options(stanc_options) - if (is.null(include_paths) && !is.null(private$precompile_include_paths_)) { - include_paths <- private$precompile_include_paths_ + if (is.null(include_paths)) { + include_paths <- private$include_paths_ %||% private$precompile_include_paths_ } - private$include_paths_ <- resolve_path(include_paths) + resolved_include_paths <- resolve_path(include_paths) + # Keep this dirty flag set across failed builds. Include-path order affects + # resolution. The first configured value is initial state, not a change. + private$include_paths_dirty_ <- isTRUE(private$include_paths_dirty_) || + (length(private$include_paths_) > 0 && + !same_path(resolved_include_paths, private$include_paths_)) + private$include_paths_ <- resolved_include_paths include_paths <- private$include_paths_ if (is.null(dir) && !is.null(private$dir_)) { dir <- absolute_path(private$dir_) @@ -607,9 +657,6 @@ compile <- function(quiet = TRUE, 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())) - } } exe <- resolve_exe_path(dir, private$dir_, self$exe_file(), self$stan_file()) @@ -623,46 +670,55 @@ 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)) - 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 - } - + resolved_header <- resolve_user_header( + user_header = user_header, + supplied = user_header_supplied, + cpp_options = cpp_options, + cpp_options_supplied = cpp_options_supplied, + previous = private$user_header_ + ) + warn_user_header_conflict(resolved_header$conflict) + user_header <- resolved_header$user_header + cpp_options <- resolved_header$cpp_options - if (!is.null(user_header)) { + using_user_header <- !is.null(user_header) + if (using_user_header) { stanc_options[["allow-undefined"]] <- TRUE - user_header <- absolute_path(user_header) # As mentioned above, just absolute, not wsl_safe_path() + # Keep user_header as a host path for the WSL1 file check below. + user_header <- resolve_path(user_header) if (!file.exists(user_header)) { stop(paste0("User header file '", user_header, "' does not exist."), call. = FALSE) } + cpp_options[[resolved_header$spelling]] <- wsl_safe_path(user_header) } + # Save the request before compiling so a failed build can be retried. + # Keep the dirty flag set until a build succeeds. + private$user_header_dirty_ <- isTRUE(private$user_header_dirty_) || + !same_path(user_header, private$user_header_) + private$user_header_ <- user_header + private$using_user_header_ <- using_user_header + + # Do not adopt an executable from a new destination. Its generated C++ and + # metadata may not match this object. + exe_changed <- length(private$exe_file_) > 0 && !same_path(exe, private$exe_file_) + # compile if: # - the user forced compilation, # - the executable does not exist + # - the destination is not the executable this object already describes + # - the user header in use is not the one the executable was built against + # - the include paths in use are not the ones the executable was built against # - 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 (exe_changed) { + force_recompile <- TRUE + } else if (isTRUE(private$user_header_dirty_)) { + force_recompile <- TRUE + } else if (isTRUE(private$include_paths_dirty_)) { + force_recompile <- TRUE } else if (file.exists(self$stan_file()) && file.mtime(exe) < file.mtime(self$stan_file())) { force_recompile <- TRUE @@ -676,11 +732,68 @@ compile <- function(quiet = TRUE, if (rlang::is_interactive()) { message("Model executable is up to date!") } - private$cpp_options_ <- cpp_options - private$precompile_cpp_options_ <- NULL - private$precompile_stanc_options_ <- NULL - private$precompile_include_paths_ <- NULL - self$functions$existing_exe <- TRUE + # A no-op must not record options that were not compiled into the executable. + # hpp_code is present only when this object built the executable. + built_here <- !is.null(self$functions$hpp_code) + + # Treat unreadable executable metadata as unavailable. + exe_info <- NULL + if (cpp_options_available || length(private$exe_file_) == 0) { + exe_info <- tryCatch( + model_compile_info(exe, self$cmdstan_version()), + error = function(e) NULL + ) + } + + # Add options reported as enabled by the executable and keep recorded values + # for anything it cannot report. + recorded_cpp_options <- + merge_exe_info_cpp_options(private$cpp_options_, exe_info) + + # A no-op cannot apply requested cpp_options. Warn instead of recording them + # as fact. It would be preferable to rebuild on mismatch (see #1019). + options_mismatch <- FALSE + if (cpp_options_available) { + if (built_here) { + # Options reported by the executable but absent from built_options came + # from make/local, so a rebuild would inherit them again. + built_options <- private$built_cpp_options_ + inherited <- merge_exe_info_cpp_options(list(), exe_info) + # Parse make flags so unnamed assignments also count as explicit. + explicit <- names(parsed_cpp_options(built_options)$assignments) + inherited <- inherited[!tolower(names(inherited)) %in% explicit] + # Command-line options override make/local. + options_mismatch <- cpp_options_disagree( + c(inherited, cpp_options), + c(inherited, built_options) + ) + } else if (length(exe_info) > 0) { + # For adopted executables, compare only reported options. The rest are + # unknown, not mismatches. It would be preferable to record build + # provenance alongside the executable (see #1238). + options_mismatch <- + !isTRUE(exe_info_reflects_cpp_options(exe_info, cpp_options)) + } + } + + # existing_exe means this object has no generated C++ for the executable. + if (length(private$exe_file_) == 0) { + self$functions$existing_exe <- TRUE + } else { + self$functions$existing_exe <- is.null(self$functions$hpp_code) + } + private$cpp_options_ <- recorded_cpp_options + private$exe_file_ <- exe + # Update state before warning because warn = 2 turns the warning into an error. + if (options_mismatch) { + warning( + "The 'cpp_options' recorded or reported for the existing executable ", + "do not match the ones requested. The executable was not rebuilt, so ", + "this call did not apply them. Use 'force_recompile = TRUE' to ", + "rebuild the model.", + call. = FALSE + ) + } return(invisible(self)) } else { if (rlang::is_interactive()) { @@ -688,6 +801,10 @@ compile <- function(quiet = TRUE, } } + # Resolve the CmdStan version before replacing the executable because this + # lookup can fail. + compiled_cmdstan_version <- cmdstan_version() + if (os_is_wsl() && (compile_model_methods || compile_standalone)) { warning("Additional model methods and standalone functions are not ", "currently available with WSLv1 CmdStan and will not be compiled.", @@ -703,7 +820,7 @@ compile <- function(quiet = TRUE, if (os_is_windows() && !os_is_wsl()) { tmp_exe <- utils::shortPathName(tmp_exe) } - private$hpp_file_ <- paste0(temp_file_no_ext, ".hpp") + hpp_file <- paste0(temp_file_no_ext, ".hpp") stancflags_val <- include_paths_stanc3_args(include_paths) @@ -719,20 +836,14 @@ compile <- function(quiet = TRUE, } stanc_inc_paths <- include_paths_stanc3_args(include_paths, direct_call = TRUE) stancflags_standalone <- c("--standalone-functions", stanc_inc_paths, stancflags_direct) - self$functions$hpp_code <- get_standalone_hpp(temp_stan_file, stancflags_standalone) - private$model_methods_env_ <- new.env() - private$model_methods_env_$hpp_code_ <- get_standalone_hpp(temp_stan_file, c(stanc_inc_paths, stancflags_direct)) - self$functions$external <- !is.null(user_header) - self$functions$existing_exe <- FALSE + standalone_hpp_code <- get_standalone_hpp(temp_stan_file, stancflags_standalone) + model_methods_env <- new.env() + model_methods_env$hpp_code_ <- get_standalone_hpp(temp_stan_file, c(stanc_inc_paths, stancflags_direct)) stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " ")) if (!dry_run) { - if (compile_standalone) { - expose_stan_functions(self$functions, verbose = !quiet) - } - withr::with_envvar( c("HOME" = short_path(Sys.getenv("HOME"))), withr::with_path( @@ -789,33 +900,64 @@ compile <- function(quiet = TRUE, stop("An error occurred during compilation! See the message above for more information.", call. = FALSE) } - if (file.exists(exe)) { - file.remove(exe) - } - file.copy(tmp_exe, exe, overwrite = TRUE) - if (os_is_wsl()) { - res <- processx::run( - command = "wsl", - args = c("chmod", "+x", wsl_safe_path(exe)), - error_on_status = FALSE + # Finish fallible work before installing the executable. Write the model-method + # header after make because make uses the same path. + stan_code <- readLines(temp_stan_file) + writeLines(model_methods_env$hpp_code_, + con = wsl_safe_path(hpp_file, revert = TRUE)) + + # Clear functions in place to preserve existing references. Because the public + # field can be replaced, verify it is a mutable environment before installing. + if (!is.environment(self$functions) || + environmentIsLocked(self$functions)) { + stop( + "The model's 'functions' environment is missing or locked, so the ", + "compiled model could not be recorded. The executable was not replaced.", + call. = FALSE ) } - writeLines(private$model_methods_env_$hpp_code_, - con = wsl_safe_path(private$hpp_file_, revert = TRUE)) + leftover_backup <- install_executable(tmp_exe, exe) + + # Commit executable-derived state only after installation succeeds. + rm(list = ls(self$functions, all.names = TRUE), envir = self$functions) + self$functions$compiled <- FALSE + self$functions$hpp_code <- standalone_hpp_code + self$functions$external <- using_user_header + self$functions$existing_exe <- FALSE + private$stan_code_ <- stan_code + private$variables_ <- NULL + private$user_header_dirty_ <- FALSE + private$include_paths_dirty_ <- FALSE + private$hpp_file_ <- hpp_file + private$model_methods_env_ <- model_methods_env + private$cpp_options_ <- cpp_options + private$built_cpp_options_ <- cpp_options + private$precompile_cpp_options_ <- NULL + private$precompile_stanc_options_ <- NULL + private$precompile_include_paths_ <- NULL } # End - if(!dry_run) - private$cmdstan_version_ <- cmdstan_version() + # These fields also describe dry runs, so update them outside the commit block. + private$cmdstan_version_ <- compiled_cmdstan_version private$exe_file_ <- exe - private$cpp_options_ <- cpp_options - private$precompile_cpp_options_ <- NULL - private$precompile_stanc_options_ <- NULL - private$precompile_include_paths_ <- NULL if (!dry_run) { + # Run optional exposure only after executable state is committed. + if (compile_standalone) { + expose_stan_functions(self$functions, verbose = !quiet) + } if (compile_model_methods) { expose_model_methods(env = private$model_methods_env_, verbose = !quiet) } + if (!is.null(leftover_backup)) { + # Warn last because warn = 2 aborts the remaining work. + warning( + "The previously compiled executable could not be removed. ", + "It has been left at '", leftover_backup, "'.", + call. = FALSE + ) + } } invisible(self) } @@ -961,6 +1103,9 @@ check_syntax <- function(pedantic = FALSE, if (is.null(include_paths) && !is.null(self$include_paths())) { include_paths <- self$include_paths() } + if (private$using_user_header_) { + stanc_options[["allow-undefined"]] <- TRUE + } temp_hpp_file <- tempfile(pattern = "model-", fileext = ".hpp") stanc_options[["o"]] <- wsl_safe_path(temp_hpp_file) @@ -1092,6 +1237,9 @@ format <- function(overwrite_file = FALSE, self$include_paths(), direct_call = TRUE ) + if (private$using_user_header_) { + stanc_options[["allow-undefined"]] <- TRUE + } stanc_options[["auto-format"]] <- TRUE if (!is.null(max_line_length)) { stanc_options[["max-line-length"]] <- max_line_length @@ -1143,6 +1291,8 @@ format <- function(overwrite_file = FALSE, cat(run_log$stdout, file = out_file, sep = "\n") if (isTRUE(overwrite_file)) { private$stan_code_ <- readLines(self$stan_file()) + # Force variables() to reparse the formatted source. + private$variables_ <- NULL } invisible(TRUE) diff --git a/R/utils.R b/R/utils.R index 56972d027..7eab2a8ff 100644 --- a/R/utils.R +++ b/R/utils.R @@ -201,6 +201,18 @@ resolve_path <- function(path) { repair_path(absolute_path(path)) } +# Compare canonical paths without requiring them to exist. mustWork = FALSE +# also avoids normalizePath() warnings under warn = 2. +same_path <- function(x, y) { + if (length(x) == 0 || length(y) == 0) { + return(length(x) == length(y)) + } + identical( + normalizePath(x, winslash = "/", mustWork = FALSE), + normalizePath(y, winslash = "/", mustWork = FALSE) + ) +} + # read, write, and copy files -------------------------------------------- #' Copy temporary files (e.g., output, data) to a different location @@ -252,6 +264,104 @@ copy_temp_files <- absolute_path(destinations) } +#' Replace a model executable while preserving the previous one +#' +#' Stage the new executable, move the old one aside, and attempt to restore it +#' if installation fails. Suppress file.copy() and file.rename() warnings so +#' warn = 2 cannot interrupt rollback. A crash between renames may leave only +#' the backup. +#' +#' @noRd +#' @param from Path to the newly compiled executable. +#' @param to Path the executable should be installed at. +#' @return NULL after a clean install, or the leftover backup path if cleanup +#' fails. The new executable is installed in either case. +install_executable <- function(from, to) { + if (dir.exists(to)) { + stop( + "Cannot install the compiled executable at '", to, + "' because that path is a directory. Nothing was modified.", + call. = FALSE + ) + } + # Normalize mixed Windows separators before converting the path for WSL. + candidate <- repair_path(tempfile(pattern = "exe-new-", tmpdir = dirname(to))) + discard_candidate <- function() { + if (unlink(candidate, expand = FALSE) == 0L) { + "" + } else { + paste0(" The staged copy has been left at '", candidate, "'.") + } + } + + if (!isTRUE(suppressWarnings(file.copy(from, candidate)))) { + stop( + "Could not stage the compiled executable at '", candidate, "'. ", + "The model executable at '", to, "' was not modified.", + call. = FALSE + ) + } + if (os_is_wsl()) { + chmod <- processx::run( + command = "wsl", + args = c("chmod", "+x", wsl_safe_path(candidate)), + error_on_status = FALSE + ) + if (is.na(chmod$status) || chmod$status != 0) { + stop( + "Could not make the compiled executable executable. ", + "The model executable at '", to, "' was not modified.", + discard_candidate(), + call. = FALSE + ) + } + } + + backup <- NULL + if (file.exists(to)) { + backup <- repair_path(tempfile(pattern = "exe-old-", tmpdir = dirname(to))) + if (!isTRUE(suppressWarnings(file.rename(to, backup)))) { + stop( + "Could not move the existing executable '", to, "' aside. ", + "It was not modified.", + discard_candidate(), + call. = FALSE + ) + } + } + + if (!isTRUE(suppressWarnings(file.rename(candidate, to)))) { + leftover_candidate <- discard_candidate() + if (is.null(backup)) { + stop( + "Could not install the compiled executable at '", to, "'.", + leftover_candidate, + call. = FALSE + ) + } + if (!isTRUE(suppressWarnings(file.rename(backup, to)))) { + stop( + "Could not install the compiled executable at '", to, "' and the ", + "previously compiled executable could not be restored. It has been ", + "kept at '", backup, "'.", + leftover_candidate, + call. = FALSE + ) + } + stop( + "Could not install the compiled executable at '", to, "'. ", + "The previously compiled executable has been restored.", + leftover_candidate, + call. = FALSE + ) + } + + if (!is.null(backup) && unlink(backup, expand = FALSE) != 0L) { + return(backup) + } + NULL +} + # generate new file names # see doc above for copy_temp_files generate_file_names <- diff --git a/man/model-method-compile.Rd b/man/model-method-compile.Rd index 83ca7ae92..6b1fbfe5e 100644 --- a/man/model-method-compile.Rd +++ b/man/model-method-compile.Rd @@ -40,10 +40,19 @@ should look for files specified in \verb{#include} directives in the Stan program. Relative paths are resolved against the working directory when the model object is created (or when \verb{$compile()} is called) and stored as absolute paths, so subsequent changes to the working directory do not -affect them.} +affect them. If \verb{$compile()} is called again without \code{include_paths}, the +most recently supplied paths are reused, and changing them forces +recompilation. Edits to the included files themselves do not; see +\code{force_recompile}.} \item{user_header}{(string) The path to a C++ file (with a .hpp extension) -to compile with the Stan model.} +to compile with the Stan model. If \verb{$compile()} is called again without +\code{user_header}, the most recently supplied header is reused, and changing +it forces recompilation. Pass \code{user_header = NULL} to compile without one. +A header can also be supplied via \code{cpp_options} as \code{USER_HEADER} or +\code{user_header}; the \code{user_header} argument takes precedence over both. +See \code{force_recompile} for the case of a header supplied for a program +whose executable is already up to date.} \item{cpp_options}{(list) Any makefile options to be used when compiling the model (\code{stan_threads}, \code{stan_mpi}, \code{stan_opencl}, etc.). Anything you would @@ -52,8 +61,10 @@ see the Stan case study \href{https://mc-stan.org/users/documentation/case-studi \strong{Note:} For historical reasons, CmdStan treats some options as enabled whenever their \code{Make} variable is non-empty. In particular, setting \code{stan_threads} to \code{FALSE} passes \code{STAN_THREADS=FALSE} to \code{Make}, which -still enables threading! To leave threading disabled, simply omit -\code{stan_threads} entirely or set it to \code{NULL}.} +still enables threading! To leave threading disabled, either omit +\code{stan_threads} entirely, which leaves any setting in \code{make/local} in +place, or set it to \code{NULL}, which passes an empty \verb{STAN_THREADS=} and so +overrides \code{make/local} too.} \item{stanc_options}{(list) Any Stan-to-C++ transpiler options to be used when compiling the model. See the \strong{Examples} section below as well as the @@ -62,7 +73,16 @@ on available options.} \item{force_recompile}{(logical) Should the model be recompiled even if it has not been modified since it was last compiled? The default is \code{FALSE}. -Can also be set via a global \code{cmdstanr_force_recompile} option.} +Can also be set via a global \code{cmdstanr_force_recompile} option. + +Only the Stan program itself and the user header (if any) are checked for +modification. Files pulled in by \verb{#include} directives are not, at any +depth, so editing an included file does not on its own trigger +recompilation. Use \code{force_recompile = TRUE} after changing one. Similarly, +when a model object is created for a Stan program whose executable already +exists and is up to date, CmdStanR cannot tell which \code{user_header} or +\code{include_paths} that executable was built with, so supplying different +ones does not force a rebuild.} \item{compile_model_methods}{(logical) Compile additional model methods (\code{log_prob()}, \code{grad_log_prob()}, \code{hessian()}, \code{constrain_variables()}, diff --git a/tests/testthat/_snaps/model-compile.md b/tests/testthat/_snaps/model-compile.md new file mode 100644 index 000000000..c048e1049 --- /dev/null +++ b/tests/testthat/_snaps/model-compile.md @@ -0,0 +1,11 @@ +# a leftover backup doesn't unwind a compile when warnings are errors + + Code + withr::with_options(list(warn = 2), model$compile(cpp_options = list( + stan_threads = TRUE), force_recompile = TRUE)) + Message + mock-compile-was-called + Condition + Error: + ! (converted from warning) The previously compiled executable could not be removed. It has been left at '/exe-old-'. + diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md index 7e76d4c14..ffd35ac53 100644 --- a/tests/testthat/_snaps/utils.md +++ b/tests/testthat/_snaps/utils.md @@ -28,3 +28,35 @@ Error: ! Failed to move files: one or more files could not be copied. No original files were removed. +# install_executable() leaves the destination alone if staging fails + + Code + install_executable(fixture$from, fixture$to) + Condition + Error: + ! Could not stage the compiled executable at '/exe-new-'. The model executable at '/model-exe' was not modified. + +# install_executable() leaves the destination alone if the backup fails + + Code + install_executable(fixture$from, fixture$to) + Condition + Error: + ! Could not move the existing executable '/model-exe' aside. It was not modified. + +# install_executable() restores the backup if the install fails + + Code + install_executable(fixture$from, fixture$to) + Condition + Error: + ! Could not install the compiled executable at '/model-exe'. The previously compiled executable has been restored. + +# install_executable() keeps the backup if it cannot be restored + + Code + install_executable(fixture$from, fixture$to) + Condition + Error: + ! Could not install the compiled executable at '/model-exe' and the previously compiled executable could not be restored. It has been kept at '/exe-old-'. + diff --git a/tests/testthat/helper-mock-cli.R b/tests/testthat/helper-mock-cli.R index 799e8d1d0..7fdd6c5fd 100644 --- a/tests/testthat/helper-mock-cli.R +++ b/tests/testthat/helper-mock-cli.R @@ -1,17 +1,33 @@ real_wcr <- wsl_compatible_run +# Use distinct contents so tests can tell successive builds apart. +mock_exe_contents <- local({ + n <- 0L + function() { + n <<- n + 1L + paste0("mock executable ", n) + } +}) + with_mocked_cli <- function(code, compile_ret, info_ret) { code <- substitute(code) caller <- parent.frame() local_mocked_bindings( wsl_compatible_run = function(command, args, ...) { if ( + # Match the configured make command. !is.null(command) - && command == "make" + && command == make_cmd() && !is.null(args) && startsWith(basename(args[1]), "model-") ) { message("mock-compile-was-called") + # Successful builds create an executable artifact, just like make. + if (isTRUE(compile_ret$status == 0)) { + mock_exe <- wsl_safe_path(args[1], revert = TRUE) + writeLines(mock_exe_contents(), mock_exe) + Sys.chmod(mock_exe, "0755", use_umask = FALSE) + } compile_ret } else if (!is.null(args) && args[1] == "info") { info_ret diff --git a/tests/testthat/test-cpp_opts.R b/tests/testthat/test-cpp_opts.R index c7e3a8682..75630fb70 100644 --- a/tests/testthat/test-cpp_opts.R +++ b/tests/testthat/test-cpp_opts.R @@ -155,3 +155,41 @@ test_that("exe_info cpp_options comparison works", { "Recompiling is recommended" ) }) + +test_that("exe_info comparison reads cpp_options the way make does", { + # Upper-case, as model_compile_info() reports it. + disabled <- list(STAN_THREADS = FALSE) + + # An unnamed raw assignment is as much a request as a named one; reading the + # list's names cannot see it. + expect_not_true( + exe_info_reflects_cpp_options(disabled, list("STAN_THREADS=TRUE")) + ) + + # Every duplicate reaches make and a makefile takes the last, so the order + # decides which of these agrees. + expect_true(exe_info_reflects_cpp_options( + disabled, + list(stan_threads = TRUE, stan_threads = NULL) + )) + expect_not_true(exe_info_reflects_cpp_options( + disabled, + list(stan_threads = NULL, stan_threads = TRUE) + )) + + # A vector value expands into one assignment per element. This used to error. + expect_not_true(exe_info_reflects_cpp_options( + disabled, + list(stan_threads = c(TRUE, FALSE)) + )) + + # Non-empty enables whatever the value, so FALSE does not ask for "off". + expect_not_true( + exe_info_reflects_cpp_options(disabled, list(stan_threads = FALSE)) + ) + + # An option the binary cannot report is unverifiable, not a mismatch. + expect_true( + exe_info_reflects_cpp_options(disabled, list(my_custom_make_flag = TRUE)) + ) +}) diff --git a/tests/testthat/test-model-code-print.R b/tests/testthat/test-model-code-print.R index 816218937..d16588b99 100644 --- a/tests/testthat/test-model-code-print.R +++ b/tests/testthat/test-model-code-print.R @@ -23,7 +23,7 @@ test_that("code() and print() still work if file is removed", { expect_identical(mod_removed_stan_file$code(), code_answer) }) -test_that("code() doesn't change when file changes (unless model is recreated)", { +test_that("code() doesn't change when file changes (unless recompiled or recreated)", { code_1 <- " parameters { real y; @@ -52,11 +52,19 @@ test_that("code() doesn't change when file changes (unless model is recreated)", # overwrite with new code, but mod$code() shouldn't change file.copy(stan_file_2, stan_file_1, overwrite = TRUE) expect_identical(mod$code(), code_1_answer) + expect_identical(utils::capture.output(mod$print()), code_1_answer) # recreate CmdStanModel object, now mod$code() should change mod <- cmdstan_model(stan_file_1, compile = FALSE) expect_identical(mod$code(), code_2_answer) expect_identical(utils::capture.output(mod$print()), code_2_answer) + + # Recompilation refreshes the cached code (#1228). + writeLines(code_1_answer, stan_file_1) + expect_identical(mod$code(), code_2_answer) + mod$compile() + expect_identical(mod$code(), code_1_answer) + expect_identical(utils::capture.output(mod$print()), code_1_answer) }) test_that("code() warns and print() errors if only exe and no Stan file", { diff --git a/tests/testthat/test-model-compile-user_header.R b/tests/testthat/test-model-compile-user_header.R index d86de0628..4e6f47eca 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -1,6 +1,30 @@ -# This test is deliberately placed above the file-level skip_if(os_is_macos()) -# below: it mocks the stanc call and never compiles, so it needs no toolchain -# and should run on every platform. +local_mocked_stanc <- function(.local_envir = parent.frame()) { + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) "", + .env = .local_envir + ) +} + +# Mocked compiles use temporary model copies to protect test resources. +local_external_model <- function(.local_envir = parent.frame()) { + stan_file <- file.path( + withr::local_tempdir(.local_envir = .local_envir), + "bernoulli_external.stan" + ) + file.copy(testing_stan_file("bernoulli_external"), stan_file) + stan_file +} + +user_header_routes <- function(header) { + list( + list(user_header = header), + list(cpp_options = list(USER_HEADER = header)), + list(cpp_options = list(user_header = header)) + ) +} + +# Keep mocked compilation tests above the toolchain skip below. test_that("cpp_options user headers allow undefined functions", { stan_file <- testing_stan_file("bernoulli_external") user_header <- withr::local_tempfile(lines = "", fileext = ".hpp") @@ -33,6 +57,371 @@ test_that("cpp_options user headers allow undefined functions", { ) }) +test_that("compile() reuses the user header from the previous compilation", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli_external.stan") + file.copy(testing_stan_file("bernoulli_external"), stan_file) + user_header <- withr::local_tempfile(lines = "", fileext = ".hpp") + received_stancflags <- list() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) { + received_stancflags <<- append(received_stancflags, list(stancflags)) + "" + } + ) + model <- cmdstan_model(stan_file, compile = FALSE) + expect_false(model$.__enclos_env__$private$using_user_header_) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0), + code = model$compile(user_header = user_header, force_recompile = TRUE) + ) + expect_true(model$.__enclos_env__$private$using_user_header_) + + received_stancflags <- list() + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0), + code = model$compile(force_recompile = TRUE) + ) + expect_true(model$.__enclos_env__$private$using_user_header_) + expect_equal( + model$cpp_options()[["USER_HEADER"]], + wsl_safe_path(absolute_path(user_header)) + ) + expect_equal( + vapply(received_stancflags, function(x) "--allow-undefined" %in% x, logical(1)), + rep(TRUE, 2) + ) +}) + +test_that("a no-op compile preserves a header supplied via cpp_options", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli_external.stan") + file.copy(testing_stan_file("bernoulli_external"), stan_file) + user_header <- withr::local_tempfile(lines = "", fileext = ".hpp") + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) "" + ) + model <- cmdstan_model(stan_file, compile = FALSE) + + # The lowercase spelling is the telling one: a bare recompile re-derives the + # header under the USER_HEADER spelling, so only this one shows whether the + # no-op path rebuilt the recorded options or left them alone. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile( + cpp_options = list(user_header = user_header), + force_recompile = TRUE + ) + ) + expect_equal( + model$cpp_options()[["user_header"]], + wsl_safe_path(absolute_path(user_header)) + ) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile(model$compile()) + ) + expect_equal( + model$cpp_options()[["user_header"]], + wsl_safe_path(absolute_path(user_header)) + ) +}) + +test_that("compile() uses a user header supplied to cmdstan_model()", { + user_header <- withr::local_tempfile(lines = "", fileext = ".hpp") + received_stancflags <- list() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) { + received_stancflags <<- append(received_stancflags, list(stancflags)) + "" + } + ) + + model <- cmdstan_model( + local_external_model(), + user_header = user_header, + compile = FALSE + ) + # Use a successful compile so its options are recorded. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(force_recompile = TRUE) + ) + + expect_equal( + model$cpp_options()[["USER_HEADER"]], + wsl_safe_path(absolute_path(user_header)) + ) + expect_equal( + vapply(received_stancflags, function(x) "--allow-undefined" %in% x, logical(1)), + rep(TRUE, 2) + ) +}) + +test_that("a header configured over a current executable does not rebuild", { + stan_file <- local_external_model() + header <- withr::local_tempfile(lines = "", fileext = ".hpp") + local_mocked_stanc() + + # An executable that already exists and is newer than both the program and + # the header, built through a different object. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + exe <- cmdstan_ext(strip_ext(stan_file)) + Sys.setFileTime(stan_file, Sys.time() - 60) + Sys.setFileTime(header, Sys.time() - 60) + Sys.setFileTime(exe, Sys.time()) + + # A fresh object cannot know which header built an existing executable, so it + # keeps the executable without recording the requested header. + for (route in user_header_routes(header)) { + model <- do.call( + cmdstan_model, + c(list(stan_file, compile = FALSE), route) + ) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile(model$compile()) + ) + expect_null(model$cpp_options()[["USER_HEADER"]]) + expect_null(model$cpp_options()[["user_header"]]) + # Stanc still uses the configured header. + expect_true(model$.__enclos_env__$private$using_user_header_) + } +}) + +test_that("cmdstan_model() records a user header from every supply route", { + header <- withr::local_tempfile(lines = "", fileext = ".hpp") + + for (route in user_header_routes(header)) { + model <- do.call( + cmdstan_model, + c(list(testing_stan_file("bernoulli_external"), compile = FALSE), route) + ) + private <- model$.__enclos_env__$private + expect_equal(private$user_header_, resolve_path(header)) + expect_true(private$using_user_header_) + expect_false(private$user_header_dirty_) + } +}) + +test_that("cmdstan_model() honours an explicit user_header = NULL", { + header <- withr::local_tempfile(lines = "", fileext = ".hpp") + + expect_warning( + model <- cmdstan_model( + testing_stan_file("bernoulli_external"), + compile = FALSE, + user_header = NULL, + cpp_options = list(USER_HEADER = header) + ), + "User header specified both" + ) + + private <- model$.__enclos_env__$private + expect_null(private$user_header_) + expect_false(private$using_user_header_) + expect_null(private$precompile_cpp_options_[["USER_HEADER"]]) + expect_null(private$precompile_cpp_options_[["user_header"]]) +}) + +test_that("cmdstan_model() rejects an empty user header", { + expect_error( + cmdstan_model( + testing_stan_file("bernoulli_external"), + compile = FALSE, + user_header = character(0) + ), + "user_header" + ) + model <- cmdstan_model(testing_stan_file("bernoulli_external"), compile = FALSE) + expect_error(model$compile(user_header = character(0)), "user_header") +}) + +test_that("a relative cpp_options user header survives a directory change", { + model_dir <- withr::local_tempdir() + file.copy(testing_stan_file("bernoulli_external"), model_dir) + writeLines("", file.path(model_dir, "header.hpp")) + local_mocked_stanc() + + model <- withr::with_dir( + model_dir, + cmdstan_model( + "bernoulli_external.stan", + compile = FALSE, + cpp_options = list(USER_HEADER = "header.hpp") + ) + ) + + expect_equal( + normalizePath(model$.__enclos_env__$private$user_header_), + normalizePath(file.path(model_dir, "header.hpp")) + ) + # The compile happens from the test's own working directory. + expect_no_error(model$compile(force_recompile = TRUE, dry_run = TRUE)) +}) + +test_that("a bare retry after a failed compile keeps the newly supplied header", { + stan_file <- local_external_model() + h1 <- withr::local_tempfile(lines = "", fileext = ".hpp") + h2 <- withr::local_tempfile(lines = "", fileext = ".hpp") + local_mocked_stanc() + model <- cmdstan_model(stan_file, compile = FALSE) + private <- model$.__enclos_env__$private + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(user_header = h1, force_recompile = TRUE) + ) + expect_equal(private$user_header_, resolve_path(h1)) + expect_false(private$user_header_dirty_) + + with_mocked_cli( + compile_ret = list(status = 1), + info_ret = list(status = 1), + code = expect_error(model$compile(user_header = h2), "An error occurred") + ) + expect_equal(private$user_header_, resolve_path(h2)) + expect_true(private$user_header_dirty_) + + # A bare retry must build h2 rather than reverting to h1. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_mock_compile(model$compile()) + ) + expect_equal(private$user_header_, resolve_path(h2)) + expect_false(private$user_header_dirty_) + expect_equal( + model$cpp_options()[["USER_HEADER"]], + wsl_safe_path(resolve_path(h2)) + ) +}) + +test_that("changing the user header forces compilation", { + stan_file <- local_external_model() + h1 <- withr::local_tempfile(lines = "", fileext = ".hpp") + h2 <- withr::local_tempfile(lines = "", fileext = ".hpp") + local_mocked_stanc() + model <- cmdstan_model(stan_file, compile = FALSE) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(user_header = h1, force_recompile = TRUE) + ) + # Older than the executable, so only the change of header identity can force + # a rebuild here (#813 only covers a header that was modified in place). + Sys.setFileTime(h2, file.mtime(model$exe_file()) - 60) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_mock_compile(model$compile(user_header = h2)) + ) + expect_equal( + model$cpp_options()[["USER_HEADER"]], + wsl_safe_path(resolve_path(h2)) + ) +}) + +test_that("user_header = NULL clears a header from every supply route", { + header <- withr::local_tempfile(lines = "", fileext = ".hpp") + local_mocked_stanc() + + for (route in user_header_routes(header)) { + model <- cmdstan_model(local_external_model(), compile = FALSE) + private <- model$.__enclos_env__$private + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = do.call(model$compile, c(route, list(force_recompile = TRUE))) + ) + expect_true(private$using_user_header_) + + # Clearing a compiled header must force a rebuild. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_mock_compile(model$compile(user_header = NULL)) + ) + expect_null(private$user_header_) + expect_false(private$using_user_header_) + expect_null(model$cpp_options()[["USER_HEADER"]]) + expect_null(model$cpp_options()[["user_header"]]) + } +}) + +test_that("duplicate headers of one spelling take the last, as make does", { + first <- withr::local_tempfile(lines = "", fileext = ".hpp") + second <- withr::local_tempfile(lines = "", fileext = ".hpp") + + # Use the last duplicate and remove every header entry before calling make. + for (spelling in c("USER_HEADER", "user_header")) { + duplicated <- structure( + list(first, second), + names = c(spelling, spelling) + ) + resolved <- resolve_user_header(NULL, FALSE, duplicated) + expect_equal(resolved$user_header, second) + expect_length(resolved$cpp_options, 0) + } + + # USER_HEADER still takes precedence across spellings. + mixed <- structure( + list(first, second, first), + names = c("user_header", "USER_HEADER", "user_header") + ) + resolved <- resolve_user_header(NULL, FALSE, mixed) + expect_equal(resolved$user_header, second) + expect_length(resolved$cpp_options, 0) +}) + +test_that("a NULL header entry clears a persisted one rather than being ignored", { + persisted <- withr::local_tempfile(lines = "", fileext = ".hpp") + first <- withr::local_tempfile(lines = "", fileext = ".hpp") + + # A NULL entry emits USER_HEADER= and clears any previous header. + for (spelling in c("USER_HEADER", "user_header")) { + single <- structure(list(NULL), names = spelling) + resolved <- resolve_user_header(NULL, FALSE, single, previous = persisted) + expect_null(resolved$user_header) + expect_length(resolved$cpp_options, 0) + + duplicated <- structure(list(first, NULL), names = c(spelling, spelling)) + resolved <- resolve_user_header(NULL, FALSE, duplicated, previous = persisted) + expect_null(resolved$user_header) + expect_length(resolved$cpp_options, 0) + } + + # A non-NULL last occurrence still wins, so this is not just "any NULL clears". + kept <- structure(list(NULL, first), names = c("USER_HEADER", "USER_HEADER")) + resolved <- resolve_user_header(NULL, FALSE, kept, previous = persisted) + expect_equal(resolved$user_header, first) + + # An entry that clears is still an entry, so it conflicts with the argument. + resolved <- resolve_user_header( + first, + TRUE, + list(USER_HEADER = NULL), + previous = persisted + ) + expect_identical(resolved$conflict, "argument") +}) + skip_if(os_is_macos()) w_path <- function(f) { @@ -87,7 +476,10 @@ test_that("cmdstan_model works with user_header with mock", { with_mocked_cli( compile_ret = list(status = 0), - info_ret = list(), + # The mocked compile installs an executable, so the constructor queries it + # for compilation info; report a failure rather than an empty list, which + # model_compile_info() cannot interpret. + info_ret = list(status = 1), code = expect_mock_compile({ mod_2 <- cmdstan_model( stan_file = testing_stan_file("bernoulli_external"), @@ -100,8 +492,8 @@ test_that("cmdstan_model works with user_header with mock", { # Check recompilation upon changing header exe_mtime <- header_mtime + 10 - # Mocked compile does not create the executable that real compilation writes. - file.create(file_that_exists) + # The mocked compile above installed the executable with a fresh mtime; pin it + # so the up-to-date check below compares against a known value. Sys.setFileTime(file_that_exists, exe_mtime) with_mocked_cli( compile_ret = list(status = 0), @@ -121,8 +513,6 @@ test_that("cmdstan_model works with user_header with mock", { }) ) - # Mocked compile does not create the executable that real compilation writes. - file.create(mod$exe_file()) Sys.setFileTime(mod$exe_file(), header_mtime + 10) # make exe newer than header # Alternative spec of user header @@ -181,64 +571,27 @@ test_that("cmdstan_model works with user_header with mock", { test_that("wsl path conversion is done as expected", { tmp_file <- withr::local_tempfile(lines = hpp, fileext = ".hpp") - # Case 1: arg - with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), - code = { - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), - user_header = tmp_file, - dry_run = TRUE - ) - } - ) - - # 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']])) - - # Case 2: cpp opt USER_HEADER - with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), - code = { - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), - cpp_options = list( - USER_HEADER = tmp_file - ), - dry_run = TRUE - ) - } - ) - - # 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']])) - - # Case # 3: only user_header opt - with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), - code = { - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), - cpp_options = list( - user_header = tmp_file - ), - dry_run = TRUE - ) - } - ) + local_mocked_stanc() + routes <- user_header_routes(tmp_file) + expected_names <- c("USER_HEADER", "USER_HEADER", "user_header") + for (i in seq_along(routes)) { + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = { + mod <- do.call( + cmdstan_model, + c(list(stan_file = local_external_model()), routes[[i]]) + ) + } + ) - # 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)) + expected_name <- expected_names[[i]] + other_name <- setdiff(c("USER_HEADER", "user_header"), expected_name) + expect_equal(mod$cpp_options()[[expected_name]], w_path(tmp_file)) + expect_null(mod$cpp_options()[[other_name]]) + } }) test_that("user_header precedence order is correct", { @@ -248,85 +601,70 @@ test_that("user_header precedence order is correct", { .local_envir = parent.frame(3) )) - # Case # 1: all 3 specified + local_mocked_stanc() + # Successful compiles record the selected header and drop ignored spellings. + + # The explicit argument wins. + mod <- cmdstan_model(local_external_model(), compile = FALSE) with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = expect_warning({ - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), + mod$compile( user_header = tmp_files[1], cpp_options = list( USER_HEADER = tmp_files[2], user_header = tmp_files[3] ), - dry_run = TRUE + force_recompile = TRUE ) }, "User header specified both") ) - # 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)), 1 ) - expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), - 3 - ) + expect_null(mod$cpp_options()[['user_header']]) - # Case # 2: Both opts, but no arg + # USER_HEADER wins over user_header. + mod <- cmdstan_model(local_external_model(), compile = FALSE) with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = expect_warning({ - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), + mod$compile( cpp_options = list( USER_HEADER = tmp_files[2], user_header = tmp_files[3] ), - dry_run = TRUE + force_recompile = TRUE ) }, "User header specified both") ) - # 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)), 2 ) - expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), - 3 - ) + expect_null(mod$cpp_options()[['user_header']]) - # Case # 3: Both opts, other order + # Option order does not change precedence. + mod <- cmdstan_model(local_external_model(), compile = FALSE) with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = expect_warning({ - mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), + mod$compile( cpp_options = list( user_header = tmp_files[3], USER_HEADER = tmp_files[2] ), - dry_run = TRUE + force_recompile = TRUE ) }, "User header specified both") ) - # Same as Case #2 expect_equal( match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)), 2 ) - expect_equal( - match(!!(mod$cpp_options()[['user_header']]), tmp_files), - 3 - ) + expect_null(mod$cpp_options()[['user_header']]) }) diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index b06db28e0..6a9ecd9a5 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -220,6 +220,142 @@ test_that("relative include_paths given to $compile() are resolved when it is ca expect_true(mod$check_syntax(quiet = TRUE)) }) +test_that("$compile() reuses include paths from the previous compilation", { + model_dir <- withr::local_tempdir() + include_dir <- file.path(model_dir, "includes") + dir.create(include_dir) + file.copy(testing_stan_file("bernoulli_include"), model_dir) + file.copy(testing_stan_file("divide_real_by_two"), include_dir) + + received_stancflags <- list() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) { + received_stancflags <<- append(received_stancflags, list(stancflags)) + "" + } + ) + + mod <- cmdstan_model( + file.path(model_dir, "bernoulli_include.stan"), + include_paths = include_dir, + compile = FALSE + ) + # Use a successful compile to move the paths out of precompile state. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = mod$compile(force_recompile = TRUE, quiet = TRUE) + ) + expect_null(mod$.__enclos_env__$private$precompile_include_paths_) + + received_stancflags <- list() + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_error(mod$compile(force_recompile = TRUE, quiet = TRUE)) + ) + expect_equal(mod$include_paths(), resolve_path(include_dir)) + # Compare stanc arguments because WSL converts stored Windows paths. + include_args <- include_paths_stanc3_args(mod$include_paths(), direct_call = TRUE) + expect_true(all(vapply( + received_stancflags, + function(x) all(include_args %in% x), + logical(1) + ))) +}) + +test_that("$compile() doesn't reuse cpp and stanc options from the previous compilation", { + # Use a temporary copy because mocked compiles install executables. + model_dir <- withr::local_tempdir() + stan_file <- file.path(model_dir, "bernoulli.stan") + file.copy(testing_stan_file("bernoulli"), stan_file) + model <- cmdstan_model(stan_file, compile = FALSE) + received_stancflags <- list() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) { + received_stancflags <<- append(received_stancflags, list(stancflags)) + "" + } + ) + + # Successful compiles clear one-shot cpp and stanc options. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile( + cpp_options = list(stan_threads = TRUE), + stanc_options = list("warn-pedantic" = TRUE), + force_recompile = TRUE + ) + ) + expect_true(model$cpp_options()[["stan_threads"]]) + expect_equal( + vapply(received_stancflags, function(x) "--warn-pedantic" %in% x, logical(1)), + rep(TRUE, 2) + ) + + received_stancflags <- list() + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(force_recompile = TRUE) + ) + + expect_null(model$cpp_options()[["stan_threads"]]) + expect_equal( + vapply(received_stancflags, function(x) "--warn-pedantic" %in% x, logical(1)), + rep(FALSE, 2) + ) +}) + +test_that("$compile() doesn't reuse cpp and stanc options supplied to cmdstan_model()", { + model_dir <- withr::local_tempdir() + stan_file <- file.path(model_dir, "bernoulli.stan") + file.copy(testing_stan_file("bernoulli"), stan_file) + # Options given to the constructor are held until the first compilation + # consumes them, unlike the include paths and user header, which persist. + model <- cmdstan_model( + stan_file, + compile = FALSE, + cpp_options = list(stan_threads = TRUE), + stanc_options = list("warn-pedantic" = TRUE) + ) + received_stancflags <- list() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) { + received_stancflags <<- append(received_stancflags, list(stancflags)) + "" + } + ) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(force_recompile = TRUE) + ) + expect_true(model$cpp_options()[["stan_threads"]]) + expect_equal( + vapply(received_stancflags, function(x) "--warn-pedantic" %in% x, logical(1)), + rep(TRUE, 2) + ) + + received_stancflags <- list() + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = model$compile(force_recompile = TRUE) + ) + + expect_null(model$cpp_options()[["stan_threads"]]) + expect_equal( + vapply(received_stancflags, function(x) "--warn-pedantic" %in% x, logical(1)), + rep(FALSE, 2) + ) +}) + test_that("name in STANCFLAGS is set correctly", { local_reproducible_output() out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE)) @@ -304,6 +440,165 @@ test_that("compile() performs stanc checks during dry runs", { ) }) +test_that("compile() with dry_run = TRUE doesn't refresh cached model state", { + model_dir <- withr::local_tempdir() + stan_file <- write_stan_file( + "parameters { real alpha; } model { alpha ~ std_normal(); }", + dir = model_dir, + basename = "issue1228-dry-run.stan" + ) + model <- cmdstan_model(stan_file, compile = FALSE) + code_before <- model$code() + variables_before <- model$variables() + local_mocked_bindings( + get_cmdstan_flags = function(flag_name) character(), + get_standalone_hpp = function(stan_file, stancflags) "" + ) + + write_stan_file( + "parameters { real beta; } model { beta ~ std_normal(); }", + dir = model_dir, + basename = "issue1228-dry-run.stan" + ) + model$compile(force_recompile = TRUE, dry_run = TRUE) + + expect_identical(model$code(), code_before) + expect_identical(model$variables(), variables_before) + expect_equal(ls(model$functions), "compiled") + expect_false(model$functions$compiled) +}) + +test_that("a failed compile() doesn't refresh cached model state", { + model_dir <- withr::local_tempdir() + stan_file <- write_stan_file( + "parameters { real alpha; } model { alpha ~ std_normal(); }", + dir = model_dir, + basename = "issue1228-failed-compile.stan" + ) + model <- cmdstan_model(stan_file, compile = FALSE) + code_before <- model$code() + variables_before <- model$variables() + + file.copy(testing_stan_file("fail"), stan_file, overwrite = TRUE) + expect_error( + model$compile(force_recompile = TRUE), + "An error occurred during compilation!", + fixed = TRUE + ) + + expect_identical(model$code(), code_before) + expect_identical(model$variables(), variables_before) + expect_equal(ls(model$functions), "compiled") + expect_false(model$functions$compiled) +}) + +# Run stanc normally but mock the C++ compiler on a temporary model copy. +local_mocked_bernoulli_model <- function(.local_envir = parent.frame()) { + stan_file <- file.path( + withr::local_tempdir(.local_envir = .local_envir), + "bernoulli.stan" + ) + file.copy(cmdstan_example_file(), stan_file) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file) + ) +} + +test_that("a failed C++ compile doesn't refresh generated-code state", { + model <- local_mocked_bernoulli_model() + private <- model$.__enclos_env__$private + + code_before <- model$code() + variables_before <- model$variables() + functions_before <- as.list(model$functions) + hpp_file_before <- model$hpp_file() + hpp_code_before <- private$model_methods_env_$hpp_code_ + exe_before <- model$exe_file() + other_dir <- withr::local_tempdir() + expect_true(any(nzchar(hpp_code_before))) + + # model_methods_env_ must describe the same program as the executable. + writeLines( + "parameters { real beta; } model { beta ~ std_normal(); }", + model$stan_file() + ) + with_mocked_cli( + compile_ret = list(status = 1), + info_ret = list(status = 1), + code = expect_error( + model$compile(dir = other_dir, force_recompile = TRUE), + "An error occurred during compilation!", + fixed = TRUE + ) + ) + + expect_identical(model$code(), code_before) + expect_identical(model$variables(), variables_before) + expect_identical(as.list(model$functions), functions_before) + expect_identical(model$hpp_file(), hpp_file_before) + expect_identical(private$model_methods_env_$hpp_code_, hpp_code_before) + expect_identical(model$exe_file(), exe_before) + expect_true(file.exists(exe_before)) +}) + +# Build a distinct replacement whose old backup cannot be removed. +local_leftover_backup_model <- function(.local_envir = parent.frame()) { + model <- local_mocked_bernoulli_model(.local_envir = .local_envir) + writeLines("old executable", model$exe_file()) + writeLines( + "parameters { real beta; } model { beta ~ std_normal(); }", + model$stan_file() + ) + local_mocked_bindings( + unlink = function(...) 1L, + .package = "base", + .env = .local_envir + ) + model +} + +expect_describes_new_program <- function(model) { + private <- model$.__enclos_env__$private + expect_identical( + model$code(), + "parameters { real beta; } model { beta ~ std_normal(); }" + ) + expect_equal(model$variables()$parameters$beta$dimensions, 0) + expect_match(paste(private$model_methods_env_$hpp_code_, collapse = "\n"), "beta") + expect_match(paste(readLines(model$hpp_file()), collapse = "\n"), "beta") + expect_true(model$cpp_options()$stan_threads) + expect_match(readLines(model$exe_file()), "^mock executable ") +} + +test_that("a leftover backup doesn't unwind a compile when warnings are errors", { + model <- local_leftover_backup_model() + model_dir <- dirname(model$exe_file()) + + # The warning must come after the new executable state is committed. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_snapshot( + error = TRUE, + withr::with_options( + list(warn = 2), + model$compile(cpp_options = list(stan_threads = TRUE), force_recompile = TRUE) + ), + # Normalize Windows separators and the random backup name. + transform = function(lines) { + for (dir in unique(c(model_dir, repair_path(model_dir)))) { + lines <- gsub(dir, "", lines, fixed = TRUE) + } + gsub("exe-old-[0-9a-f]+", "exe-old-", lines) + } + ) + ) + + expect_describes_new_program(model) +}) + test_that("dir arg works for cmdstan_model and $compile()", { tmp_dir <- tempdir() tmp_dir_2 <- tempdir() @@ -408,9 +703,14 @@ test_that("*hpp_file() functions work", { expect_equal(mod$hpp_file(), file.path(dirname(mod$stan_file()), "bernoulli.hpp")) mod$save_hpp_file(tmp_dir) expect_equal(mod$hpp_file(), file.path(tmp_dir, "bernoulli.hpp")) + # A dry run leaves the saved header location unchanged. mod$compile(force_recompile = TRUE, dry_run = TRUE) + expect_equal(mod$hpp_file(), file.path(tmp_dir, "bernoulli.hpp")) + # A real recompilation uses a fresh temporary header. + expect_call_compilation(mod$compile(force_recompile = TRUE)) expect_false(isTRUE(all.equal(mod$hpp_file(), file.path(tmp_dir, "bernoulli.hpp")))) expect_false(isTRUE(all.equal(mod$hpp_file(), file.path(dirname(mod$stan_file()), "bernoulli.hpp")))) + checkmate::expect_file_exists(mod$hpp_file()) }) test_that("check_syntax() works", { @@ -527,6 +827,16 @@ test_that("check_syntax() works with include_paths on compiled model", { }) +test_that("check_syntax() and format() allow undefined functions with a user header", { + stan_file <- testing_stan_file("bernoulli_external") + # Stanc does not read the header, so an empty one is enough. + user_header <- withr::local_tempfile(lines = "", fileext = ".hpp") + mod <- cmdstan_model(stan_file, user_header = user_header, compile = FALSE) + + expect_true(mod$check_syntax(quiet = TRUE)) + expect_output(mod$format(), "make_odds", fixed = TRUE) +}) + test_that("compile() and check_syntax() error on removed syntax", { model_code <- " transformed data { @@ -802,6 +1112,28 @@ test_that("cmdstan_model cpp_options dont captialize cxxflags ", { expect_output(print(out), "-Dsomething_not_used") }) +test_that("format(overwrite_file = TRUE) refreshes cached variables", { + model_dir <- withr::local_tempdir() + stan_file <- write_stan_file( + "parameters { real alpha; } model { alpha ~ std_normal(); }", + dir = model_dir, + basename = "reformat.stan" + ) + model <- cmdstan_model(stan_file, compile = FALSE) + expect_equal(names(model$variables()$parameters), "alpha") + + # Formatting in place must refresh variables along with the cached code. + writeLines( + "parameters { real beta; } model { beta ~ std_normal(); }", + stan_file + ) + model$format(overwrite_file = TRUE, quiet = TRUE) + + expect_equal(names(model$variables()$parameters), "beta") + expect_match(paste(model$code(), collapse = " "), "beta") +}) + + test_that("format() works", { code <- " parameters { @@ -1153,3 +1485,70 @@ test_that("compile() ignores directory chatter from MAKEFLAGS when reading STANC withr::local_envvar(MAKEFLAGS = "-w -j 4") expect_compilation(mod, quiet = TRUE, force_recompile = TRUE) }) + +test_that("compile() checks it can commit before replacing the executable", { + model_dir <- withr::local_tempdir() + stan_file <- file.path(model_dir, "bernoulli.stan") + file.copy(testing_stan_file("bernoulli"), stan_file) + model <- cmdstan_model(stan_file, compile = FALSE) + exe <- cmdstan_ext(strip_ext(stan_file)) + + lockEnvironment(model$functions, bindings = FALSE) + + # Clearing a locked environment would fail during the state commit. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_error( + model$compile(force_recompile = TRUE), + "missing or locked", + fixed = TRUE + ) + ) + expect_false(file.exists(exe)) + expect_length(model$exe_file(), 0) +}) + +test_that("compile() refuses an executable destination that is a directory", { + model_dir <- withr::local_tempdir() + stan_file <- file.path(model_dir, "bernoulli.stan") + file.copy(testing_stan_file("bernoulli"), stan_file) + destination <- file.path(model_dir, "target-dir") + dir.create(destination) + writeLines("important", file.path(destination, "data.txt")) + + model <- cmdstan_model(stan_file, compile = FALSE) + model$exe_file(destination) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_error( + model$compile(force_recompile = TRUE), + "is a directory", + fixed = TRUE + ) + ) + expect_true(dir.exists(destination)) + expect_identical(readLines(file.path(destination, "data.txt")), "important") +}) + +test_that("compile() installs the artifact it just built, not the previous one", { + model_dir <- withr::local_tempdir() + stan_file <- file.path(model_dir, "bernoulli.stan") + file.copy(testing_stan_file("bernoulli"), stan_file) + model <- cmdstan_model(stan_file, compile = FALSE) + exe <- cmdstan_ext(strip_ext(stan_file)) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = { + model$compile(force_recompile = TRUE) + first <- readLines(exe) + model$compile(force_recompile = TRUE) + second <- readLines(exe) + } + ) + expect_false(identical(first, second)) +}) diff --git a/tests/testthat/test-model-expose-functions.R b/tests/testthat/test-model-expose-functions.R index 0cbc4f8ba..ab65e0653 100644 --- a/tests/testthat/test-model-expose-functions.R +++ b/tests/testthat/test-model-expose-functions.R @@ -311,6 +311,55 @@ test_that("Functions can be compiled with model", { ) }) +test_that("recompiling drops previously exposed functions", { + model_dir <- withr::local_tempdir() + write_model <- function(code) { + write_stan_file(code, dir = model_dir, basename = "issue1228.stan") + } + code_two_functions <- " + functions { + real times_two(real x) { return 2 * x; } + real times_three(real x) { return 3 * x; } + } + parameters { + real y; + } + model { + y ~ std_normal(); + } + " + stan_file <- write_model(code_two_functions) + mod <- cmdstan_model(stan_file) + mod$expose_functions() + expect_equal(mod$functions$times_two(1), 2) + expect_equal(mod$functions$times_three(1), 3) + + # change one function and remove the other, then recompile + write_model(" + functions { + real times_two(real x) { return 20 * x; } + } + parameters { + real y; + } + model { + y ~ std_normal(); + } + ") + mod$compile() + expect_false(mod$functions$compiled) + expect_false("times_three" %in% ls(mod$functions)) + mod$expose_functions() + expect_equal(mod$functions$times_two(1), 20) + expect_false("times_three" %in% ls(mod$functions)) + + # compile_standalone exposes the functions of the recompiled model + write_model(code_two_functions) + mod$compile(compile_standalone = TRUE) + expect_equal(mod$functions$times_two(1), 2) + expect_equal(mod$functions$times_three(1), 3) +}) + test_that("compile_standalone warns but doesn't error if no functions", { stan_no_funs_block <- write_stan_file(" parameters { diff --git a/tests/testthat/test-model-generate_quantities.R b/tests/testthat/test-model-generate_quantities.R index ff4b9072e..a1809645f 100644 --- a/tests/testthat/test-model-generate_quantities.R +++ b/tests/testthat/test-model-generate_quantities.R @@ -55,15 +55,24 @@ 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_gq_output( - mod_gq$generate_quantities(data = data_list, fitted_params = fit_1_chain, threads_per_chain = 2) + # The existing executable is unthreaded and is not rebuilt, so do not report + # the requested thread count (#1019). + expect_warning( + mod_gq <- cmdstan_model(testing_stan_file("bernoulli_ppc"), cpp_options = list(stan_threads = TRUE)), + "do not match the ones requested" + ) + threads_output <- capture.output( + expect_warning( + mod_gq$generate_quantities(data = data_list, fitted_params = fit_1_chain, threads_per_chain = 2), + "'threads_per_chain' is set but the model was not compiled with" + ) ) - expect_output( - mod_gq$generate_quantities(data = data_list, fitted_params = fit_1_chain, threads_per_chain = 2), - "2 thread(s) per chain", + expect_match( + paste(threads_output, collapse = "\n"), + "Running standalone generated quantities after ", fixed = TRUE ) + expect_false(any(grepl("thread(s) per chain", threads_output, fixed = TRUE))) }) test_that("generate_quantities works with draws_array", { diff --git a/tests/testthat/test-model-recompile-logic.R b/tests/testthat/test-model-recompile-logic.R index c9d7a3856..cdf4dd1b7 100644 --- a/tests/testthat/test-model-recompile-logic.R +++ b/tests/testthat/test-model-recompile-logic.R @@ -1,9 +1,15 @@ -stan_program <- cmdstan_example_file() +# Use a temporary copy because mocked compiles install executables. +model_dir <- withr::local_tempdir() +stan_program <- file.path(model_dir, "bernoulli.stan") +file.copy(cmdstan_example_file(), stan_program) +# Keep the source older than executables used by no-op tests. +Sys.setFileTime(stan_program, Sys.time() - 60) + file_that_doesnt_exist <- withr::local_tempfile(pattern = "placeholder_doesnt_exist") file_that_exists <- withr::local_tempfile(pattern = "placeholder_exists") file.create(file_that_exists) -skip_message <- "To be fixed in a later version." +skip_message <- "To be fixed in a later version. See #1019." test_that("warning when no recompile and no info", { skip(skip_message) @@ -23,13 +29,672 @@ 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(), + # Report executable metadata as unavailable. + info_ret = list(status = 1), code = expect_mock_compile({ mod <- cmdstan_model(stan_file = stan_program, force_recompile = TRUE) }) ) ) +test_that("a no-op compile preserves what the previous compilation recorded", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- cmdstan_model(stan_file, compile = FALSE) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = mod$compile( + cpp_options = list(stan_threads = TRUE), + force_recompile = TRUE + ) + ) + expect_true(mod$cpp_options()$stan_threads) + expect_false(mod$functions$existing_exe) + + # A no-op must preserve build options and local-build provenance. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile(mod$compile()) + ) + expect_true(mod$cpp_options()$stan_threads) + expect_false(mod$functions$existing_exe) +}) + +test_that("a no-op compile does not record cpp_options the executable lacks", { + # A real executable, up to date and built without threading. + testing_model("bernoulli") + + expect_warning( + mod <- cmdstan_model( + testing_stan_file("bernoulli"), + cpp_options = list(stan_threads = TRUE) + ), + "do not match the ones requested" + ) + + # The unapplied threading request must not affect ordinary sampling (#1019). + expect_false(isTRUE(mod$cpp_options()$stan_threads)) + expect_no_error( + mod$sample( + data = testing_data("bernoulli"), + chains = 1, + iter_warmup = 10, + iter_sampling = 10, + refresh = 0, + diagnostics = NULL, + show_messages = FALSE + ) + ) +}) + +test_that("changing include_paths forces recompilation", { + model_dir <- withr::local_tempdir() + dir_a <- file.path(model_dir, "a") + dir_b <- file.path(model_dir, "b") + dir.create(dir_a) + dir.create(dir_b) + # One directive, two directories, two different programs. + writeLines("parameters { real alpha; }", file.path(dir_a, "params.stan")) + writeLines("parameters { real beta; }", file.path(dir_b, "params.stan")) + stan_file <- file.path(model_dir, "included.stan") + writeLines(c("#include params.stan", "model { target += 0; }"), stan_file) + Sys.setFileTime(stan_file, Sys.time() - 60) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, include_paths = dir_a, force_recompile = TRUE) + ) + expect_equal(names(mod$variables()$parameters), "alpha") + + # The same directive resolves to a different program in dir_b (#1228). + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_mock_compile(mod$compile(include_paths = dir_b)) + ) + expect_equal(mod$include_paths(), resolve_path(dir_b)) + expect_equal(names(mod$variables()$parameters), "beta") + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile(mod$compile()) + ) + + # Same directory, different spelling: not a change. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + mod$compile(include_paths = file.path(dir_b, ".")) + ) + ) +}) + +test_that("a no-op compile adopts an executable the object did not build", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + exe <- cmdstan_ext(strip_ext(stan_file)) + + # Build with one object, then adopt the executable with another. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + mod <- cmdstan_model(stan_file, compile = FALSE) + expect_length(mod$exe_file(), 0) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 0, + stdout = "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\nSTAN_THREADS=true\nSTAN_OPENCL=false" + ), + code = expect_no_mock_compile(mod$compile()) + ) + + expect_equal(mod$exe_file(), exe) + expect_true(mod$functions$existing_exe) + # Record enabled flags only and omit STAN_VERSION (not a make option). + expect_true(mod$cpp_options()$STAN_THREADS) + expect_null(mod$cpp_options()$STAN_OPENCL) + expect_null(mod$cpp_options()$STAN_VERSION) +}) + +test_that("adopting an executable describes the binary, not the request", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + + # The executable is up to date but was not built with threading. Until + # cmdstanr rebuilds on a cpp_options mismatch (#1019), the request describes + # an executable that does not exist, so it is reported as a warning rather + # than recorded as fact. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 0, + stdout = "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\nSTAN_THREADS=false" + ), + code = expect_warning( + mod <- cmdstan_model(stan_file, cpp_options = list(stan_threads = TRUE)), + "do not match the ones requested" + ) + ) + + expect_null(mod$cpp_options()$stan_threads) + expect_true(mod$functions$existing_exe) +}) + +test_that("a no-op compile does not adopt options the executable lacks", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file) + ) + expect_null(mod$cpp_options()$stan_threads) + + # A no-op warns without changing the options recorded for the executable. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 0, + stdout = "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\nSTAN_THREADS=false" + ), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = list(stan_threads = TRUE)), + "do not match the ones requested" + ) + ) + ) + expect_null(mod$cpp_options()$stan_threads) +}) + +test_that("a no-op compile warns about options the executable cannot report", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + + # The executable does not report STAN_CPP_OPTIMS or arbitrary make variables. + # Because this object built it, the recorded options can still detect mismatches. + info <- paste0( + "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\n", + "STAN_THREADS=false" + ) + for (requested in list( + list(stan_cpp_optims = TRUE), + list(my_custom_make_flag = "1") + )) { + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = info), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = requested), + "do not match the ones requested" + ) + ) + ) + expect_null(cpp_option_value(mod$cpp_options(), names(requested))) + } +}) + +test_that("a no-op compile stays quiet about options it was built with", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model( + stan_file, + cpp_options = list(stan_cpp_optims = TRUE, my_custom_make_flag = "1"), + force_recompile = TRUE + ) + ) + + # Same unreportable options, but this executable really was built with them, + # so re-supplying them is ordinary reuse and must not warn. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_no_warning( + mod$compile( + cpp_options = list(stan_cpp_optims = TRUE, my_custom_make_flag = "1") + ) + ) + ) + ) +}) + +test_that("option comparison ignores spelling but not an empty assignment", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model( + stan_file, + cpp_options = list(STAN_CPP_OPTIMS = TRUE), + force_recompile = TRUE + ) + ) + + quietly <- function(requested) { + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_no_warning(mod$compile(cpp_options = requested)) + ) + ) + } + # Same option, other spelling, and the string a makefile would carry. + quietly(list(stan_cpp_optims = TRUE)) + quietly(list(stan_cpp_optims = "TRUE")) + + # NULL is not omission either: it reaches make as an empty STAN_THREADS=, + # which overrides whatever make/local sets rather than leaving it alone. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = list(stan_cpp_optims = TRUE, stan_threads = NULL)), + "do not match the ones requested" + ) + ) + ) + + # Dropping a recorded option is still a change: cpp_options are one-shot, so + # recompiling with this list would build without STAN_CPP_OPTIMS. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = list(stan_threads = TRUE)), + "do not match the ones requested" + ) + ) + ) +}) + +test_that("option comparison follows what make is actually given", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model( + stan_file, + cpp_options = list(stan_cpp_optims = TRUE), + force_recompile = TRUE + ) + ) + no_op <- function(requested, expectation) { + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile(expectation(mod$compile(cpp_options = requested))) + ) + } + warns <- function(requested) { + no_op(requested, function(code) { + expect_warning(code, "do not match the ones requested") + }) + } + quietly <- function(requested) no_op(requested, expect_no_warning) + + # FALSE is not omission. It reaches make as STAN_CPP_OPTIMS=FALSE, and CmdStan + # enables some options whenever their make variable is non-empty, so asking + # for it would build a different executable than the recorded TRUE did. + warns(list(stan_cpp_optims = FALSE)) + warns(list(stan_cpp_optims = TRUE, stan_threads = FALSE)) + + # Every duplicate reaches make, and a makefile takes the last. + quietly(list(stan_cpp_optims = FALSE, stan_cpp_optims = TRUE)) + warns(list(stan_cpp_optims = TRUE, stan_cpp_optims = FALSE)) + + # An unnamed entry is a raw make argument rather than something to skip. + warns(list("STAN_THREADS=TRUE")) + + # Order survives normalization: these reach make as the same two assignments + # in opposite orders, so exactly one of them matches the recorded TRUE. + quietly(list("STAN_CPP_OPTIMS=FALSE", "STAN_CPP_OPTIMS=TRUE")) + warns(list("STAN_CPP_OPTIMS=TRUE", "STAN_CPP_OPTIMS=FALSE")) + + # The same, across the boundary between a named entry and a raw one. + quietly(structure( + list(FALSE, "STAN_CPP_OPTIMS=TRUE"), + names = c("stan_cpp_optims", "") + )) + warns(structure( + list("STAN_CPP_OPTIMS=TRUE", FALSE), + names = c("", "stan_cpp_optims") + )) + + # A vector value expands into one assignment per element, so it is the last + # element that decides, not the vector as a whole. + quietly(list(stan_cpp_optims = c(FALSE, TRUE))) + warns(list(stan_cpp_optims = c(TRUE, FALSE))) +}) + +test_that("a raw make argument round-trips through the option comparison", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + mod <- with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model( + stan_file, + cpp_options = list("STAN_CPP_OPTIMS=TRUE"), + force_recompile = TRUE + ) + ) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_no_warning(mod$compile(cpp_options = list("STAN_CPP_OPTIMS=TRUE"))) + ) + ) +}) + +test_that("options inherited from make/local are learned, not warned about", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + # make/local supplies STAN_THREADS=true, so the executable is threaded even + # though nothing was passed to $compile() and nothing could be recorded. + threaded <- paste0( + "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\n", + "STAN_THREADS=true" + ) + + mod <- cmdstan_model(stan_file, compile = FALSE) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = mod$compile(force_recompile = TRUE) + ) + expect_null(mod$cpp_options()$stan_threads) + + # Metadata fills in options inherited from make/local and records them so + # assert_valid_threads() sees the executable's threading support. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = expect_no_mock_compile( + expect_no_warning(mod$compile(cpp_options = list(stan_threads = TRUE))) + ) + ) + expect_true(cpp_option_value(mod$cpp_options(), "stan_threads")) + + # An option only the record knows about still combines with one only the + # metadata knows about. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = mod$compile( + cpp_options = list(stan_cpp_optims = TRUE), + force_recompile = TRUE + ) + ) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = expect_no_mock_compile( + expect_no_warning( + mod$compile(cpp_options = list(stan_cpp_optims = TRUE, stan_threads = TRUE)) + ) + ) + ) + # Changing the unreported option still warns. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = list(stan_cpp_optims = FALSE, stan_threads = TRUE)), + "do not match the ones requested" + ) + ) + ) + + # Without metadata, compare the options recorded during compilation. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_no_warning(mod$compile(cpp_options = list(stan_cpp_optims = TRUE))) + ) + ) +}) + +test_that("an explicitly passed raw assignment is not taken for make/local", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + threaded <- paste0( + "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\n", + "STAN_THREADS=true" + ) + + mod <- cmdstan_model(stan_file, compile = FALSE) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = mod$compile( + cpp_options = structure( + list("STAN_THREADS=TRUE", TRUE), + names = c("", "stan_cpp_optims") + ), + force_recompile = TRUE + ) + ) + + # Raw STAN_THREADS=TRUE is explicit, not inherited from make/local. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = threaded), + code = expect_no_mock_compile( + expect_warning( + mod$compile(cpp_options = list(stan_cpp_optims = TRUE)), + "do not match the ones requested" + ) + ) + ) +}) + +test_that("an executable built with an explicit NULL accepts NULL again", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + # Reported FALSE leaves the explicit NULL assignment intact. + disabled <- paste0( + "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\n", + "STAN_THREADS=false" + ) + + mod <- cmdstan_model(stan_file, compile = FALSE) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = disabled), + code = mod$compile( + cpp_options = list(stan_threads = NULL), + force_recompile = TRUE + ) + ) + + # An empty STAN_THREADS= is what was built with, so re-stating it matches. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = disabled), + code = expect_no_mock_compile( + expect_no_warning(mod$compile(cpp_options = list(stan_threads = NULL))) + ) + ) + + # Omission is a different request: it would leave make/local in force rather + # than overriding it, so it does not match a build that overrode it. + mod_omitted <- cmdstan_model(stan_file, compile = FALSE) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = mod_omitted$compile(force_recompile = TRUE) + ) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_no_mock_compile( + expect_warning( + mod_omitted$compile(cpp_options = list(stan_threads = NULL)), + "do not match the ones requested" + ) + ) + ) +}) + +test_that("an adopted executable stays silent about options it cannot report", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + + # An adopted executable cannot verify unreported options, so it neither warns + # nor records the request (#1238). + info <- paste0( + "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\n", + "STAN_THREADS=false" + ) + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 0, stdout = info), + code = expect_no_mock_compile( + expect_no_warning( + mod <- cmdstan_model( + stan_file, + cpp_options = list(stan_cpp_optims = TRUE) + ) + ) + ) + ) + expect_null(mod$cpp_options()$stan_cpp_optims) +}) + +test_that("no mismatch warning when the executable already has the options", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model( + stan_file, + cpp_options = list(stan_threads = TRUE), + force_recompile = TRUE + ) + ) + + # The adopted executable reports the requested threading option, so ordinary + # reuse must not warn. + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list( + status = 0, + stdout = "stan_version_major=2\nstan_version_minor=39\nstan_version_patch=0\nSTAN_THREADS=true" + ), + code = expect_no_warning( + mod <- cmdstan_model(stan_file, cpp_options = list(stan_threads = TRUE)) + ) + ) + # cpp_option_value() handles the metadata's uppercase spelling. + expect_true(cpp_option_value(mod$cpp_options(), "stan_threads")) +}) + +test_that("a no-op compile tolerates an executable it cannot query", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = cmdstan_model(stan_file, force_recompile = TRUE) + ) + mod <- cmdstan_model(stan_file, compile = FALSE) + + # The mocked executable cannot answer info queries, but adoption is best-effort. + expect_no_error(mod$compile()) + expect_true(mod$functions$existing_exe) +}) + +test_that("compiling into a directory with a different executable recompiles", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = mod <- cmdstan_model(stan_file) + ) + + # Do not adopt an unrelated executable from a new directory. + other_dir <- withr::local_tempdir() + other_exe <- cmdstan_ext(file.path(other_dir, "bernoulli")) + file.create(other_exe) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_mock_compile(mod$compile(dir = other_dir)) + ) + expect_equal(mod$exe_file(), other_exe) +}) + +test_that("a mocked failed compile installs no executable", { + stan_file <- file.path(withr::local_tempdir(), "bernoulli.stan") + file.copy(stan_program, stan_file) + exe <- cmdstan_ext(strip_ext(stan_file)) + + with_mocked_cli( + compile_ret = list(status = 1), + info_ret = list(status = 1), + code = expect_error( + cmdstan_model(stan_file = stan_file, force_recompile = TRUE), + "An error occurred during compilation" + ) + ) + + expect_false(file.exists(exe)) +}) + test_that("no mismatch results in no recompile", with_mocked_cli( compile_ret = list(status = 0), info_ret = list( diff --git a/tests/testthat/test-model-variables.R b/tests/testthat/test-model-variables.R index a87cf4c1a..b8613fb65 100644 --- a/tests/testthat/test-model-variables.R +++ b/tests/testthat/test-model-variables.R @@ -70,6 +70,59 @@ test_that("$variables() work correctly with multidimensional variables", { expect_equal(mod$variables()$transformed_parameters$pp$dimensions, 3) }) +test_that("$variables() is refreshed when the model is recompiled", { + model_dir <- withr::local_tempdir() + stan_file <- write_stan_file( + " + parameters { + real alpha; + } + model { + alpha ~ std_normal(); + } + ", + dir = model_dir, + basename = "issue1228.stan" + ) + mod <- cmdstan_model(stan_file) + expect_equal(names(mod$variables()$parameters), "alpha") + + write_stan_file( + " + parameters { + real beta; + } + model { + beta ~ std_normal(); + } + ", + dir = model_dir, + basename = "issue1228.stan" + ) + # editing the file alone doesn't invalidate the cached variables + expect_equal(names(mod$variables()$parameters), "alpha") + + # the edited file is newer than the executable, so this recompiles + mod$compile() + expect_equal(names(mod$variables()$parameters), "beta") + + # the fitting methods validate inits against the refreshed variables + expect_no_message( + utils::capture.output( + mod$sample( + chains = 1, + iter_warmup = 10, + iter_sampling = 10, + refresh = 0, + init = list(list(beta = 0)), + diagnostics = NULL, + show_messages = FALSE + ) + ), + message = "Init values were only set for a subset of parameters" + ) +}) + test_that("$variables() errors on no stan_file", { code <- " parameters { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c38390498..c297460e5 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -209,6 +209,183 @@ test_that("copy_temp_files retains sources if any copy fails", { expect_identical(file.exists(source_paths), c(TRUE, TRUE)) }) +local_exe_fixture <- function(destination_exists = TRUE, + .local_envir = parent.frame()) { + dir <- withr::local_tempdir(.local_envir = .local_envir) + fixture <- list( + dir = dir, + from = file.path(dir, "compiled-exe"), + to = file.path(dir, "model-exe") + ) + writeLines("new executable", fixture$from) + # Compiled by make, so executable. Installation has to preserve that. + Sys.chmod(fixture$from, "0755", use_umask = FALSE) + if (destination_exists) { + writeLines("old executable", fixture$to) + } + fixture +} + +# POSIX execute permissions are not available through Windows R, including WSL. +expect_installed_executable <- function(path) { + expect_identical(readLines(path), "new executable") + if (!os_is_windows()) { + expect_identical(file.access(path, mode = 1)[[1]], 0L) + } +} + +# Replace platform-specific directory spellings and random filenames without +# hiding separator regressions in paths created by install_executable(). +exe_path_transform <- function(fixture) { + dirs <- unique(c( + fixture$dir, + repair_path(fixture$dir), + gsub("\\\\", "/", fixture$dir) + )) + function(lines) { + for (dir in dirs) { + lines <- gsub(dir, "", lines, fixed = TRUE) + } + gsub("exe-(new|old)-[0-9a-f]+", "exe-\\1-", lines) + } +} + +# Make the n-th file.rename() call fail, optionally warning first, as base does. +local_failing_file_rename <- function(fail_on, + warn = FALSE, + .local_envir = parent.frame()) { + real_file_rename <- base::file.rename + calls <- 0 + local_mocked_bindings( + file.rename = function(from, to) { + calls <<- calls + 1 + if (calls %in% fail_on) { + if (warn) warning("cannot rename file") + return(FALSE) + } + real_file_rename(from, to) + }, + .package = "base", + .env = .local_envir + ) +} + +test_that("install_executable() installs when there is no existing executable", { + fixture <- local_exe_fixture(destination_exists = FALSE) + + expect_null(install_executable(fixture$from, fixture$to)) + expect_installed_executable(fixture$to) + expect_setequal(list.files(fixture$dir), basename(c(fixture$from, fixture$to))) +}) + +test_that("install_executable() replaces an executable and removes the backup", { + fixture <- local_exe_fixture() + + expect_null(install_executable(fixture$from, fixture$to)) + expect_installed_executable(fixture$to) + expect_setequal(list.files(fixture$dir), basename(c(fixture$from, fixture$to))) +}) + +test_that("install_executable() refuses to install over a directory", { + fixture <- local_exe_fixture(destination_exists = FALSE) + dir.create(fixture$to) + writeLines("important", file.path(fixture$to, "data.txt")) + + # Directories satisfy file.exists(), so reject them before staging or renaming. + # Both $exe_file(path) and exe_file= can pass a directory here. + expect_error( + install_executable(fixture$from, fixture$to), + "is a directory", + fixed = TRUE + ) + expect_true(dir.exists(fixture$to)) + expect_identical(readLines(file.path(fixture$to, "data.txt")), "important") + expect_setequal( + list.files(fixture$dir), + basename(c(fixture$from, fixture$to)) + ) +}) + +test_that("install_executable() leaves the destination alone if staging fails", { + fixture <- local_exe_fixture() + local_mocked_bindings(file.copy = function(...) FALSE, .package = "base") + + expect_snapshot( + error = TRUE, + install_executable(fixture$from, fixture$to), + transform = exe_path_transform(fixture) + ) + expect_identical(readLines(fixture$to), "old executable") + expect_setequal(list.files(fixture$dir), basename(c(fixture$from, fixture$to))) +}) + +test_that("install_executable() leaves the destination alone if the backup fails", { + fixture <- local_exe_fixture() + local_failing_file_rename(fail_on = 1) + + expect_snapshot( + error = TRUE, + install_executable(fixture$from, fixture$to), + transform = exe_path_transform(fixture) + ) + expect_identical(readLines(fixture$to), "old executable") + expect_setequal(list.files(fixture$dir), basename(c(fixture$from, fixture$to))) +}) + +test_that("install_executable() restores the backup if the install fails", { + fixture <- local_exe_fixture() + local_failing_file_rename(fail_on = 2) + + expect_snapshot( + error = TRUE, + install_executable(fixture$from, fixture$to), + transform = exe_path_transform(fixture) + ) + expect_identical(readLines(fixture$to), "old executable") + expect_setequal(list.files(fixture$dir), basename(c(fixture$from, fixture$to))) +}) + +test_that("install_executable() keeps the backup if it cannot be restored", { + fixture <- local_exe_fixture() + local_failing_file_rename(fail_on = c(2, 3)) + + expect_snapshot( + error = TRUE, + install_executable(fixture$from, fixture$to), + transform = exe_path_transform(fixture) + ) + # The destination is gone, so the error has to name a real recovery path. + expect_false(file.exists(fixture$to)) + leftover <- setdiff(list.files(fixture$dir), basename(fixture$from)) + expect_match(leftover, "^exe-old-") + expect_identical(readLines(file.path(fixture$dir, leftover)), "old executable") +}) + +test_that("install_executable() rolls back when warnings are errors", { + fixture <- local_exe_fixture() + # file.rename() warnings must not interrupt rollback when warn = 2. + local_failing_file_rename(fail_on = 2, warn = TRUE) + withr::local_options(warn = 2) + + expect_error( + install_executable(fixture$from, fixture$to), + "previously compiled executable has been restored", + fixed = TRUE + ) + expect_identical(readLines(fixture$to), "old executable") +}) + +test_that("install_executable() reports a backup it could not remove", { + fixture <- local_exe_fixture() + local_mocked_bindings(unlink = function(...) 1L, .package = "base") + + # Return the backup without warning so the caller can commit state first. + expect_no_warning(leftover <- install_executable(fixture$from, fixture$to)) + expect_identical(readLines(fixture$to), "new executable") + expect_true(file.exists(leftover)) + expect_identical(readLines(leftover), "old executable") +}) + test_that("repair_path() fixes slashes", { # all slashes should be single "/", and no trailing slash expect_equal(repair_path("a//b\\c/"), "a/b/c")