Skip to content

Commit

Permalink
lint
Browse files Browse the repository at this point in the history
  • Loading branch information
@katrinabrock
katrinabrock committed Dec 18, 2024
1 parent f993531 commit 66aa1b4
Show file tree
Hide file tree
Showing 10 changed files with 464 additions and 223 deletions.
208 changes: 150 additions & 58 deletions R/model.R
View file

Large diffs are not rendered by default.

4 changes: 2 additions & 2 deletions R/path.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -234,9 +234,9 @@ unset_cmdstan_path <- function() {
}

# fake a cmdstan version (only used in tests)
fake_cmdstan_version <- function(version, mod=NULL) {
fake_cmdstan_version <- function(version, mod = NULL) {
.cmdstanr$VERSION <- version
if(!is.null(mod)) {
if (!is.null(mod)) {
if (!is.null(mod$.__enclos_env__$private$exe_info_)) {
mod$.__enclos_env__$private$exe_info_$stan_version <- version
}
Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/helper-custom-expectations.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,10 +101,10 @@ expect_noninteractive_silent <- function(object) {
expect_silent(object))
}

expect_equal_ignore_order <- function(object, expected, ...){
expect_equal_ignore_order <- function(object, expected, ...) {
object <- expected[sort(names(object))]
expected <- expected[sort(names(expected))]
expect_equal(object, expected, ...)
}

expect_not_true <- function(...) expect_false(isTRUE(...))
expect_not_true <- function(...) expect_false(isTRUE(...))
27 changes: 18 additions & 9 deletions tests/testthat/helper-mock-cli.R
View file
Original file line number Diff line number Diff line change
@@ -1,19 +1,22 @@
real_wcr <- wsl_compatible_run

with_mocked_cli <- function(code, compile_ret, info_ret){
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'
&& command == "make"
&& !is.null(args)
&& startsWith(basename(args[1]), 'model-')
&& 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, ...)
} else if (!is.null(args) && args[1] == "info") {
info_ret
} else {
real_wcr(command = command, args = args, ...)
}
}
)
}
Expand All @@ -31,15 +34,21 @@ with_mocked_cli <- function(code, compile_ret, info_ret){
# fails if mock_compile is called (even once)
#
# Implementation:
# `with_mocked_cli` emits a message with the contents `mock-compile-was-called` if a compile is triggered
# `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
# 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' , ...)
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", ...)
}
247 changes: 154 additions & 93 deletions tests/testthat/test-model-compile-user_header.R
View file
Original file line number Diff line number Diff line change
@@ -1,14 +1,21 @@

file_that_exists <- 'placeholder_exists'
file_that_doesnt_exist <- 'placeholder_doesnt_exist'
file_that_exists <- "placeholder_exists"
file_that_doesnt_exist <- "placeholder_doesnt_exist"
file.create(file_that_exists)
on.exit(if(file.exists(file_that_exists)) file.remove(file_that_exists), add=TRUE, after=FALSE)
on.exit(
if (file.exists(file_that_exists)) file.remove(file_that_exists),
add = TRUE,
after = FALSE
)

make_local_orig <- cmdstan_make_local()
cmdstan_make_local(cpp_options = list("PRECOMPILED_HEADERS"="false"))
on.exit(cmdstan_make_local(cpp_options = make_local_orig, append = FALSE), add = TRUE, after = FALSE)
hpp <-
"
cmdstan_make_local(cpp_options = list("PRECOMPILED_HEADERS" = "false"))
on.exit(
cmdstan_make_local(cpp_options = make_local_orig, append = FALSE),
add = TRUE,
after = FALSE
)
hpp <- "
#include <stan/math.hpp>
#include <boost/math/tools/promotion.hpp>
#include <ostream>
Expand All @@ -17,9 +24,10 @@ 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__)
inline typename boost::math::tools::promote_args<T0__>::type make_odds(
const T0__ & theta,
std::ostream *pstream__
)
{
return theta / (1 - theta);
}
Expand All @@ -30,77 +38,112 @@ test_that("cmdstan_model works with user_header with mock", {
tmpfile <- tempfile(fileext = ".hpp")
cat(hpp, file = tmpfile, sep = "\n")

with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_mock_compile(
expect_warning(
expect_no_warning({
mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
exe_file = file_that_exists,
user_header = tmpfile
)
}, message = 'Recompiling is recommended'), # this warning should not occur because recompile happens automatically
'Retrieving exe_file info failed' # this warning should occur
)
))

