maintain separate direct and Make-quoted stanc options

Author: jgabry

NEWS.md

@@ -2,6 +2,7 @@
 
 * The `CMDSTANR_NO_VER_CHECK` R option and environment variable are deprecated 
 as of CmdStanR 1.0.0; use the lowercase `cmdstanr_no_ver_check` forms instead.
+* `CmdStanModel$compile()` now compiles models with named `stanc_options` values such as `canonicalize`. (#1227)
 * CmdStanModel methods now correctly handle `#include` directories with spaces
 in their paths. (#820)
 * `$include_paths()` now returns absolute paths, and relative include paths are

R/model.R

@@ -710,28 +710,37 @@ compile <- function(quiet = TRUE,
     stanc_options[["name"]] <- paste0(self$model_name(), "_model")
   }
   stanc_built_options <- c()
+  stanc_direct_options <- c()
   for (i in seq_len(length(stanc_options))) {
     option_name <- names(stanc_options)[i]
     if (isTRUE(as.logical(stanc_options[[i]]))) {
-      stanc_built_options <- c(stanc_built_options, paste0("--", option_name))
+      stanc_direct_option <- paste0("--", option_name)
+      stanc_built_option <- stanc_direct_option
     } else if (is.null(option_name) || !nzchar(option_name)) {
-      stanc_built_options <- c(stanc_built_options, paste0("--", stanc_options[[i]]))
+      stanc_direct_option <- paste0("--", stanc_options[[i]])
+      stanc_built_option <- stanc_direct_option
     } else if (option_name == "name") { # Quoting model name mangles generated namespace
-      stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", stanc_options[[i]]))
-    }  else {
-      stanc_built_options <- c(stanc_built_options, paste0("--", option_name, "=", "'", stanc_options[[i]], "'"))
+      stanc_direct_option <- paste0("--", option_name, "=", stanc_options[[i]])
+      stanc_built_option <- stanc_direct_option
+    } else {
+      stanc_direct_option <- paste0("--", option_name, "=", stanc_options[[i]])
+      stanc_built_option <- paste0("--", option_name, "=", "'", stanc_options[[i]], "'")
     }
+    stanc_direct_options <- c(stanc_direct_options, stanc_direct_option)
+    stanc_built_options <- c(stanc_built_options, stanc_built_option)
   }
   stancflags_combined <- stanc_built_options
+  stancflags_direct <- stanc_direct_options
   stancflags_local <- get_cmdstan_flags("STANCFLAGS")
   if (length(stancflags_local) > 0) {
     stancflags_combined <- c(stancflags_combined, stancflags_local)
+    stancflags_direct <- c(stancflags_direct, stancflags_local)
   }
   stanc_inc_paths <- include_paths_stanc3_args(include_paths, direct_call = TRUE)
-  stancflags_standalone <- c("--standalone-functions", stanc_inc_paths, stancflags_combined)
+  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_combined))
+  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
 

R/utils.R

