Add mock for stan cli

Author: katrinabrock

tests/testthat/helper-mock-cli.R

@@ -0,0 +1,54 @@
+real_wcr <- wsl_compatible_run
+
+with_mocked_cli <- function(code, compile_ret, info_ret) {
+  with_mocked_bindings(
+    code,
+    wsl_compatible_run = function(command, args, ...) {
+      if (
+        !is.null(command)
+        && command == "make"
+        && !is.null(args)
+        && startsWith(basename(args[1]), "model-")
+      ) {
+        message("mock-compile-was-called")
+        compile_ret
+      } else if (!is.null(args) && args[1] == "info") {
+        info_ret
+      } else {
+        real_wcr(command = command, args = args, ...)
+      }
+    }
+  )
+}
+
+######## Mock Compile Expectations #######
+
+# These helpers mimic `assert_called` and `assert_not_called` in other languages.
+#
+# Logic
+# `expect_mock_compile`
+#     passes if mock_compile is called (at all, doesn't matter how many times)
+#     fails if mock_compile is never called
+# `expect_no_mock_compile` is the inverse. It
+#      passes if mock_compile is *not* called at all
+#      fails if mock_compile is called (even once)
+#
+# Implementation:
+# `with_mocked_cli`
+#    if a compile is triggered
+#      emits a message with the contents `mock-compile-was-called`
+#      (defined as wsl_compatible_run being called with make model-*)
+# `expect_mock_compile` checks for this message:
+#     passes if it detects such a message
+#     fails if it does not
+# `expect_no_mock_compile`
+#      fails if a message with exactly this text is detected
+#      passes if no such message is detected
+#      messages with any other text does not impact `expect_no_mock_compile`
+
+expect_mock_compile <- function(object, ...) {
+  expect_message(object, regexp = "mock-compile-was-called", ...)
+}
+expect_no_mock_compile <- function(object, ...) {
+  expect_no_message(object, message = "mock-compile-was-called", ...)
+}

tests/testthat/test-model-recompile-logic.R

@@ -0,0 +1,109 @@
+stan_program <- cmdstan_example_file()
+file_that_doesnt_exist <- "placeholder_doesnt_exist"
+file_that_exists <- "placeholder_exists"
+file.create(file_that_exists)
+withr::defer(
+  if (file.exists(file_that_exists)) file.remove(file_that_exists),
+  teardown_env()
+)
+
+skip_message <- "To be fixed in a later version."
+
+test_that("warning when no recompile and no info", {
+  skip(skip_message)
+  with_mocked_cli(
+    compile_ret = list(),
+    info_ret = list(status = 1),
+    code = expect_warning({
+      mod <- cmdstan_model(
+        stan_file = stan_program,
+        exe_file = file_that_exists,
+        compile = FALSE
+      )
+    }, "Recompiling is recommended.")
+  )
+})
+
+test_that("recompiles when force_recompile flag set",
+  with_mocked_cli(
+    compile_ret = list(status = 0),
+    info_ret = list(),
+    code = expect_mock_compile({
+      mod <- cmdstan_model(stan_file = stan_program, force_recompile = TRUE)
+    })
+  )
+)
+
+test_that("no mismatch results in no recompile", with_mocked_cli(
+  compile_ret = list(status = 0),
+  info_ret = list(
+    status = 0,
+    stdout = "
+      stan_version_major = 2
+      stan_version_minor = 35
+      stan_version_patch = 0
+      STAN_THREADS=false
+      STAN_MPI=false
+      STAN_OPENCL=false
+      STAN_NO_RANGE_CHECKS=false
+      STAN_CPP_OPTIMS=false
+    "
+  ),
+  code = expect_no_mock_compile({
+    mod <- cmdstan_model(stan_file = stan_program, exe_file = file_that_exists)
+  })
+))
+
+test_that("mismatch results in recompile.", {
+  skip(skip_message)
+  with_mocked_cli(
+    compile_ret = list(status = 0),
+    info_ret = list(
+      status = 0,
+      stdout =  "
+        stan_version_major = 2
+        stan_version_minor = 35
+        stan_version_patch = 0
+        STAN_THREADS=false
+        STAN_MPI=false
+        STAN_OPENCL=false
+        STAN_NO_RANGE_CHECKS=false
+        STAN_CPP_OPTIMS=false
+      "
+    ),
+    code = expect_mock_compile({
+      mod <- cmdstan_model(
+        stan_file = stan_program,
+        exe_file = file_that_exists,
+        cpp_options = list(stan_threads = TRUE)
+      )
+    })
+  )
+})
+
+test_that("recompile when cpp args don't match binary", {
+  skip(skip_message)
+  with_mocked_cli(
+    compile_ret = list(status = 0),
+    info_ret = list(
+      status = 0,
+      stdout = "
+        stan_version_major = 2
+        stan_version_minor = 38
+        stan_version_patch = 0
+        STAN_THREADS=false
+        STAN_MPI=false
+        STAN_OPENCL=true
+        STAN_NO_RANGE_CHECKS=false
+        STAN_CPP_OPTIMS=false
+      "
+    ),
+    expect_mock_compile({
+      mod_gq <- cmdstan_model(
+        testing_stan_file("bernoulli_ppc"),
+        exe_file = file_that_exists,
+        cpp_options = list(stan_threads = TRUE)
+      )
+    })
+  )
+})