with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_mock_compile({
mod_2 <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
exe_file = file_that_doesnt_exist,
cpp_options=list(USER_HEADER=tmpfile),
stanc_options = list("allow-undefined")
with_mocked_cli(
compile_ret = list(status = 0),
info_ret = list(),
code = expect_mock_compile(
expect_warning(
expect_no_warning({
mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
exe_file = file_that_exists,
user_header = tmpfile
)
}, message = "Recompiling is recommended"),
# ^ this warning should not occur because recompile happens automatically
"Retrieving exe_file info failed"
# ^ this warning should occur
)
)
}))
)

with_mocked_cli(
compile_ret = list(status = 0),
info_ret = list(),
code = expect_mock_compile({
mod_2 <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
exe_file = file_that_doesnt_exist,
cpp_options = list(USER_HEADER = tmpfile),
stanc_options = list("allow-undefined")
)
})
)

# Check recompilation upon changing header
file.create(file_that_exists)
with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_no_mock_compile({
mod$compile(quiet = TRUE, user_header = tmpfile)
}))
with_mocked_cli(
compile_ret = list(status = 0),
info_ret = list(),
code = expect_no_mock_compile({
mod$compile(quiet = TRUE, user_header = tmpfile)
})
)

Sys.setFileTime(tmpfile, Sys.time() + 1) # touch file to trigger recompile
with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_mock_compile({
mod$compile(quiet = TRUE, user_header = tmpfile)
}))
with_mocked_cli(
compile_ret = list(status = 0),
info_ret = list(),
code = expect_mock_compile({
mod$compile(quiet = TRUE, user_header = tmpfile)
})
)

# mock does not automatically update file mtime
Sys.setFileTime(mod$exe_file(), Sys.time() + 1) # touch file to trigger recompile

# Alternative spec of user header
with_mocked_cli(compile_ret = list(status = 0), info_ret = list(), code = expect_no_mock_compile({
mod$compile(
quiet = TRUE,
cpp_options = list(user_header = tmpfile),
dry_run = TRUE
)}))
with_mocked_cli(
compile_ret = list(status = 0),
info_ret = list(),
code = expect_no_mock_compile({
mod$compile(
quiet = TRUE,
cpp_options = list(user_header = tmpfile),
dry_run = TRUE
)
})
)

# Error/warning messages
with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = 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"
))

with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = 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"
))
with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = 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"
))
with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = 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"
)
)

with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = 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"
)
)
with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = 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("user_header precedence order is correct", {
Expand All @@ -112,35 +155,53 @@ test_that("user_header precedence order is correct", {
add = TRUE
)

with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = expect_warning(
{mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
user_header = tmp_files[[1]],
cpp_options = list(USER_HEADER = tmp_files[[2]], user_header = tmp_files[[3]]),
dry_run = TRUE
)},
"User header specified both"
))
with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = expect_warning({
mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
user_header = tmp_files[[1]],
cpp_options = list(
USER_HEADER = tmp_files[[2]],
user_header = tmp_files[[3]]
),
dry_run = TRUE
)
}, "User header specified both")
)
expect_equal(mod$precompile_cpp_options()$user_header, tmp_files[[1]])

with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = expect_warning(
{mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
cpp_options = list(USER_HEADER = tmp_files[[2]], user_header = tmp_files[[3]]),
dry_run = TRUE
)},
"User header specified both"
))
with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = expect_warning({
mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
cpp_options = list(
USER_HEADER = tmp_files[[2]],
user_header = tmp_files[[3]]
),
dry_run = TRUE
)
}, "User header specified both")
)
expect_equal(mod$precompile_cpp_options()$user_header, tmp_files[[2]])

with_mocked_cli(compile_ret = list(status = 1), info_ret = list(), code = expect_warning(
{mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
cpp_options = list(user_header = tmp_files[[3]], USER_HEADER = tmp_files[[2]] ),
dry_run = TRUE
)},
"User header specified both"
))
with_mocked_cli(
compile_ret = list(status = 1),
info_ret = list(),
code = expect_warning({
mod <- cmdstan_model(
stan_file = testing_stan_file("bernoulli_external"),
cpp_options = list(
user_header = tmp_files[[3]],
USER_HEADER = tmp_files[[2]]
),
dry_run = TRUE
)
}, "User header specified both")
)
expect_equal(mod$precompile_cpp_options()$user_header, tmp_files[[3]])

})
Loading

0 comments on commit 66aa1b4

Please sign in to comment.