diff --git a/NEWS.md b/NEWS.md index 21b4e6494..3194c2b70 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,13 +19,73 @@ 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) * CmdStanModel methods now correctly handle `#include` directories with spaces in their paths. (#820) * `$include_paths()` now returns absolute paths, and relative include paths are diff --git a/R/cpp_opts.R b/R/cpp_opts.R index b13f0e3f5..2dc2ef75e 100644 --- a/R/cpp_opts.R +++ b/R/cpp_opts.R @@ -73,6 +73,77 @@ model_compile_info <- function(exe_file, version) { info } +# Merge the options an executable reports about itself into the options already +# recorded for it. STAN_VERSION describes the toolchain rather than a make +# option, and a flag the executable reports as FALSE was never set at all, so +# recording it would pass "FLAG=FALSE" to make, which CmdStan reads as enabling +# 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 +} + +# The options a compilation would actually be run with, normalized so that a +# request can be compared against what an executable was built with. +# +# Deliberately canonicalizes the output of cpp_options_to_compile_flags() rather +# than reading the list itself: what make is handed is what decides whether two +# builds differ, and any second reading of these lists drifts from the first. +# Named and unnamed entries, duplicate names, vector values that expand into +# several assignments and NULLs that expand into an empty NAME= are all already +# resolved by the time the flags exist. +# +# Assignments are reduced last-wins, as a makefile does, and compared by +# lower-cased name so that spelling is not a difference. Anything that is not an +# assignment is opaque and keeps its order relative to the other opaque +# arguments, though not its position among the assignments. Header entries are +# dropped: header identity is tracked separately and forces a rebuild on its +# own. +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) +} + +# Whether an executable built with `recorded` would differ from one built with +# `requested`. Symmetric, because cpp_options are one-shot: a recompilation +# carrying `requested` would drop anything `recorded` holds that it does not. +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 +199,80 @@ validate_cpp_options <- function(cpp_options) { cpp_options } +# user headers --------------------------------------------------------- +# Decide which user header a compilation should use and reduce cpp_options to a +# single, unambiguous source for it. +# +# Precedence: +# 1. an explicit non-NULL `user_header` argument; +# 2. an explicit `user_header = NULL`, which clears any header carried in +# cpp_options as well; +# 3. only when the argument is omitted, cpp_options -- USER_HEADER ahead of +# user_header whichever order they appear in -- and then `previous`, the +# header the model already holds. +# +# `supplied` is what makes (2) expressible at all: `user_header = NULL` is also +# the default, so the value alone cannot separate "cleared" from "not +# mentioned". `cpp_options_supplied` separates a header passed in the same call, +# a conflict worth warning about, from one inherited from an earlier call. +# +# Both spellings are always dropped from cpp_options; callers reinsert the +# selected header under `spelling`, in whatever form they store. The header is +# returned as supplied, neither made absolute nor WSL-safe, because callers +# differ on which they need. +resolve_user_header <- function(user_header, + supplied, + cpp_options, + cpp_options_supplied = TRUE, + previous = NULL) { + from_upper <- cpp_options[["USER_HEADER"]] + from_lower <- cpp_options[["user_header"]] + conflict <- NULL + spelling <- "USER_HEADER" + + if (supplied) { + if (cpp_options_supplied && (!is.null(from_upper) || !is.null(from_lower))) { + conflict <- "argument" + } + header <- user_header + } else if (!is.null(from_upper)) { + if (!is.null(from_lower)) { + conflict <- "cpp_options" + } + header <- from_upper + } else if (!is.null(from_lower)) { + header <- from_lower + spelling <- "user_header" + } else { + header <- previous + } + + # Shape is checked wherever a header is accepted; whether it exists is checked + # only when compiling, so that a header created between construction and + # $compile() still works. + if (!is.null(header)) { + checkmate::assert_string(header, .var.name = "user_header") + } + cpp_options[["USER_HEADER"]] <- NULL + cpp_options[["user_header"]] <- NULL + + 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 +351,21 @@ 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)] + # Only the assignments the binary can speak to. Anything else is left alone + # rather than reported as a mismatch: an adopted executable carries no record + # of what produced it, so an unreportable option is unverifiable, not wrong. + # Read through parsed_cpp_options() so that unnamed raw assignments, duplicate + # names and vector values mean here what they mean to 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 enables these whenever the make variable is non-empty, so an empty + # assignment is the only way to ask for one to be off. + 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 876590422..808af216c 100644 --- a/R/model.R +++ b/R/model.R @@ -242,7 +242,20 @@ CmdStanModel <- R6::R6Class( cpp_options_ = list(), stanc_options_ = list(), include_paths_ = NULL, + user_header_ = NULL, using_user_header_ = FALSE, + # Neither configuration nor a description of the executable: a record that + # the two have drifted apart. Set by a change of header, cleared only by a + # successful executable replacement. + user_header_dirty_ = FALSE, + # The same, for a change of include paths. + include_paths_dirty_ = FALSE, + # The cpp_options actually passed to make for the current executable, as + # distinct from cpp_options_, which also carries what the binary reports + # about itself. Only these would be dropped by a recompilation that omitted + # them; anything else the binary has came from make/local and would be + # inherited again. + built_cpp_options_ = NULL, precompile_cpp_options_ = NULL, precompile_stanc_options_ = NULL, precompile_include_paths_ = NULL, @@ -262,12 +275,32 @@ 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 + # The same precedence $compile() applies, run here too: a model created + # with compile = FALSE never enters $compile(), so resolving the paths + # alone would let an explicit user_header = NULL be ignored. `...` + # preserves NULL entries, so names() is the missing() equivalent here. + resolved_header <- resolve_user_header( + user_header = args$user_header, + supplied = "user_header" %in% names(args), + cpp_options = args$cpp_options %||% list() + ) + if (!compile) { + # Otherwise $compile() receives the original arguments below and warns + # once; warning here as well would double up. + warn_user_header_conflict(resolved_header$conflict) } + # Deliberately without the header: the resolver strips both spellings + # and only $compile() reinserts the selected one. Storing it here would + # mean storing a WSL-safe path, which the next $compile() would pick up + # as its host-path `user_header` and fail to find on WSLv1 -- the hazard + # the comment at the resolver call in $compile() describes. user_header_ + # below is the single source instead. + private$precompile_cpp_options_ <- resolved_header$cpp_options + # Prepopulating this also keeps the first $compile() from seeing a + # change of header and rebuilding an already-current executable. + 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 +327,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 +509,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 +529,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 +541,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 +614,24 @@ NULL #' # same as mod <- cmdstan_model(file_pedantic, pedantic = TRUE) #' } #' +# The object holds three kinds of state, committed at different moments. The +# comments through this function explain individual assignments; the rule they +# are all instances of is: +# +# Source configuration -- what the next build should use. Assigned eagerly and +# kept through a failure, because a bare retry after fixing a bad header or +# a wrong path has to build what the user last asked for. +# Artifact description -- what the executable on disk actually is. Committed +# only after that executable has been successfully replaced, so a dry run, a +# failed compile, or a failed install can never leave the object describing +# a program that was never built. (#1228) +# Divergence markers -- a record that the two have drifted apart, which is +# neither of the above. Latched rather than assigned, because on a retry the +# configuration resolves back to itself and nothing looks changed. +# +# exe_file_ and cmdstan_version_ are deliberate exceptions: they are also the +# configured destination and the toolchain version, so they are assigned on a +# dry run and on a no-op, but never on a failure. compile <- function(quiet = TRUE, dir = NULL, pedantic = FALSE, @@ -587,17 +651,40 @@ compile <- function(quiet = TRUE, ) } assert_stan_file_exists(self$stan_file()) + # Captured before either is reassigned below: an explicit user_header = NULL + # is indistinguishable from an omitted argument by value alone, and a header + # inherited from an earlier call is not a conflict worth warning about. + 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_ } + # Distinct from cpp_options_supplied, which is only about whether this call + # carried a conflicting header: options held from cmdstan_model(compile = + # FALSE) did not arrive with this call but are still the caller's intent. + 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) + # Compared before the assignment below, and latched for the same reason the + # header's marker is: a failed compile must keep the new paths, so on the + # retry they resolve back to themselves and nothing looks changed. Order is + # significant -- it decides which directory a directive resolves from -- so + # this is an ordered comparison, which same_path() already does. + # + # Only a change counts, never the first configuration: a fresh object holds no + # paths, so comparing against nothing would force a rebuild in every new R + # session. That leaves an executable adopted from an earlier session unproven, + # which is documented under `force_recompile`. + 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 +694,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 +707,66 @@ 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, + # the header the model was last compiled with, or the one supplied to + # cmdstan_model() if it has not been compiled yet + 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() + # 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 + 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) } + # Source configuration, so assigned eagerly: it says what the next stanc or + # make invocation should use, and a failed compile must not revert it. The + # usual route to a failed compile with a new header is a bug in that header, + # and a bare retry after fixing it has to build the header the user supplied. + # + # The divergence marker is latched rather than assigned, because on that retry + # the reuse branch resolves back to the same header and nothing looks changed. + 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 + + # The resolved destination need not be the executable this object describes, + # e.g. $compile(dir = ) aimed at a directory that already holds a current + # executable. Adopting that binary while keeping this object's generated C++ + # and metadata would produce a hybrid, so build the model there instead. + 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 +780,110 @@ 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 + # Nothing was compiled, so nothing describing the current executable may be + # consumed or overwritten by configuration this call merely proposed. + # Options supplied to this call describe an executable that was not built, + # so they are deliberately not recorded: assert_valid_threads() and the + # OpenCL checks read these back as fact, and a stan_threads the binary + # lacks makes a plain $sample() fail with "the model executable was built + # with threading enabled", which is false and cannot be worked around + # without recompiling. What is already recorded still describes the + # executable that exists, so it is carried forward untouched. (#1019) + # This object holds the generated C++ for an executable only if it compiled + # it. Even then the record is only what was passed to make: options + # inherited from make/local never reach $compile() and so were never + # recorded, which is why the record alone is not the artifact. + built_here <- !is.null(self$functions$hpp_code) + + # Asking the executable about itself. Best effort, because + # model_compile_info() runs it and errors outright rather than returning a + # status when the file is not runnable. + 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 + ) + } + + # The two accounts of the executable, combined: metadata reports the + # STAN_* flags actually compiled in, including any inherited from + # make/local, and the record holds the options metadata cannot report. + # Metadata wins where both speak, since it describes the binary; a metadata + # FALSE is skipped by the merge, so an explicit NULL survives as an empty + # assignment. A failed query leaves the record untouched. + recorded_cpp_options <- + merge_exe_info_cpp_options(private$cpp_options_, exe_info) + + # Recording options the executable does not have would otherwise be a quiet + # lie: nothing was rebuilt, so a requested stan_threads produces the + # "N thread(s) per chain" message while the binary, compiled without + # STAN_THREADS, runs single-threaded. Rebuilding on a mismatch is the real + # fix and is still outstanding (see the skipped tests in + # test-model-recompile-logic.R); until then, say so. + options_mismatch <- FALSE + if (cpp_options_available) { + if (built_here) { + # Options the binary reports but the record never held cannot have come + # from $compile(), so they came from make/local -- and a rebuild would + # inherit them again. Applying them to both sides keeps an option the + # request never mentioned, and never had to, from reading as a change. + # Anything the record does hold was passed on the command line and + # would be dropped by a rebuild that omits it, so it stays subject to + # the symmetric comparison. + built_options <- private$built_cpp_options_ + inherited <- merge_exe_info_cpp_options(list(), exe_info) + # Which options were passed explicitly is a question about what make was + # given, not about the shape of the list: an unnamed "STAN_THREADS=TRUE" + # is as explicit as a named entry, and names() cannot see it. + explicit <- names(parsed_cpp_options(built_options)$assignments) + inherited <- inherited[!tolower(names(inherited)) %in% explicit] + # Explicit options are appended last because cpp_options reach make on + # the command line, which overrides make/local. + options_mismatch <- cpp_options_disagree( + c(inherited, cpp_options), + c(inherited, built_options) + ) + } else if (length(exe_info) > 0) { + # An adopted executable can only be asked about itself, and it answers + # about a handful of STAN_* flags. Options outside that set are left + # alone rather than reported as a mismatch: unverifiable is not the same + # as wrong, and warning whenever provenance is unknown would fire on + # ordinary reuse. Recording provenance beside the executable is the + # fix (#1238). + options_mismatch <- + !isTRUE(exe_info_reflects_cpp_options(exe_info, cpp_options)) + } + } + + if (length(private$exe_file_) == 0) { + # This object is adopting an executable it did not build: it holds no + # generated C++ for it, and the only description of it beyond the request + # is what the binary reports about itself. + self$functions$existing_exe <- TRUE + } else { + # The flag means "we don't hold the generated C++ for this executable", + # which is not the same as "this call compiled nothing". + self$functions$existing_exe <- is.null(self$functions$hpp_code) + } + private$cpp_options_ <- recorded_cpp_options + private$exe_file_ <- exe + # Warned about only once the state above is recorded: under + # options(warn = 2) this is an error, and raising it earlier would unwind + # with the object half-updated. + if (options_mismatch) { + # Deliberately not phrased as a claim about how the executable was built: + # options inherited from make/local are invisible here unless the binary + # reports them, so what is actually known is that the two descriptions + # disagree. (#1238) + 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 +891,14 @@ compile <- function(quiet = TRUE, } } + # Evaluated here rather than in the tail: cmdstan_version() is not infallible + # despite being an accessor, because set_cmdstan_path() can leave PATH set + # while VERSION stays NULL, and in that state stanc and make both run but this + # errors. Staging it removes a failure point after the executable is already + # installed. It cannot be hoisted above the no-op return, which today never + # reaches this call at all. + 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 +914,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 +930,16 @@ 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) + # Staged in a local: this describes the program being compiled now, so it may + # not reach the object unless that program's executable is installed. (#1228) + 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 +996,69 @@ 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 - ) - } - - writeLines(private$model_methods_env_$hpp_code_, - con = wsl_safe_path(private$hpp_file_, revert = TRUE)) + # Everything that can still fail happens before the executable is replaced, + # so that the commit block below is only assignments. Writing the + # model-method header is fallible and has to come after make, which + # generates its own .hpp at the same path. + stan_code <- readLines(temp_stan_file) + writeLines(model_methods_env$hpp_code_, + con = wsl_safe_path(hpp_file, revert = TRUE)) + + # Errors if the executable could not be replaced, so a failure here can + # never leave the model with no executable at all. A backup that could not + # be cleaned up afterwards is reported rather than signalled, and warned + # about only once all the optional work below has had its chance to run. + leftover_backup <- install_executable(tmp_exe, exe) + + # The new executable is in place, so everything derived from the Stan + # program that was just compiled can be committed. A dry run or a failed + # compilation leaves the previously compiled state untouched. (#1228) + 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() + # Both are exceptions to the rule that state describing the compiled artifact + # is committed only above: during a dry run they are also the configured + # destination and the toolchain version, so they are assigned on a dry run and + # on success -- and, for exe_file_, on a no-op -- but never on a failure. + 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) { + # Both exposures are optional and fallible, and both run only once every + # field describing the installed executable has been committed -- including + # exe_file_ above. Failing here must not leave the object unable to find an + # executable that is sitting on disk. + 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)) { + # Deliberately last: under options(warn = 2) this is an error, and raising + # it any earlier would abort exposure the user asked for -- or worse, roll + # back before the state describing the installed executable was recorded. + warning( + "The previously compiled executable could not be removed. ", + "It has been left at '", leftover_backup, "'.", + call. = FALSE + ) + } } invisible(self) } @@ -961,6 +1204,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 +1338,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 +1392,11 @@ 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()) + # The program on disk has been rewritten, so anything parsed from it is + # stale. $variables() reparses when this is NULL; leaving it would let + # $code() and $variables() describe different programs, and the fitting + # methods validate data and inits against $variables(). (#1228) + private$variables_ <- NULL } invisible(TRUE) diff --git a/R/utils.R b/R/utils.R index eed238bc3..ac64176e7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -205,6 +205,25 @@ resolve_path <- function(path) { repair_path(absolute_path(path)) } +# Do two paths name the same file? Compared canonically rather than as strings, +# so that symlink aliases, ".." components, separator differences and (on +# Windows) casing don't make one file look like two. +# +# mustWork = FALSE is deliberate: neither path is guaranteed to exist, and the +# default mustWork = NA warns when a path cannot be normalized, which +# options(warn = 2) would turn into an error. A path that cannot be normalized +# is compared as given, which for a missing path against an existing one means +# "different" -- the safe answer for both callers. +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 @@ -256,6 +275,117 @@ copy_temp_files <- absolute_path(destinations) } +#' Replace a model executable with a newly compiled one +#' +#' Stages the new executable beside the destination, moves any existing +#' executable aside, and only then renames the staged copy into place. Every step +#' that fails before the final rename leaves the destination exactly as it was; +#' a failed final rename restores the previous executable. +#' +#' Staged and rollback-capable rather than transactional: a crash between the two +#' renames can still leave the previous executable at the backup path only. +#' +#' Every filesystem call is wrapped in `suppressWarnings()` and checked by value. +#' `file.copy()` and `file.rename()` warn on failure, so under +#' `options(warn = 2)` base would throw before returning `FALSE` -- and if that +#' happened on the final rename, the rollback below would never run and the only +#' good executable would be stranded at the backup path. `unlink()` reports a +#' status without signalling, so it needs no such treatment, but it returns +#' `0L` for success rather than `TRUE`. +#' +#' @noRd +#' @param from Path to the newly compiled executable. +#' @param to Path the executable should be installed at. +#' @return `NULL` on a clean install, or the path to a backup of the previous +#' executable that could not be removed afterwards. Callers must not treat a +#' returned path as a failure: the new executable is installed either way, and +#' signalling from here would unwind before the caller could record the state +#' describing it. +install_executable <- function(from, to) { + # repair_path() because tempfile() joins with a backslash on Windows, giving + # "//wsl$/distro/path/to/dir\\exe-new-1234". The Win32 calls below tolerate the + # mixed separators, but wsl_safe_path() only rewrites the prefix, so the POSIX + # chmod inside WSL would be handed a path that does not exist. + candidate <- repair_path(tempfile(pattern = "exe-new-", tmpdir = dirname(to))) + # Discarding the staged copy can fail too, so the diagnostics say where it was + # left rather than implying it is gone and sending the user looking for a file + # that is still there. + 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..19fa6bfa0 100644 --- a/tests/testthat/helper-mock-cli.R +++ b/tests/testthat/helper-mock-cli.R @@ -12,6 +12,13 @@ with_mocked_cli <- function(code, compile_ret, info_ret) { && startsWith(basename(args[1]), "model-") ) { message("mock-compile-was-called") + # Real `make` writes the executable named by args[1] when it succeeds and + # writes nothing when it fails. Without this, code that installs the + # compiled artifact silently has nothing to install. `isTRUE()` because + # callers may pass a `compile_ret` with no status at all. + if (isTRUE(compile_ret$status == 0)) { + file.create(wsl_safe_path(args[1], revert = TRUE)) + } 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..9b4908523 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,20 @@ 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) + + # overwrite with the original code, mod$code() shouldn't change until the + # model is successfully recompiled (#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..d8115dabf 100644 --- a/tests/testthat/test-model-compile-user_header.R +++ b/tests/testthat/test-model-compile-user_header.R @@ -1,3 +1,31 @@ +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 + ) +} + +# A mocked compile installs an executable, so anything that compiles for real +# (even with a mocked compiler) works on a temporary copy rather than writing +# into the package's 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)) + ) +} + # 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. @@ -33,6 +61,328 @@ test_that("cpp_options user headers allow undefined functions", { ) }) +# Also above the file-level skip_if() below: the compiler is mocked, so these +# need no toolchain either. +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)) + ) + + # The executable is up to date, so this call compiles nothing and must leave + # the options describing it alone. + 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 + ) + # A mocked compile rather than a dry run: a dry run builds nothing, so it + # records nothing about a compiled artifact. + 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()) + + # Nothing records which header an executable was built with -- the binary + # cannot report it and nothing is written alongside it -- so a fresh object + # cannot tell a header it was configured with from the one already compiled + # in. Rebuilding on the possibility would recompile in every new R session, + # so the up-to-date executable is kept and $cpp_options() does not claim a + # header it cannot vouch for. Documented under `force_recompile`. + 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"]]) + # Source configuration is a separate axis and still reflects the request: + # it is what makes stanc accept the undefined functions the header defines. + 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_) + + # The usual route to this is a bug in h2 itself, so the header the user just + # supplied has to survive the failure. + 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 or no-op'ing: the + # reuse branch resolves back to h2, so nothing here looks like a change. + 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_) + + # The executable is up to date but was built against a header the model no + # longer uses, so clearing has to force a rebuild rather than no-op. + 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"]]) + } +}) + skip_if(os_is_macos()) w_path <- function(f) { @@ -87,7 +437,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 +453,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 +474,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,15 +532,18 @@ 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") + local_mocked_stanc() + # Mocked successful compiles rather than dry runs: only a compilation that + # produced an executable records the options describing it. + # Case 1: arg with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = { mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), - user_header = tmp_file, - dry_run = TRUE + stan_file = local_external_model(), + user_header = tmp_file ) } ) @@ -201,15 +555,14 @@ test_that("wsl path conversion is done as expected", { # Case 2: cpp opt USER_HEADER with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = { mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), + stan_file = local_external_model(), cpp_options = list( USER_HEADER = tmp_file - ), - dry_run = TRUE + ) ) } ) @@ -221,15 +574,14 @@ test_that("wsl path conversion is done as expected", { # Case # 3: only user_header opt with_mocked_cli( - compile_ret = list(status = 1), - info_ret = list(), + compile_ret = list(status = 0), + info_ret = list(status = 1), code = { mod <- cmdstan_model( - stan_file = testing_stan_file("bernoulli_external"), + stan_file = local_external_model(), cpp_options = list( user_header = tmp_file - ), - dry_run = TRUE + ) ) } ) @@ -248,85 +600,80 @@ test_that("user_header precedence order is correct", { .local_envir = parent.frame(3) )) + local_mocked_stanc() + # Asserted after a mocked successful compile rather than a dry run: only a + # compilation that produced an executable records the options describing it. + # The ignored spelling is dropped in every case, so the next compile has a + # single source for the header. + # Case # 1: all 3 specified + 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 + # tmp_files[2] and tmp_files[3] are 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 + 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 + # cpp_options[['USER_HEADER']] == tmp_files[2] <- actually used + # tmp_files[3] 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 + 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 + # Same as Case #2: USER_HEADER wins whichever order the two appear in 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..efe2fabf3 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -220,6 +220,154 @@ 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 + ) + # A successful compile rather than a dry run: a dry run leaves + # precompile_include_paths_ in place, so the call after it can find the paths + # there and the reuse through the compiled state is never exercised. + 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_) + + # The include path isn't supplied again, but the included file is still found + # and the path still reaches stanc. + 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)) + # Compared against the arguments stanc is actually handed, not the stored + # path: under WSL the model holds a Windows host path while the stanc + # argument is converted to /mnt//..., so the two do not match. + 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", { + # A mocked compile installs a real (empty) executable, so this has to build a + # temporary copy rather than the shared test model. + 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 rather than dry runs: the precompile state these options + # travel in is cleared only once an executable has been installed, so a pair + # of dry runs never reaches the transition this test is named for and passes + # merely because arguments to one call are absent from another. + 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) + ) + + # The held options are released only by a successful compilation, so this is + # the transition that a pair of dry runs cannot reach. + 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 +452,255 @@ 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) +}) + +# A compiled model whose compiler is mocked, so that stanc runs for real and +# only the C++ stage can be made to fail. That is the case the tests above miss: +# the generated C++ for the new program is already in hand, so any state derived +# from it that is recorded before the executable is replaced would outlive a +# failure and describe a program the executable was never built from. +# +# The copy is temporary because a mocked compile installs a real (empty) +# executable, and the model here is the CmdStan installation's own example. +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_ + expect_true(any(nzchar(hpp_code_before))) + + # The model-method environment is handed to every fit, so a stale pairing here + # means fit$init_model_methods() compiles log_prob() from a program the draws + # did not come from. + 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(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) +}) + +test_that("a failed C++ compile doesn't move the executable path", { + model <- local_mocked_bernoulli_model() + exe_before <- model$exe_file() + other_dir <- withr::local_tempdir() + + 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$exe_file(), exe_before) + expect_true(file.exists(exe_before)) +}) + +test_that("compile() errors if the executable cannot be replaced", { + model <- local_mocked_bernoulli_model() + exe <- model$exe_file() + writeLines("old executable", exe) + + # Fail the first attempt to put a file at the destination. A replacement that + # fails unnoticed leaves the model with no executable at all. + real_file_copy <- base::file.copy + real_file_rename <- base::file.rename + installs <- 0 + local_mocked_bindings( + file.copy = function(from, to, ...) { + if (identical(to, exe)) { + installs <<- installs + 1 + if (installs == 1L) return(FALSE) + } + real_file_copy(from, to, ...) + }, + file.rename = function(from, to) { + if (identical(to, exe)) { + installs <<- installs + 1 + if (installs == 1L) return(FALSE) + } + real_file_rename(from, to) + }, + .package = "base" + ) + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = expect_error(model$compile(force_recompile = TRUE)) + ) + expect_true(file.exists(exe)) + expect_identical(readLines(exe), "old executable") +}) + +# Set up a model whose executable is about to be replaced by a program that can +# be told apart from it, with removal of the old executable's backup failing. +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) + # The mocked replacement is empty, the executable it replaced was not. + expect_equal(file.size(model$exe_file()), 0) +} + +test_that("a leftover backup warns without discarding a successful compile", { + model <- local_leftover_backup_model() + + with_mocked_cli( + compile_ret = list(status = 0), + info_ret = list(status = 1), + code = condition <- expect_warning( + model$compile(cpp_options = list(stan_threads = TRUE), force_recompile = TRUE), + "could not be removed" + ) + ) + + # Reporting the backup instead of deleting it is only worth anything if the + # path named is real and still holds the previous executable, so check the + # path out of the message rather than trusting that one was mentioned. + leftover <- sub(".*left at '([^']*)'.*", "\\1", conditionMessage(condition)) + expect_true(file.exists(leftover)) + expect_identical(readLines(leftover), "old executable") + expect_false(same_path(leftover, model$exe_file())) + + expect_describes_new_program(model) +}) + +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()) + + # Signalling the cleanup failure before the state is committed would install + # the new executable while the object still described the old program -- the + # exact hybrid this all exists to prevent. The option is scoped to the call so + # that testthat's own snapshot warnings stay warnings. + 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) + ), + # Separators are normalized first: on Windows the backup path arrives as + # "\exe-old-1234", since tempfile() joins with a backslash. + 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 +805,15 @@ 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 generates no C++, so it leaves the saved location alone rather + # than pointing $hpp_file() at a temporary file that was never written. mod$compile(force_recompile = TRUE, dry_run = TRUE) + expect_equal(mod$hpp_file(), file.path(tmp_dir, "bernoulli.hpp")) + # A real recompilation does write it, to a fresh temporary location. + 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 +930,18 @@ 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") + # both methods only run stanc, which never reads the user header, so an empty + # one is enough here. Compiling against a real header is tested in + # test-model-compile-user_header.R + 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 +1217,31 @@ 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") + + # The program is edited behind the object's back, then formatted in place. + # $format() reloads $code() from disk, so a cached $variables() would go on + # describing a different program than $code() does -- and the fitting methods + # validate data and initial values against $variables(). (#1228) + 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 { 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..f18d734cb 100644 --- a/tests/testthat/test-model-generate_quantities.R +++ b/tests/testthat/test-model-generate_quantities.R @@ -55,15 +55,29 @@ 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 executable is already built without threading and is up to date, so this + # does not rebuild it and the request has no effect on the binary. The request + # is therefore not recorded either, so 'threads_per_chain' is refused rather + # than reported back as though it had taken effect. (#1019) + expect_warning( + mod_gq <- cmdstan_model(testing_stan_file("bernoulli_ppc"), cpp_options = list(stan_threads = TRUE)), + "do not match the ones requested" ) - expect_output( - mod_gq$generate_quantities(data = data_list, fitted_params = fit_1_chain, threads_per_chain = 2), - "2 thread(s) per chain", - fixed = TRUE + expect_warning( + expect_gq_output( + 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" + ) + # This used to report "2 thread(s) per chain" for a binary compiled without + # STAN_THREADS, which ran single-threaded regardless. + 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_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..2dc1ce905 100644 --- a/tests/testthat/test-model-recompile-logic.R +++ b/tests/testthat/test-model-recompile-logic.R @@ -1,9 +1,21 @@ -stan_program <- cmdstan_example_file() +# A mocked compile produces a real (empty) executable at the destination, so the +# model compiled here must be a temporary copy. Compiling the installed example +# in place would replace the CmdStan installation's own executable. +example_exe <- cmdstan_ext(strip_ext(cmdstan_example_file())) +example_exe_before <- file.info(example_exe)[, c("size", "mtime")] + +model_dir <- withr::local_tempdir() +stan_program <- file.path(model_dir, "bernoulli.stan") +file.copy(cmdstan_example_file(), stan_program) +# Keep the program older than the placeholder executables created below, so the +# up-to-date check doesn't force a recompile on timestamp resolution alone. +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 +35,734 @@ 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(), + # The mocked compile now leaves an executable behind, 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 <- cmdstan_model(stan_file = stan_program, force_recompile = TRUE) }) ) ) +test_that("a mocked successful compile installs an 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 = 0), + info_ret = list(status = 1), + code = mod <- cmdstan_model(stan_file = stan_file, force_recompile = TRUE) + ) + + expect_equal(mod$exe_file(), exe) + expect_true(file.exists(exe)) +}) + +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) + + # The second call finds the executable up to date and compiles nothing, so it + # must not discard the options the executable was actually built with: an + # erased stan_threads makes assert_valid_threads() drop 'threads' and run a + # threaded executable single-threaded. It must not claim the executable is + # pre-compiled either, or $expose_functions() fails on a model that built + # itself. + 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) + # Standalone functions are rejected outright on WSL, before existing_exe is + # consulted, so only there can this consequence not be observed. + if (!os_is_wsl()) { + expect_warning(mod$expose_functions(), "No standalone functions found") + } +}) + +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" + ) + + # Nothing was rebuilt, so the request describes no executable that exists. + # Recording it anyway left assert_valid_threads() trusting it, and a plain + # $sample() then failed with "The model executable was built with threading + # enabled but 'threads_per_chain' was not set!" -- an error that is both + # false and inescapable without recompiling. (#1019) + expect_false(isTRUE(mod$cpp_options()$stan_threads)) + expect_no_error( + mod$sample( + data = testing_data("bernoulli"), + chains = 1, + iter_warmup = 100, + iter_sampling = 100, + refresh = 0, + 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 #include directive resolves to a different file under the other + # directory, so an executable built against one does not describe the program + # the other produces. Without this the object reported the new paths and the + # new $variables() while still running the old binary, which is the + # stale-validation failure #1228 is about. + 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") + + # The recorded paths are now the ones just built against, so a bare call has + # nothing new to build. + 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 the executable through one object, then let a second, freshly + # constructed object find it up to date. + 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) + # Hydrated from the executable itself: STAN_THREADS is reported, STAN_OPENCL + # is reported as FALSE (i.e. never set) and STAN_VERSION is 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) + + # Same object, same executable, but this call explicitly asks for threading. + # Nothing was rebuilt, so what is recorded still has to describe the binary + # on disk; the caller learns their request had no effect from the warning. + 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) + ) + + # CmdStan 2.39 reports no STAN_CPP_OPTIMS, and reports nothing at all about + # arbitrary make variables, so the binary's own metadata can neither confirm + # nor deny either request. This object compiled this executable, though, so + # what it was built with is known exactly and both requests plainly disagree + # with it. Detecting these through the metadata alone silently ignored them. + 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 + ) + ) + + # Re-supplying exactly what the executable was built with is ordinary reuse, + # even when the option never had a name to compare by. + 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) + + # Comparing against the record alone reported a mismatch for a binary that + # does have threading. The binary's own account fills the gap, and is kept: + # suppressing the warning without recording what it revealed would leave + # assert_valid_threads() still dropping 'threads_per_chain'. + 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)) + ) + ) + ) + # ...and changing the unreportable one is still caught. + 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" + ) + ) + ) + + # With no metadata to be had, the record is all there is and still answers + # for the option it holds. + 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 + ) + ) + + # The binary reports threading and this call did not name stan_threads, but it + # did pass STAN_THREADS=TRUE as a raw assignment, so the flag is not inherited + # from make/local and omitting it would drop it. Reading names() rather than + # what make was given missed that and stayed quiet. + 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) + + # Metadata reporting threading off, rather than no metadata at all, so the + # merge is exercised: a reported FALSE is skipped, leaving the explicit NULL + # to stand as the empty assignment it is. + 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) + ) + + # A second object adopts that executable and holds no generated C++ for it, + # so the binary's own metadata is the only description available and it + # reports nothing about STAN_CPP_OPTIMS. Unverifiable is not a mismatch, so + # this 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 + ) + ) + + # Adopted by a second object, so the binary's metadata is the only account of + # it available -- an object that compiled the executable is answered from what + # it recorded instead. The metadata reports exactly what is being asked for, + # so re-stating it must stay quiet, otherwise the warning fires on ordinary + # reuse. + 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)) + ) + ) + # Hydrated from metadata, so it carries the metadata's spelling; the accessor + # the fitting methods use is case-insensitive. + 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 is empty, so running it errors rather than returning + # a non-zero status. Adopting it is best-effort and must still succeed. + 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) + ) + + # A current executable already sits in the target directory. Adopting it would + # leave the object describing this program's C++ while running that binary, so + # the model is rebuilt there instead. + 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( @@ -103,3 +836,14 @@ test_that("recompile when cpp args don't match binary", { }) ) }) + +# Deliberately the last test in this file: it checks that none of the mocked +# compiles above installed anything over the CmdStan installation's own example +# executable. A git diff would not catch this, since that executable is not part +# of the repository, and a truncating overwrite changes no tracked file at all. +test_that("mocked compiles leave the CmdStan installation untouched", { + expect_equal( + file.info(example_exe)[, c("size", "mtime")], + example_exe_before + ) +}) diff --git a/tests/testthat/test-model-variables.R b/tests/testthat/test-model-variables.R index a87cf4c1a..4abb9a622 100644 --- a/tests/testthat/test-model-variables.R +++ b/tests/testthat/test-model-variables.R @@ -70,6 +70,57 @@ 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 = 100, + iter_sampling = 100, + refresh = 0, + init = list(list(beta = 0)) + ) + ), + 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..7d6871141 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -209,6 +209,168 @@ 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) + if (destination_exists) { + writeLines("old executable", fixture$to) + } + fixture +} + +# Normalize the random staging and backup names out of a snapshot, keeping the +# structure of the paths the diagnostics name. +# +# Separators are normalized first because on Windows these paths arrive with a +# mixture: dirname() converts to forward slashes, while withr::local_tempdir() +# and tempfile() use backslashes, so tempfile(tmpdir = dirname(to)) yields +# "C:/a/b\exe-new-1234". +exe_path_transform <- function(fixture) { + # Every spelling the directory can appear in: withr::local_tempdir() can + # return "/tmp//Rtmpx", file.path() keeps that, and install_executable() + # passes its own paths through repair_path(), which collapses it. + dirs <- unique(c( + fixture$dir, + repair_path(fixture$dir), + gsub("\\\\", "/", fixture$dir) + )) + # Deliberately not normalizing separators in the message itself: + # install_executable() repairs the paths it builds, so a backslash reaching a + # diagnostic is a regression these snapshots should catch, not hide. + 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_identical(readLines(fixture$to), "new executable") + 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_identical(readLines(fixture$to), "new executable") + 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() + # base warns and returns FALSE; under warn = 2 the warning alone would throw + # from inside file.rename(), skipping the rollback and stranding the only good + # executable at the backup path. + 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") + + # Reporting rather than signalling is the whole point: a warning here would, + # under options(warn = 2), unwind before the caller could record the state + # describing the executable that was just installed. + 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")