tests/testthat/test-model-compile.R

context("model-compile")

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))
  expect_error(
    mod$hpp_file(),
    "The .hpp file does not exists. Please (re)compile the model.",
    fixed = TRUE
  )
})

test_that("error if no compile() before model fitting", {
  expect_error(
    mod$sample(),
    "Model not compiled. Try running the compile() method first.",
    fixed = TRUE
  )
})

test_that("compile() method works", {
  # remove executable if exists
  exe <- cmdstan_ext(strip_ext(mod$stan_file()))
  if (file.exists(exe)) {
    file.remove(exe)
  }
  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)
  out <- utils::capture.output(mod$compile(quiet = FALSE))
  expect_output(print(out), "Translating Stan model")
})

test_that("compile() method forces recompilation force_recompile = TRUE", {
  mod$compile(quiet = TRUE)
  expect_compilation(mod, quiet = TRUE, force_recompile = TRUE)
})

test_that("compile() method forces recompilation if model modified", {
  # remove executable if exists
  exe <- cmdstan_ext(strip_ext(mod$stan_file()))
  if (!file.exists(exe)) {
    mod$compile(quiet = TRUE)
  }
  Sys.setFileTime(mod$stan_file(), Sys.time() + 1) #touch file to trigger recompile
  expect_compilation(mod, quiet = TRUE)
})

test_that("compile() method works with spaces in path", {
  stan_file <- testing_stan_file("bernoulli")
  stan_model_with_spaces <- testing_stan_file("folder spaces/bernoulli spaces")

  dir_with_spaces <- test_path("resources", "stan", "folder spaces")
  if (!file.exists(dir_with_spaces)) {
    dir.create(dir_with_spaces)
  }
  file.copy(stan_file, stan_model_with_spaces)

  mod_spaces <- cmdstan_model(stan_file = stan_model_with_spaces, compile = FALSE)
  exe <- cmdstan_ext(strip_ext(mod_spaces$stan_file()))
  if (file.exists(exe)) {
    file.remove(exe)
  }
  expect_compilation(mod_spaces)
  file.remove(stan_model_with_spaces)
  file.remove(exe)
  unlink(dir_with_spaces, recursive = TRUE)
})

test_that("compile() method overwrites binaries", {
  mod$compile(quiet = TRUE)
  old_time = file.mtime(mod$exe_file())
  mod$compile(quiet = TRUE, force_recompile = TRUE)
  new_time =
  expect_gt(file.mtime(mod$exe_file()), old_time)
})

test_that("compilation works with include_paths", {
  stan_program_w_include <- testing_stan_file("bernoulli_include")
  exe <- cmdstan_ext(strip_ext(stan_program_w_include))
  if(file.exists(exe)) {
    file.remove(exe)
  }
  expect_error(
    cmdstan_model(stan_file = stan_program_w_include, include_paths = "NOT_A_DIR",
                  quiet = TRUE),
    "Directory 'NOT_A_DIR' does not exist"
  )

  expect_error(
    expect_output(
      cmdstan_model(stan_file = stan_program_w_include, quiet = TRUE),
      "could not find include file"
    )
  )

  expect_call_compilation(
    mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, quiet = TRUE,
                                   include_paths = test_path("resources", "stan"),
                                   force_recompile = TRUE)
  )
  expect_equal(
    mod_w_include$exe_file(),
    cmdstan_ext(strip_ext(absolute_path(stan_program_w_include)))
  )
})

test_that("name in STANCFLAGS is set correctly", {
  out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE))
  if(os_is_windows() && !os_is_wsl()) {
    out_no_name <- "bin/stanc.exe --name='bernoulli_model' --o"
    out_name <- "bin/stanc.exe --name='bernoulli2_model' --o"
  } else {
    out_no_name <- "bin/stanc --name='bernoulli_model' --o"
    out_name <- "bin/stanc --name='bernoulli2_model' --o"
  }
  expect_output(print(out), out_no_name)
  out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE, stanc_options = list(name = "bernoulli2_model")))
  expect_output(print(out), out_name)
})