@@ -931,6 +931,7 @@ get_standalone_hpp <- function(stan_file, stancflags) {
   name <- strip_ext(basename(stan_file))
   path <- dirname(stan_file)
   hpp_path <- file.path(path, paste0(name, ".hpp"))
+  on.exit(unlink(hpp_path), add = TRUE)
 
   status <- withr::with_path(
       c(
@@ -944,13 +945,22 @@ get_standalone_hpp <- function(stan_file, stancflags) {
         error_on_status = FALSE
       )
     )
-  if (status$status == 0) {
-    hpp <- suppressWarnings(readLines(hpp_path, warn = FALSE))
-    unlink(hpp_path)
-    hpp
-  } else {
-    invisible(NULL)
+  if (is.null(status$status) || is.na(status$status) || status$status != 0) {
+    if (length(status$stderr) > 0 && nzchar(status$stderr)) {
+      message(status$stderr)
+    }
+    status_code <- if (is.null(status$status) || is.na(status$status)) {
+      "missing"
+    } else {
+      status$status
+    }
+    stop(
+      "stanc exited with status ", status_code, ".\n",
+      "Failed to generate the model C++ header.",
+      call. = FALSE
+    )
   }
+  suppressWarnings(readLines(hpp_path, warn = FALSE))
 }
 
 get_function_name <- function(fun_start, fun_end, model_lines) {

tests/testthat/_snaps/utils.md

@@ -1,3 +1,14 @@
+# get_standalone_hpp() reports stanc failures
+
+    Code
+      get_standalone_hpp(stan_file, "--canonicalize='deprecations'")
+    Message
+      stanc: invalid canonicalize value
+    Condition
+      Error:
+      ! stanc exited with status 124.
+      Failed to generate the model C++ header.
+
 # copy_temp_files retains sources if any copy fails
 
     Code

tests/testthat/test-model-compile.R

@@ -284,7 +284,8 @@ test_that("compile errors are shown", {
   stan_file <- testing_stan_file("fail")
   expect_error(
     cmdstan_model(stan_file),
-    "An error occured during compilation! See the message above for more information."
+    "stanc exited with status 1.\nFailed to generate the model C++ header.",
+    fixed = TRUE
   )
 })
 
@@ -522,7 +523,7 @@ test_that("check_syntax() works with pedantic=TRUE", {
   mod_dep_warning <- cmdstan_model(stan_file, compile = FALSE)
   expect_error(
     mod_dep_warning$compile(),
-    "An error occured during compilation! See the message above for more information.",
+    "stanc exited with status 1.\nFailed to generate the model C++ header.",
     fixed = TRUE
   )
   expect_error(
@@ -984,6 +985,72 @@ test_that("STANCFLAGS from get_cmdstan_flags() are included in compile output",
   expect_output(print(out), out_w_flags)
 })
 
+test_that("compile() passes unquoted named stanc options to direct calls", {
+  stan_file <- testing_stan_file("bernoulli")
+  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))
+      ""
+    }
+  )
+
+  model$compile(
+    stanc_options = list(
+      canonicalize = "deprecations",
+      "filename-in-msg" = "model filename with spaces.stan"
+    ),
+    force_recompile = TRUE,
+    dry_run = TRUE
+  )
+
+  expected <- c(
+    "--canonicalize=deprecations",
+    "--filename-in-msg=model filename with spaces.stan"
+  )
+  direct_options <- lapply(received_stancflags, function(x) {
+    grep("^--(canonicalize|filename-in-msg)=", x, value = TRUE)
+  })
+  expect_length(received_stancflags, 2)
+  expect_equal(direct_options, rep(list(expected), 2))
+  expect_equal(
+    grep("'", unlist(received_stancflags), fixed = TRUE, value = TRUE),
+    character()
+  )
+})
+
+test_that("compile() works with named stanc option values", {
+  stan_file <- write_stan_file(
+    "
+    functions {
+      real half(real x) {
+        return x / 2;
+      }
+    }
+    parameters {
+      real y;
+    }
+    model {
+      y ~ std_normal();
+    }
+    ",
+    dir = withr::local_tempdir(),
+    basename = "issue1227.stan"
+  )
+
+  expect_call_compilation(
+    model <- cmdstan_model(
+      stan_file,
+      stanc_options = list(
+        canonicalize = "deprecations",
+        "filename-in-msg" = "model filename with spaces.stan"
+      )
+    )
+  )
+})
+
 test_that("compile() detects stan_opencl without case or partial matching", {
   stan_file <- testing_stan_file("bernoulli")
   model <- cmdstan_model(stan_file, compile = FALSE)

tests/testthat/test-utils.R

@@ -135,6 +135,32 @@ test_that("cmdstan_diagnose works if bin/diagnose deleted file", {
   expect_output(delete_and_run(), "Checking sampler transitions treedepth")
 })
 
+test_that("get_standalone_hpp() reports stanc failures", {
+  model_dir <- withr::local_tempdir()
+  stan_file <- file.path(model_dir, "model.stan")
+  hpp_file <- file.path(model_dir, "model.hpp")
+  writeLines("parameters { real y; } model { y ~ std_normal(); }", stan_file)
+  writeLines("// partial output", hpp_file)
+  local_mocked_bindings(
+    wsl_compatible_run = function(...) {
+      list(
+        status = 124L,
+        stdout = "",
+        stderr = "stanc: invalid canonicalize value"
+      )
+    }
+  )
+
+  expect_snapshot(
+    error = TRUE,
+    get_standalone_hpp(
+      stan_file,
+      "--canonicalize='deprecations'"
+    )
+  )
+  expect_false(file.exists(hpp_file))
+})
+
 
 # misc --------------------------------------------------------------------