diff --git a/R/model.R b/R/model.R index 5fe9f70fc..0086892ea 100644 --- a/R/model.R +++ b/R/model.R @@ -397,6 +397,8 @@ CmdStanModel <- R6::R6Class( #' `functions` field in the compiled model object. This can also be done after #' compilation using the #' [`$expose_functions()`][model-method-expose_functions] method. +#' @param dry_run (logical) If `TRUE`, the code will do all checks before compilation, +#' but skip the actual C++ compilation. Used to speedup tests. #' #' @param threads Deprecated and will be removed in a future release. Please #' turn on threading via `cpp_options = list(stan_threads = TRUE)` instead. @@ -450,8 +452,10 @@ compile <- function(quiet = TRUE, compile_model_methods = FALSE, compile_hessian_method = FALSE, compile_standalone = FALSE, + dry_run = FALSE, #deprecated threads = FALSE) { + if (length(self$stan_file()) == 0) { stop("'$compile()' cannot be used because the 'CmdStanModel' was not created with a Stan file.", call. = FALSE) } @@ -500,15 +504,63 @@ compile <- function(quiet = TRUE, exe <- self$exe_file() } + # Resolve stanc and cpp options + if (pedantic) { + stanc_options[["warn-pedantic"]] <- TRUE + } + + if (isTRUE(cpp_options$stan_opencl)) { + 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)) + stanc_options[["allow-undefined"]] <- TRUE + private$using_user_header_ <- TRUE + } + else if (!is.null(cpp_options[["USER_HEADER"]])) { + if(!is.null(cpp_options[["user_header"]])) { + warning('User header specified both via cpp_options[["USER_HEADER"]] and cpp_options[["user_header"]].', call. = FALSE) + } + + user_header <- cpp_options[["USER_HEADER"]] + cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(cpp_options[["USER_HEADER"]])) + private$using_user_header_ <- TRUE + } + else if (!is.null(cpp_options[["user_header"]])) { + user_header <- cpp_options[["user_header"]] + cpp_options[["user_header"]] <- wsl_safe_path(absolute_path(cpp_options[["user_header"]])) + private$using_user_header_ <- TRUE + } + + + if(!is.null(user_header)) { + user_header <- absolute_path(user_header) # As mentioned above, just absolute, not wsl_safe_path() + if(!file.exists(user_header)) { + stop(paste0("User header file '", user_header, "' does not exist."), call. = FALSE) + } + } + # compile if: # - the user forced compilation, # - the executable does not exist # - the stan model was changed since last compilation + # - a user header is used and the user header changed since last compilation (#813) if (!file.exists(exe)) { force_recompile <- TRUE } else if (file.exists(self$stan_file()) && file.mtime(exe) < file.mtime(self$stan_file())) { force_recompile <- TRUE + } else if (!is.null(user_header) + && file.exists(user_header) + && file.mtime(exe) < file.mtime(user_header)) { + force_recompile <- TRUE } if (!force_recompile) { @@ -530,7 +582,7 @@ compile <- function(quiet = TRUE, if (os_is_wsl() && (compile_model_methods || compile_standalone)) { warning("Additional model methods and standalone functions are not ", - "currently available with WSL CmdStan and will not be compiled", + "currently available with WSLv1 CmdStan and will not be compiled.", call. = FALSE) compile_model_methods <- FALSE compile_standalone <- FALSE @@ -548,23 +600,6 @@ compile <- function(quiet = TRUE, stancflags_val <- include_paths_stanc3_args(include_paths) - if (pedantic) { - stanc_options[["warn-pedantic"]] <- TRUE - } - - if (isTRUE(cpp_options$stan_opencl)) { - stanc_options[["use-opencl"]] <- TRUE - } - if (!is.null(user_header)) { - cpp_options[["USER_HEADER"]] <- wsl_safe_path(user_header) - stanc_options[["allow-undefined"]] <- TRUE - } - if (!is.null(cpp_options[["USER_HEADER"]])) { - cpp_options[["USER_HEADER"]] <- wsl_safe_path(absolute_path(cpp_options[["USER_HEADER"]])) - } - if (!is.null(cpp_options[["user_header"]])) { - cpp_options[["user_header"]] <- wsl_safe_path(absolute_path(cpp_options[["user_header"]])) - } if (is.null(stanc_options[["name"]])) { stanc_options[["name"]] <- paste0(self$model_name(), "_model") } @@ -588,10 +623,17 @@ compile <- function(quiet = TRUE, self$functions$hpp_code <- get_standalone_hpp(temp_stan_file, stancflags_standalone) self$functions$external <- !is.null(user_header) self$functions$existing_exe <- FALSE + + stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " ")) + + if (dry_run) { + return(invisible(self)) + } + if (compile_standalone) { expose_stan_functions(self$functions, !quiet) } - stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " ")) + withr::with_path( c( toolchain_PATH_env_var(), diff --git a/man/model-method-compile.Rd b/man/model-method-compile.Rd index b4d7b35f8..34b8a25de 100644 --- a/man/model-method-compile.Rd +++ b/man/model-method-compile.Rd @@ -17,6 +17,7 @@ compile( compile_model_methods = FALSE, compile_hessian_method = FALSE, compile_standalone = FALSE, + dry_run = FALSE, threads = FALSE ) } @@ -72,6 +73,9 @@ compiled for use in R? If \code{TRUE} the functions will be available via the compilation using the \code{\link[=model-method-expose_functions]{$expose_functions()}} method.} +\item{dry_run}{(logical) If \code{TRUE}, the code will do all checks before compilation, +but skip the actual C++ compilation. Used to speedup tests.} + \item{threads}{Deprecated and will be removed in a future release. Please turn on threading via \code{cpp_options = list(stan_threads = TRUE)} instead.} } diff --git a/tests/testthat/helper-custom-expectations.R b/tests/testthat/helper-custom-expectations.R index 80f596821..ae08cce90 100644 --- a/tests/testthat/helper-custom-expectations.R +++ b/tests/testthat/helper-custom-expectations.R @@ -1,3 +1,34 @@ +#' @param ... arguments passed to mod$compile() +expect_compilation <- function(mod, ...) { + if(length(mod$exe_file()) > 0 && file.exists(mod$exe_file())) { + before_mtime <- file.mtime(mod$exe_file()) + } else { + before_mtime <- NULL + } + expect_interactive_message(mod$compile(...), "Compiling Stan program...") + if(length(mod$exe_file()) == 0 || !file.exists(mod$exe_file())) { + fail(sprint("Model executable '%s' does not exist after compilation.", mod$exe_file())) + } + if(!is.null(before_mtime)) { + after_mtime <- file.mtime(mod$exe_file()) + expect(before_mtime != after_mtime, sprintf("Exe file '%s' has NOT changed, despite expecting (re)compilation", mod$exe_file())) + } + invisible(mod) +} + +#' @param ... arguments passed to mod$compile() +expect_no_recompilation <- function(mod, ...) { + if(length(mod$exe_file()) == 0 || !file.exists(mod$exe_file())) { + fail(sprint("Model executable '%s' does not exist, cannot test if recompilation is triggerred.", mod$exe_file())) + } + + before_mtime <- file.mtime(mod$exe_file()) + expect_interactive_message(mod$compile(...), "Model executable is up to date!") + after_mtime <- file.mtime(mod$exe_file()) + expect(before_mtime == after_mtime, sprintf("Model executable '%s' has changed, despite expecting no recompilation", mod$exe_file())) + invisible(mod) +} + expect_sample_output <- function(object, num_chains = NULL) { output <- "Running MCMC with" diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R index 6052d80aa..3134bbc0b 100644 --- a/tests/testthat/test-model-compile.R +++ b/tests/testthat/test-model-compile.R @@ -4,6 +4,7 @@ set_cmdstan_path() stan_program <- cmdstan_example_file() mod <- cmdstan_model(stan_file = stan_program, compile = FALSE) + test_that("object initialized correctly", { expect_equal(mod$stan_file(), stan_program) expect_equal(mod$exe_file(), character(0)) @@ -28,8 +29,8 @@ test_that("compile() method works", { if (file.exists(exe)) { file.remove(exe) } - expect_interactive_message(mod$compile(quiet = TRUE), "Compiling Stan program...") - expect_interactive_message(mod$compile(quiet = TRUE), "Model executable is up to date!") + expect_compilation(mod, quiet = TRUE) + expect_no_recompilation(mod, quiet = TRUE) checkmate::expect_file_exists(mod$hpp_file()) checkmate::expect_file_exists(exe) file.remove(exe) @@ -39,10 +40,7 @@ test_that("compile() method works", { test_that("compile() method forces recompilation force_recompile = TRUE", { mod$compile(quiet = TRUE) - expect_interactive_message( - mod$compile(quiet = TRUE, force_recompile = TRUE), - "Compiling Stan program..." - ) + expect_compilation(mod, quiet = TRUE, force_recompile = TRUE) }) test_that("compile() method forces recompilation if model modified", { @@ -52,7 +50,7 @@ test_that("compile() method forces recompilation if model modified", { mod$compile(quiet = TRUE) } Sys.setFileTime(mod$stan_file(), Sys.time() + 1) #touch file to trigger recompile - expect_interactive_message(mod$compile(quiet = TRUE), "Compiling Stan program...") + expect_compilation(mod, quiet = TRUE) }) test_that("compile() method works with spaces in path", { @@ -70,7 +68,7 @@ test_that("compile() method works with spaces in path", { if (file.exists(exe)) { file.remove(exe) } - expect_interactive_message(mod_spaces$compile(), "Compiling Stan program...") + expect_compilation(mod_spaces) file.remove(stan_model_with_spaces) file.remove(exe) unlink(dir_with_spaces, recursive = TRUE) @@ -156,6 +154,8 @@ test_that("switching threads on and off works without rebuild", { mod$compile(force_recompile = TRUE) after_mtime <- file.mtime(main_path_o) expect_equal(before_mtime, after_mtime) + + expect_warning(mod$compile(threads = TRUE, dry_run = TRUE), "deprecated") }) test_that("multiple cpp_options work", { @@ -595,7 +595,7 @@ test_that("cmdstan_model errors with no args ", { }) test_that("cmdstan_model works with user_header", { - skip_if(os_is_macos() | (os_is_windows() && !os_is_wsl())) + skip_if(os_is_macos()) tmpfile <- tempfile(fileext = ".hpp") hpp <- " @@ -627,6 +627,43 @@ test_that("cmdstan_model works with user_header", { stanc_options = list("allow-undefined") ) expect_true(file.exists(mod_2$exe_file())) + + # Check recompilation upon changing header + expect_no_recompilation(mod, quiet = TRUE, user_header = tmpfile) + + Sys.setFileTime(tmpfile, Sys.time() + 1) #touch file to trigger recompile + expect_compilation(mod, quiet = TRUE, user_header = tmpfile) + + # Alternative spec of user header + expect_no_recompilation(mod, + quiet = TRUE, + cpp_options = list(user_header = tmpfile), + dry_run = TRUE + ) + + # Error/warning messages + expect_error( + cmdstan_model( + stan_file = testing_stan_file("bernoulli_external"), + cpp_options = list(USER_HEADER = "non_existent.hpp"), + stanc_options = list("allow-undefined") + ), + "header file '[^']*' does not exist" + ) + + expect_warning(cmdstan_model( + stan_file = testing_stan_file("bernoulli_external"), + cpp_options = list(USER_HEADER = tmpfile, user_header = tmpfile), + dry_run = TRUE), + "User header specified both" + ) + expect_warning(cmdstan_model( + stan_file = testing_stan_file("bernoulli_external"), + user_header = tmpfile, + cpp_options = list(USER_HEADER = tmpfile), + dry_run = TRUE), + "User header specified both" + ) }) test_that("cmdstan_model cpp_options dont captialize cxxflags ", {