test_that("switching threads on and off works without rebuild", {
  main_path_o <- file.path(cmdstan_path(), "src", "cmdstan", "main.o")
  main_path_threads_o <- file.path(cmdstan_path(), "src", "cmdstan", "main_threads.o")
  if (file.exists(main_path_threads_o)) {
    file.remove(main_path_threads_o)
  }
  mod$compile(force_recompile = TRUE)

  before_mtime <- file.mtime(main_path_o)
  mod$compile(force_recompile = TRUE)
  after_mtime <- file.mtime(main_path_o)
  expect_equal(before_mtime, after_mtime)
  expect_false(file.exists(main_path_threads_o))

  mod$compile(force_recompile = TRUE, cpp_options = list(stan_threads = TRUE))
  checkmate::expect_file_exists(main_path_threads_o)

  before_mtime <- file.mtime(main_path_o)
  mod$compile(force_recompile = TRUE, cpp_options = list(stan_threads = TRUE))
  after_mtime <- file.mtime(main_path_o)
  expect_equal(before_mtime, after_mtime)

  before_mtime <- file.mtime(main_path_o)
  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", {
  stan_file <- testing_stan_file("bernoulli")
  expect_call_compilation(
    mod <- cmdstan_model(stan_file, cpp_options = list("DUMMY_TEST2"="1", "DUMMY_TEST2"="1",  "DUMMY_TEST3"="1"), force_recompile = TRUE)
  )
  expect_compilation(mod, cpp_options = list("DUMMY_TEST2"="1", "DUMMY_TEST2"="1",  "DUMMY_TEST3"="1"), force_recompile = TRUE)
  expect_compilation(mod, cpp_options = list(), force_recompile = TRUE)
})

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."
  )
})

test_that("dir arg works for cmdstan_model and $compile()", {
  tmp_dir <- tempdir()
  tmp_dir_2 <- tempdir()

  mod_dir <- cmdstan_model(stan_program, dir = tmp_dir)
  expect_equal(repair_path(dirname(mod_dir$exe_file())), repair_path(tmp_dir))
  checkmate::expect_file_exists(mod_dir$exe_file())
  file.remove(mod_dir$exe_file())

  mod_dir_1 <- cmdstan_model(stan_program, dir = tmp_dir, compile = FALSE)
  mod_dir_1$compile(dry_run = TRUE)
  expect_equal(repair_path(dirname(mod_dir_1$exe_file())), repair_path(tmp_dir))

  mod_dir_1$compile(dir = tmp_dir_2, dry_run = TRUE) #dir in compile overwrites dir in cmdstan_model
  expect_equal(repair_path(dirname(mod_dir_1$exe_file())), repair_path(tmp_dir))

  mod_dir_2 <- cmdstan_model(stan_program, compile = FALSE)
  mod_dir_2$compile(dir = tmp_dir, dry_run = TRUE)
  expect_equal(repair_path(dirname(mod_dir_2$exe_file())), repair_path(tmp_dir))

  mod_dir_3 <- cmdstan_model(stan_program)
  mod_dir_3$compile(dir = tmp_dir, dry_run = TRUE) #dir in compile overwrites dir in cmdstan_model
  expect_equal(repair_path(dirname(mod_dir_3$exe_file())), repair_path(tmp_dir))

  expect_error(
    cmdstan_model(stan_program, dir = "ABCD"),
    "Assertion on 'dir' failed"
  )
})

