Merge pull request #990 from stan-dev/bugfixes

Bugfixes - Fix Windows path change, aarch64 rtools, 2.35 seed changes
stan-dev · Jun 6, 2024 · 9ea8e99 · 9ea8e99
2 parents c9369c4 + 4927783
commit 9ea8e99
Show file tree

Hide file tree

Showing 6 changed files with 148 additions and 112 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -69,11 +69,7 @@ jobs:
       - name: Install cmdstan
         run: |
           cmdstanr::check_cmdstan_toolchain(fix = TRUE)
-          if (Sys.getenv("CMDSTANR_USE_RTOOLS") == "TRUE") {
-            cmdstanr::install_cmdstan(cores = 2, version = "2.35.0-rc2")
-          } else {
-            cmdstanr::install_cmdstan(cores = 2)
-          }
+          cmdstanr::install_cmdstan(cores = 2)
         shell: Rscript {0}
 
       - name: Session info

diff --git a/R/install.R b/R/install.R
@@ -453,63 +453,72 @@ build_cmdstan <- function(dir,
   } else {
     run_cmd <- make_cmd()
   }
-  withr::with_path(
-    c(
-      toolchain_PATH_env_var(),
-      tbb_path(dir = dir)
-    ),
-    wsl_compatible_run(
-      command = run_cmd,
-      args = c(translation_args, paste0("-j", cores), "build"),
-      wd = dir,
-      echo_cmd = is_verbose_mode(),
-      echo = !quiet || is_verbose_mode(),
-      spinner = quiet,
-      error_on_status = FALSE,
-      stderr_callback = function(x, p) { if (quiet) message(x) },
-      timeout = timeout
+  withr::with_envvar(
+    c("HOME" = short_path(Sys.getenv("HOME"))),
+    withr::with_path(
+      c(
+        toolchain_PATH_env_var(),
+        tbb_path(dir = dir)
+      ),
+      wsl_compatible_run(
+        command = run_cmd,
+        args = c(translation_args, paste0("-j", cores), "build"),
+        wd = dir,
+        echo_cmd = is_verbose_mode(),
+        echo = !quiet || is_verbose_mode(),
+        spinner = quiet,
+        error_on_status = FALSE,
+        stderr_callback = function(x, p) { if (quiet) message(x) },
+        timeout = timeout
+      )
     )
   )
 }
 
 clean_cmdstan <- function(dir = cmdstan_path(),
                           cores = getOption("mc.cores", 2),
                           quiet = FALSE) {
-  withr::with_path(
-    c(
-      toolchain_PATH_env_var(),
-      tbb_path(dir = dir)
-    ),
-    wsl_compatible_run(
-      command = make_cmd(),
-      args = "clean-all",
-      wd = dir,
-      echo_cmd = is_verbose_mode(),
-      echo = !quiet || is_verbose_mode(),
-      spinner = quiet,
-      error_on_status = FALSE,
-      stderr_callback = function(x, p) { if (quiet) message(x) }
+  withr::with_envvar(
+    c("HOME" = short_path(Sys.getenv("HOME"))),
+    withr::with_path(
+      c(
+        toolchain_PATH_env_var(),
+        tbb_path(dir = dir)
+      ),
+      wsl_compatible_run(
+        command = make_cmd(),
+        args = "clean-all",
+        wd = dir,
+        echo_cmd = is_verbose_mode(),
+        echo = !quiet || is_verbose_mode(),
+        spinner = quiet,
+        error_on_status = FALSE,
+        stderr_callback = function(x, p) { if (quiet) message(x) }
+      )
     )
   )
 }
 
 build_example <- function(dir, cores, quiet, timeout) {
-  withr::with_path(
-    c(
-      toolchain_PATH_env_var(),
-      tbb_path(dir = dir)
-    ),
-    wsl_compatible_run(
-      command = make_cmd(),
-      args = c(paste0("-j", cores),
-                cmdstan_ext(file.path("examples", "bernoulli", "bernoulli"))),
-      wd = dir,
-      echo_cmd = is_verbose_mode(),
-      echo = !quiet || is_verbose_mode(),
-      spinner = quiet,
-      error_on_status = FALSE,
-      stderr_callback = function(x, p) { if (quiet) message(x) },
-      timeout = timeout
+  withr::with_envvar(
+    c("HOME" = short_path(Sys.getenv("HOME"))),
+    withr::with_path(
+      c(
+        toolchain_PATH_env_var(),
+        tbb_path(dir = dir)
+      ),
+      wsl_compatible_run(
+        command = make_cmd(),
+        args = c(paste0("-j", cores),
+                  cmdstan_ext(file.path("examples", "bernoulli", "bernoulli"))),
+        wd = dir,
+        echo_cmd = is_verbose_mode(),
+        echo = !quiet || is_verbose_mode(),
+        spinner = quiet,
+        error_on_status = FALSE,
+        stderr_callback = function(x, p) { if (quiet) message(x) },
+        timeout = timeout
+      )
     )
   )
 }
@@ -849,7 +858,11 @@ toolchain_PATH_env_var <- function() {
 rtools4x_toolchain_path <- function() {
   toolchain <- ifelse(is_ucrt_toolchain(), "ucrt64", "mingw64")
   if (Sys.getenv("CMDSTANR_USE_RTOOLS") != "") {
-    toolchain <- "x86_64-w64-mingw32.static.posix"
+    if (arch_is_aarch64()) {
+      toolchain <- "aarch64-w64-mingw32.static.posix"
+    } else {
+      toolchain <- "x86_64-w64-mingw32.static.posix"
+    }
   }
   repair_path(file.path(rtools4x_home_path(), toolchain, "bin"))
 }
@@ -871,10 +884,16 @@ rtools4x_version <- function() {
 
 rtools4x_home_path <- function() {
   rtools_ver <- rtools4x_version()
+  if (arch_is_aarch64()) {
+    rtools_ver <- paste0(rtools_ver, "_AARCH64")
+  }
   path <- Sys.getenv(paste0("RTOOLS", rtools_ver, "_HOME"))
 
   if (!nzchar(path)) {
     default_path <- repair_path(file.path(paste0("C:/rtools", rtools_ver)))
+    if (arch_is_aarch64()) {
+      default_path <- paste0(default_path, "-aarch64")
+    }
     if (dir.exists(default_path)) {
       path <- default_path
     }

diff --git a/R/model.R b/R/model.R
@@ -665,53 +665,56 @@ compile <- function(quiet = TRUE,
       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(repair_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(
-              "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_envvar(
+      c("HOME" = short_path(Sys.getenv("HOME"))),
+      withr::with_path(
+        c(
+          toolchain_PATH_env_var(),
+          tbb_path()
+        ),
+        run_log <- wsl_compatible_run(
+          command = make_cmd(),
+          args = c(wsl_safe_path(repair_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 (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) {

diff --git a/R/run.R b/R/run.R
@@ -410,18 +410,21 @@ CmdStanRun <- R6::R6Class(
 check_target_exe <- function(exe) {
   exe_path <- file.path(cmdstan_path(), exe)
   if (!file.exists(exe_path)) {
-    withr::with_path(
-      c(
-        toolchain_PATH_env_var(),
-        tbb_path()
-      ),
-      run_log <- wsl_compatible_run(
-        command = make_cmd(),
-        args = exe,
-        wd = cmdstan_path(),
-        echo_cmd = TRUE,
-        echo = TRUE,
-        error_on_status = TRUE
+    withr::with_envvar(
+      c("HOME" = short_path(Sys.getenv("HOME"))),
+      withr::with_path(
+        c(
+          toolchain_PATH_env_var(),
+          tbb_path()
+        ),
+        run_log <- wsl_compatible_run(
+          command = make_cmd(),
+          args = exe,
+          wd = cmdstan_path(),
+          echo_cmd = TRUE,
+          echo = TRUE,
+          error_on_status = TRUE
+        )
       )
     )
   }

diff --git a/R/utils.R b/R/utils.R
@@ -83,6 +83,10 @@ is_rosetta2 <- function() {
   rosetta2
 }
 
+arch_is_aarch64 <- function() {
+  isTRUE(R.version$arch == "aarch64")
+}
+
 # Returns the type of make command to use to compile depending on the OS
 make_cmd <- function() {
   if (os_is_windows() && !os_is_wsl() && (Sys.getenv("CMDSTANR_USE_RTOOLS") == "")) {
@@ -103,6 +107,14 @@ stanc_cmd <- function() {
 
 # paths and extensions ----------------------------------------------------
 
+short_path <- function(path) {
+  if (os_is_windows()) {
+    utils::shortPathName(path)
+  } else {
+    path
+  }
+}
+
 # Replace `\\` with `/` in a vector of paths
 # Needed for windows if CmdStan version is < 2.21:
 # https://github.com/stan-dev/cmdstanr/issues/1#issuecomment-539118598
@@ -688,11 +700,14 @@ assert_file_exists <- checkmate::makeAssertionFunction(check_file_exists)
 # Model methods & expose_functions helpers ------------------------------------------------------
 get_cmdstan_flags <- function(flag_name) {
   cmdstan_path <- cmdstanr::cmdstan_path()
-  flags <- wsl_compatible_run(
-    command = "make",
-    args = c("-s", paste0("print-", flag_name)),
-    wd = cmdstan_path
-  )$stdout
+  withr::with_envvar(
+    c("HOME" = short_path(Sys.getenv("HOME"))),
+    flags <- wsl_compatible_run(
+      command = "make",
+      args = c("-s", paste0("print-", flag_name)),
+      wd = cmdstan_path
+    )$stdout
+  )
 
   flags <- gsub("\n", "", flags, fixed = TRUE)
 

diff --git a/tests/testthat/test-model-init.R b/tests/testthat/test-model-init.R
@@ -20,7 +20,7 @@ test_that("all fitting methods work with provided init files", {
     mod$optimize(data = data_list, init = init_json_1, seed = 123)
   )
   expect_vb_output(
-    mod$variational(data = data_list, init = init_json_1, seed = 123)
+    mod$variational(data = data_list, init = init_json_1, seed = 1234)
   )
   expect_laplace_output(
     mod$laplace(data = data_list, init = init_json_1, seed = 123)