Merge pull request #836 from martinmodrak/835-compile-test-improvements

rok-cesnovar · web-flow · commit 22ee5fc84759 · 2023-09-14T09:11:46.000+02:00
Improvemements to compile tests
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -40,12 +40,12 @@ Imports:
     posterior (>= 1.4.1),
     processx (>= 3.5.0),
     R6 (>= 2.4.0),
-    withr (>= 2.5.0)
+    withr (>= 2.5.0),
+    rlang (>= 0.4.7)
 Suggests:
     bayesplot,
     knitr (>= 1.37),
     loo (>= 2.0.0),
-    rlang (>= 0.4.7),
     rmarkdown,
     testthat (>= 2.1.0),
     Rcpp,
diff --git a/R/model.R b/R/model.R
@@ -570,7 +570,7 @@ compile <- function(quiet = TRUE,
   }
 
   if (!force_recompile) {
-    if (interactive()) {
+    if (rlang::is_interactive()) {
       message("Model executable is up to date!")
     }
     private$cpp_options_ <- cpp_options
@@ -581,7 +581,7 @@ compile <- function(quiet = TRUE,
     self$exe_file(exe)
     return(invisible(self))
   } else {
-    if (interactive()) {
+    if (rlang::is_interactive()) {
       message("Compiling Stan program...")
     }
   }
@@ -632,89 +632,92 @@ compile <- function(quiet = TRUE,
 
   stancflags_val <- paste0("STANCFLAGS += ", stancflags_val, paste0(" ", stancflags_combined, collapse = " "))
 
-  if (dry_run) {
-    return(invisible(self))
-  }
+  if (!dry_run) {
 
-  if (compile_standalone) {
-    expose_stan_functions(self$functions, !quiet)
-  }
+    if (compile_standalone) {
+      expose_stan_functions(self$functions, !quiet)
+    }
 
-  withr::with_path(
-    c(
-      toolchain_PATH_env_var(),
-      tbb_path()
-    ),
-    run_log <- wsl_compatible_run(
-      command = make_cmd(),
-      args = c(wsl_safe_path(tmp_exe),
-              cpp_options_to_compile_flags(cpp_options),
-              stancflags_val),
-      wd = cmdstan_path(),
-      echo = !quiet || is_verbose_mode(),
-      echo_cmd = is_verbose_mode(),
-      spinner = quiet && interactive() && !identical(Sys.getenv("IN_PKGDOWN"), "true"),
-      stderr_callback = function(x, p) {
-        if (!startsWith(x, paste0(make_cmd(), ": *** No rule to make target"))) {
-          message(x)
-        }
-        if (grepl("PCH file", x) || grepl("precompiled header", x) || grepl(".hpp.gch", x) ) {
-          warning(
-            "CmdStan's precompiled header (PCH) files may need to be rebuilt.\n",
-            "If your model failed to compile please run rebuild_cmdstan().\n",
-            "If the issue persists please open a bug report.",
-            call. = FALSE
-          )
-        }
-        if (grepl("No space left on device", x) || grepl("error in backend: IO failure on output stream", x)) {
-          warning(
-            "The C++ compiler ran out of disk space and was unable to build the executables for your model!\n",
-            "See the above error for more details.",
-            call. = FALSE
-          )
-        }
-        if (os_is_macos()) {
-          if (R.version$arch == "aarch64"
-              && grepl("but the current translation unit is being compiled for target", x)) {
+    withr::with_path(
+      c(
+        toolchain_PATH_env_var(),
+        tbb_path()
+      ),
+      run_log <- wsl_compatible_run(
+        command = make_cmd(),
+        args = c(wsl_safe_path(tmp_exe),
+                cpp_options_to_compile_flags(cpp_options),
+                stancflags_val),
+        wd = cmdstan_path(),
+        echo = !quiet || is_verbose_mode(),
+        echo_cmd = is_verbose_mode(),
+        spinner = quiet && rlang::is_interactive() && !identical(Sys.getenv("IN_PKGDOWN"), "true"),
+        stderr_callback = function(x, p) {
+          if (!startsWith(x, paste0(make_cmd(), ": *** No rule to make target"))) {
+            message(x)
+          }
+          if (grepl("PCH file", x) || grepl("precompiled header", x) || grepl(".hpp.gch", x) ) {
             warning(
-              "The C++ compiler has errored due to incompatibility between the x86 and ",
-              "Apple Silicon architectures.\n",
-              "If you are running R inside an IDE (RStudio, VSCode, ...), ",
-              "make sure the IDE is a native Apple Silicon app.\n",
+              "CmdStan's precompiled header (PCH) files may need to be rebuilt.\n",
+              "If your model failed to compile please run rebuild_cmdstan().\n",
+              "If the issue persists please open a bug report.",
               call. = FALSE
             )
           }
-        }
-      },
-      error_on_status = FALSE
-    )
-  )
-  if (is.na(run_log$status) || run_log$status != 0) {
-    stop("An error occured 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
+          if (grepl("No space left on device", x) || grepl("error in backend: IO failure on output stream", x)) {
+            warning(
+              "The C++ compiler ran out of disk space and was unable to build the executables for your model!\n",
+              "See the above error for more details.",
+              call. = FALSE
+            )
+          }
+          if (os_is_macos()) {
+            if (R.version$arch == "aarch64"
+                && grepl("but the current translation unit is being compiled for target", x)) {
+              warning(
+                "The C++ compiler has errored due to incompatibility between the x86 and ",
+                "Apple Silicon architectures.\n",
+                "If you are running R inside an IDE (RStudio, VSCode, ...), ",
+                "make sure the IDE is a native Apple Silicon app.\n",
+                call. = FALSE
+              )
+            }
+          }
+        },
+        error_on_status = FALSE
+      )
     )
-  }
+    if (is.na(run_log$status) || run_log$status != 0) {
+      stop("An error occured 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
+      )
+    }
+  } # End - if(!dry_run)
+
   private$exe_file_ <- exe
   private$cpp_options_ <- cpp_options
   private$precompile_cpp_options_ <- NULL
   private$precompile_stanc_options_ <- NULL
   private$precompile_include_paths_ <- NULL
   private$model_methods_env_ <- new.env()
-  suppressWarnings(private$model_methods_env_$hpp_code_ <- readLines(private$hpp_file_, warn = FALSE))
-  if (compile_model_methods) {
-    expose_model_methods(env = private$model_methods_env_,
-                          verbose = !quiet,
-                          hessian = compile_hessian_method)
+
+  if(!dry_run) {
+    suppressWarnings(private$model_methods_env_$hpp_code_ <- readLines(private$hpp_file_, warn = FALSE))
+    if (compile_model_methods) {
+      expose_model_methods(env = private$model_methods_env_,
+                            verbose = !quiet,
+                            hessian = compile_hessian_method)
+    }
   }
   invisible(self)
 }
@@ -876,7 +879,7 @@ check_syntax <- function(pedantic = FALSE,
       wd = cmdstan_path(),
       echo = is_verbose_mode(),
       echo_cmd = is_verbose_mode(),
-      spinner = quiet && interactive(),
+      spinner = quiet && rlang::is_interactive(),
       stderr_callback = function(x, p) {
         message(x)
       },
diff --git a/tests/testthat/helper-custom-expectations.R b/tests/testthat/helper-custom-expectations.R
@@ -16,6 +16,21 @@ expect_compilation <- function(mod, ...) {
   invisible(mod)
 }
 
+#' Check compilation from a call (expecting a constructor call, but not necessarily).
+#' @param constructor_call a call returning a CmdStanModel object that should have been compiled
+#' @return the newly created model
+expect_call_compilation <- function(constructor_call) {
+  before_time <- Sys.time()
+  mod <- expect_interactive_message(constructor_call, "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()))
+  }
+  after_mtime <- file.mtime(mod$exe_file())
+  expect(before_time <= after_mtime, sprintf("Exe file '%s' has old timestamp, 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())) {
@@ -70,14 +85,11 @@ expect_gq_output <- function(object, num_chains = NULL) {
 }
 
 expect_interactive_message <- function(object, regexp = NULL) {
-  # Non-interactive message suppression failing under Windows CI,
-  # temporarily skip message check only on Windows
-  if (os_is_windows() && !os_is_wsl()) {
-    return(object)
-  }
-  if (interactive()) {
-    expect_message(object = object, regexp = regexp)
-  } else {
-    expect_silent(object = object)
-  }
+  rlang::with_interactive(value = TRUE,
+    expect_message(object = object, regexp = regexp))
+}
+
+expect_noninteractive_silent <- function(object) {
+  rlang::with_interactive(value = FALSE,
+    expect_silent(object))
 }
diff --git a/tests/testthat/test-model-compile.R b/tests/testthat/test-model-compile.R