test_that("compiling stops on hyphens in stanc_options", {
  hyphens <- list("--allow-undefined")
  hyphens2 <- list("--allow-undefined" = TRUE)
  hyphens3 <- list("--o" = "something")
  stan_file <- testing_stan_file("bernoulli")
  expect_error(
    cmdstan_model(stan_file, stanc_options = hyphens, compile = FALSE),
    "No leading hyphens allowed in stanc options (--allow-undefined). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
  expect_error(
    cmdstan_model(stan_file, stanc_options = hyphens2, compile = FALSE),
    "No leading hyphens allowed in stanc options (--allow-undefined). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
  expect_error(
    cmdstan_model(stan_file, stanc_options = hyphens3, compile = FALSE),
    "No leading hyphens allowed in stanc options (--o). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
  mod <- cmdstan_model(stan_file, compile = FALSE)
  expect_error(
    mod$compile(stanc_options = hyphens),
    "No leading hyphens allowed in stanc options (--allow-undefined). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
  expect_error(
    mod$compile(stanc_options = hyphens2),
    "No leading hyphens allowed in stanc options (--allow-undefined). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
  expect_error(
    mod$compile(stanc_options = hyphens3),
    "No leading hyphens allowed in stanc options (--o). Use options without leading hyphens, for example `stanc_options = list('allow-undefined')`",
    fixed = TRUE
  )
})

test_that("compiling works with only names in list", {
  stan_file <- testing_stan_file("bernoulli")
  expect_call_compilation(mod <- cmdstan_model(stan_file, stanc_options = list("warn-pedantic"), force_recompile = TRUE))
  checkmate::expect_r6(
    mod,
    "CmdStanModel"
  )
})

test_that("compile() works with pedantic=TRUE", {
  stan_file <- write_stan_file("
  parameters {
    real y;
    real x;
  }
  model {
    y ~ std_normal();
  }
  ")
  expect_message(
    mod_pedantic_warn <- cmdstan_model(stan_file, pedantic = TRUE, force_recompile = TRUE),
    "The parameter x was declared but was not used",
    fixed = TRUE
  )
})

test_that("*hpp_file() functions work", {
  tmp_dir <- tempdir()
  stan_file <- testing_stan_file("bernoulli")
  expect_call_compilation(mod <- cmdstan_model(stan_file, force_recompile = TRUE))
  checkmate::expect_file_exists(mod$hpp_file())
  expect_match(paste0(readLines(mod$hpp_file(), warn = FALSE), collapse = "\n"), "Code generated by stanc", fixed = TRUE)
  mod$save_hpp_file()
  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"))
  mod$compile(force_recompile = TRUE, dry_run = 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"))))
})

test_that("check_syntax() works", {
  stan_file <- testing_stan_file("fail")
  mod_fail <- cmdstan_model(stan_file, compile = FALSE)
  expect_error(
    expect_message(
      mod_fail$check_syntax(),
      "Ill-typed arguments supplied to assignment operator"
    ),
    "Syntax error found! See the message above for more information."
  )

  stan_file <- testing_stan_file("bernoulli")
  mod_ok <- cmdstan_model(stan_file, compile = FALSE)
  expect_true(
    expect_message(
      mod_ok$check_syntax(),
      "Stan program is syntactically correct"
    )
  )
  expect_message(
    mod_ok$check_syntax(quiet = TRUE),
    regexp = NA
  )
  expect_message(
    mod_ok$check_syntax(stanc_options = list("allow-undefined", "warn-pedantic")),
    "Stan program is syntactically correct",
    fixed = TRUE
  )
  expect_message(
    mod_ok$check_syntax(stanc_options = list("allow-undefined", "warn-pedantic"), quiet = TRUE),
    regexp = NA
  )

  code <- "
  parameters {
    real y;
  }
  model {
    y ~ std_normal();
  }
  "
  stan_file_tmp <- write_stan_file(code)
  mod_removed_stan_file <- cmdstan_model(stan_file_tmp)
  file.remove(stan_file_tmp)
  expect_error(
    mod_removed_stan_file$check_syntax(),
    "The Stan file used to create the `CmdStanModel` object does not exist.",
    fixed = TRUE
  )
  mod_exe <- cmdstan_model(exe_file = mod_removed_stan_file$exe_file())
  expect_error(
    mod_exe$check_syntax(),
    "'$check_syntax()' cannot be used because the 'CmdStanModel' was not created with a Stan file.",
    fixed = TRUE
  )

})

test_that("check_syntax() works with pedantic=TRUE", {
  model_code <- "
  parameters {
    real y;
    real x;
  }
  model {
    y ~ std_normal();
  }
  "
  stan_file <- write_stan_file(model_code)
  mod_pedantic_warn <- cmdstan_model(stan_file, compile = FALSE)
  expect_message(
    mod_pedantic_warn$check_syntax(),
    "Stan program is syntactically correct"
  )

  expect_message(
    mod_pedantic_warn$check_syntax(pedantic = TRUE),
    "The parameter x was declared but was not used",
    fixed = TRUE
  )

  # should also still work if specified via stanc_options
  expect_message(
    mod_pedantic_warn$check_syntax(stanc_options = list("warn-pedantic" = TRUE)),
    "The parameter x was declared but was not used",
    fixed = TRUE
  )

  expect_message(
    mod_pedantic_warn$check_syntax(pedantic = TRUE),
    "The parameter x was declared but was not used",
    fixed = TRUE
  )
})

test_that("check_syntax() works with include_paths", {
  stan_program_w_include <- testing_stan_file("bernoulli_include")

  mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=FALSE,
                                   include_paths = test_path("resources", "stan"))
  expect_true(mod_w_include$check_syntax())

})

test_that("check_syntax() works with include_paths on compiled model", {
  stan_program_w_include <- testing_stan_file("bernoulli_include")

  mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE,
                                 include_paths = test_path("resources", "stan"))
  expect_true(mod_w_include$check_syntax())

})

test_that("check_syntax() works with pedantic=TRUE", {
  model_code <- "
  transformed data {
    real a;
    a <- 3;
  }
  "
  stan_file <- write_stan_file(model_code)
  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.",
    fixed = TRUE
  )
  expect_error(
    mod_dep_warning$check_syntax(),
    "Syntax error found! See the message above for more information.",
    fixed = TRUE
  )
})

test_that("compiliation errors if folder with the model name exists", {
  skip_if(os_is_windows() && !os_is_wsl())
  model_code <- "
  parameters {
    real y;
  }
  model {
    y ~ std_normal();
  }
  "
  stan_file <- write_stan_file(model_code)
  exe <- strip_ext(stan_file)
  if (!dir.exists(exe)) {
    if (file.exists(exe)) {
      file.remove(exe)
    }
    dir.create(exe)
  }
  expect_error(
    cmdstan_model(stan_file),
    "There is a subfolder matching the model name in the same folder as the model! Please remove or rename the subfolder and try again."
  )
  unlink(exe, recursive = TRUE)
})

test_that("cpp_options_to_compile_flags() works", {
  options = list(
    stan_threads = TRUE
  )
  expect_equal(cpp_options_to_compile_flags(options), "STAN_THREADS=TRUE")
  options = list(
    stan_threads = TRUE,
    stanc2 = TRUE
  )
  expect_equal(cpp_options_to_compile_flags(options), c("STAN_THREADS=TRUE", "STANC2=TRUE"))
  options = list()
  expect_equal(cpp_options_to_compile_flags(options), NULL)
})

test_that("include_paths_stanc3_args() works", {
  expect_equal(include_paths_stanc3_args(), NULL)
  path_1 <- file.path(tempdir(), "folder1")
  if (!dir.exists(path_1)) {
    dir.create(path_1)
  }
  path_1 <- repair_path(path_1)
  path_1_compare <- ifelse(os_is_wsl(), wsl_safe_path(path_1), path_1)
  expect_equal(
    include_paths_stanc3_args(path_1),
    paste0("--include-paths=", path_1_compare))
  path_2 <- file.path(tempdir(), "folder2")
  if (!dir.exists(path_2)) {
    dir.create(path_2)
  }
  path_2 <- repair_path(path_2)
  path_2_compare <- ifelse(os_is_wsl(), wsl_safe_path(path_2), path_2)
  expect_equal(
    include_paths_stanc3_args(c(path_1, path_2)),
    c(
      paste0("--include-paths=", path_1_compare, ",", path_2_compare)
    )
  )
})

test_that("cpp_options work with settings in make/local", {
  backup <- cmdstan_make_local()

  if (length(mod$exe_file()) > 0 && file.exists(mod$exe_file())) {
    file.remove(mod$exe_file())
  }

  cmdstan_make_local(cpp_options = list(), append = TRUE)
  rebuild_cmdstan()
  mod <- cmdstan_model(stan_file = stan_program)
  expect_null(mod$cpp_options()$STAN_THREADS)

  file.remove(mod$exe_file())

  cmdstan_make_local(cpp_options = backup, append = FALSE)
  cmdstan_make_local(cpp_options = list(stan_threads = TRUE), append = TRUE)

  file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan")
  mod <- cmdstan_model(file)
  expect_true(mod$cpp_options()$STAN_THREADS)

  file.remove(mod$exe_file())

  # restore
  cmdstan_make_local(cpp_options = backup, append = FALSE)
})

test_that("cmdstan_model works with exe_file", {
  stan_file <- testing_stan_file("bernoulli")
  mod <- cmdstan_model(stan_file, dry_run = TRUE)
  default_exe_file <- mod$exe_file()
  if(file.exists(mod$exe_file())) {
    file.remove(mod$exe_file())
  }

  tmp_exe_file <- tempfile(fileext = cmdstan_ext())
  mod <- cmdstan_model(
    stan_file = stan_file,
    exe_file = tmp_exe_file
  )
  expect_match(
    mod$exe_file(),
    repair_path(tmp_exe_file)
  )
  expect_true(file.exists(mod$exe_file()))
  expect_false(file.exists(default_exe_file))

  mod <- cmdstan_model(
    exe_file = tmp_exe_file,
    dry_run = TRUE
  )
  expect_match(
    mod$exe_file(),
    repair_path(tmp_exe_file)
  )
})

test_that("cmdstan_model errors if exe_file specified and version less than 2.27", {
  fake_cmdstan_version("2.26.0")
  expect_error(
    cmdstan_model(exe_file = "foo"),
    "'exe_file' argument is only supported with CmdStan 2.27 and newer"
  )
  reset_cmdstan_version()
})

test_that("cmdstan_model created only with exe_file errors for check_syntax, code, ... ", {
  mod <- testing_model("bernoulli")
  mod_exe <- cmdstan_model(exe_file = mod$exe_file())
  expect_error(
    mod_exe$check_syntax(),
    "'$check_syntax()' cannot be used because the 'CmdStanModel' was not created with a Stan file.",
    fixed = TRUE
  )
  expect_error(
    mod_exe$variables(),
    "'$variables()' cannot be used because the 'CmdStanModel' was not created with a Stan file.",
    fixed = TRUE
  )
  expect_error(
    mod_exe$compile(),
    "'$compile()' cannot be used because the 'CmdStanModel' was not created with a Stan file.",
    fixed = TRUE
  )
})

test_that("cmdstan_model errors with no args ", {
  expect_error(
    cmdstan_model(),
    "Unable to create a `CmdStanModel` object. Both 'stan_file' and 'exe_file' are undefined.",
    fixed = TRUE
  )
})

test_that("cmdstan_model works with user_header", {
  skip_if(os_is_macos())
  tmpfile <- tempfile(fileext = ".hpp")
  hpp <-
  "
  #include <stan/math.hpp>
  #include <boost/math/tools/promotion.hpp>
  #include <ostream>

  namespace bernoulli_external_model_namespace
  {
      template <typename T0__,
            stan::require_all_t<stan::is_stan_scalar<T0__>>* = nullptr>
      inline typename boost::math::tools::promote_args<T0__>::type make_odds(const T0__ &
                                                                                 theta,
                                                                             std::ostream *pstream__)
      {
          return theta / (1 - theta);
      }
  }"
  cat(hpp, file = tmpfile, sep = "\n")
  expect_call_compilation(
    mod <- cmdstan_model(
      stan_file = testing_stan_file("bernoulli_external"),
      user_header = tmpfile
  ))
  file.remove(mod$exe_file())

  expect_call_compilation(
    mod_2 <- cmdstan_model(
      stan_file = testing_stan_file("bernoulli_external"),
      cpp_options=list(USER_HEADER=tmpfile),
      stanc_options = list("allow-undefined")
    )
  )

  # 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 ", {
  file <- file.path(cmdstan_path(), "examples", "bernoulli", "bernoulli.stan")
  cpp_options <- list(
    "CXXFLAGS_OPTIM += -Dsomething_not_used"
  )
  withr::with_options(list("cmdstanr_verbose" = TRUE),
    out <- utils::capture.output(
      mod <- cmdstan_model(file, cpp_options = cpp_options, force_recompile = TRUE)
    )
  )
  expect_output(print(out), "-Dsomething_not_used")
})

test_that("format() works", {
  code <- "
  parameters {
    real y;
  }
  model {
  target +=         normal_log(y, 0, 1);
  }
  "
  stan_file_tmp <- write_stan_file(code)
  mod_1 <- cmdstan_model(stan_file_tmp, compile = FALSE)

  expect_error(
    mod_1$format(),
    "Syntax error found! See the message above for more information.",
    fixed = TRUE
  )

  expect_error(
    mod_1$format(),
    "Syntax error found! See the message above for more information.",
    fixed = TRUE
  )

  stan_file <- testing_stan_file("bernoulli_external")
  mod_2 <- cmdstan_model(stan_file, compile = FALSE, stanc_options = list("allow-undefined"))
  expect_output(
    mod_2$format(),
    "make_odds(theta);",
    fixed = TRUE
  )
  mod_3 <- cmdstan_model(
    stan_file,
    compile = FALSE,
    stanc_options = list("allow-undefined", "warn-pedantic")
  )
  expect_output(
    expect_message(
      mod_2$format(),
      regexp = NA
    ),
    "make_odds(theta);",
    fixed = TRUE
  )

  code <- "
  parameters {
    real y;
  }
  model {
    y ~ std_normal();
  }
  "
  stan_file_tmp <- write_stan_file(code)
  mod_removed_stan_file <- cmdstan_model(stan_file_tmp)
  file.remove(stan_file_tmp)
  expect_error(
    mod_removed_stan_file$format(),
    "The Stan file used to create the `CmdStanModel` object does not exist.",
    fixed = TRUE
  )
  mod_exe <- cmdstan_model(exe_file = mod_removed_stan_file$exe_file())
  expect_error(
    mod_exe$format(),
    "'$format()' cannot be used because the 'CmdStanModel' was not created with a Stan file.",
    fixed = TRUE
  )
})

test_that("format() works with include_paths", {
  stan_program_w_include <- testing_stan_file("bernoulli_include")

  mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=FALSE,
                                   include_paths = test_path("resources", "stan"))
  expect_output(
    mod_w_include$format(),
    "#include ",
    fixed = TRUE
  )
  expect_output(
    mod_w_include$format(canonicalize = list('deprecations', 'parentheses', 'braces')),
    "#include ",
    fixed = TRUE
  )
    expect_output(
    mod_w_include$format(canonicalize = list('includes')),
    "real divide_real_by_two",
    fixed = TRUE
  )
})

test_that("format() works with include_paths on compiled model", {
  stan_program_w_include <- testing_stan_file("bernoulli_include")

  mod_w_include <- cmdstan_model(stan_file = stan_program_w_include, compile=TRUE,
                                 include_paths = test_path("resources", "stan"))
  expect_output(
    mod_w_include$format(),
    "#include ",
    fixed = TRUE
  )
  expect_output(
    mod_w_include$format(canonicalize = list('deprecations', 'parentheses', 'braces')),
    "#include ",
    fixed = TRUE
  )
  expect_output(
    mod_w_include$format(canonicalize = list('includes')),
    "real divide_real_by_two",
    fixed = TRUE
  )
})

test_that("overwrite_file works with format()", {
  code <- "
  parameters {
    real y;
  }
  model {
  target +=         normal_lpdf(y| 0, 5);
  }
  "
  stan_file_tmp <- write_stan_file(code)
  mod_1 <- cmdstan_model(stan_file_tmp, compile = FALSE)
  expect_false(
    any(
      grepl(paste0(basename(mod_1$stan_file()), ".bak"),
            list.files(dirname(mod_1$stan_file()))
      )
    )
  )
  mod_1$format(overwrite_file = TRUE, backup = FALSE)
  expect_false(
    any(
      grepl(paste0(basename(mod_1$stan_file()), ".bak"),
            list.files(dirname(mod_1$stan_file()))
      )
    )
  )
  mod_1$format(overwrite_file = TRUE, backup = TRUE)
  expect_true(
    any(
      grepl(paste0(basename(mod_1$stan_file()), ".bak"),
            list.files(dirname(mod_1$stan_file()))
      )
    )
  )
})

test_that("dirname of stan_file is used as include path if no other paths supplied", {
  data_code <- "
  data {
    int N;
  }
  "

  model_code <- "
  #include separate_file.stan
  parameters {
    vector[N] y;
  }
  model {
    y ~ std_normal();
  }
  "
  tmpdir <- tempdir()
  stan_data_file <- write_stan_file(data_code, basename = "separate_file.stan", dir = tmpdir)
  stan_file <- write_stan_file(model_code, dir = tmpdir)

  mod_tmp <- cmdstan_model(stan_file, compile = FALSE)
  expect_true(mod_tmp$check_syntax())
  expect_true(mod_tmp$format())
  expect_s3_class(mod_tmp$compile(), "CmdStanModel")
})

test_that("STANCFLAGS included from make/local", {
  make_local_old <- cmdstan_make_local()
  cmdstan_make_local(cpp_options = "STANCFLAGS += --O1", append = TRUE)
  out <- utils::capture.output(mod$compile(quiet = FALSE, force_recompile = TRUE))
  if(os_is_windows() && !os_is_wsl()) {
    out_w_flags <- "bin/stanc.exe --name='bernoulli_model'  --O1 --o"
  } else {
    out_w_flags <- "bin/stanc --name='bernoulli_model'  --O1 --o"
  }
  expect_output(print(out), out_w_flags)
  cmdstan_make_local(cpp_options = make_local_old, append = FALSE)
})
stan-dev/cmdstanr documentation built on May 16, 2024, 12:58 a.m.