Skip to content

Commit 50b6e8d

Browse files
jgabryjgabry
authored
Merge pull request #1084 from katrinabrock/add-tests
Add user_header tests, minor changes to opencl tests
2 parents 68b5862 + cc6ec50 commit 50b6e8d

File tree

3 files changed

+335
-11
lines changed

3 files changed

+335
-11
lines changed

‎tests/testthat/test-example.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
context("cmdstanr_example")
22

33
test_that("cmdstanr_example works", {
4-
fit_mcmc <- cmdstanr_example("logistic", chains = 2)
4+
fit_mcmc <- cmdstanr_example("logistic", chains = 2, force_recompile = TRUE)
55
checkmate::expect_r6(fit_mcmc, "CmdStanMCMC")
66
expect_equal(fit_mcmc$num_chains(), 2)
77

‎tests/testthat/test-model-compile-user_header.R

Lines changed: 292 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,292 @@
1+
skip_if(os_is_macos())
2+
3+
file_that_exists <- "placeholder_exists"
4+
file_that_doesnt_exist <- "placeholder_doesnt_exist"
5+
withr::local_file(file_that_exists)
6+
7+
w_path <- function(f) {
8+
x <- sapply(f, function(fi) wsl_safe_path(absolute_path(fi)))
9+
names(x) <- NULL
10+
x
11+
}
12+
13+
make_local_orig <- cmdstan_make_local()
14+
cmdstan_make_local(cpp_options = list("PRECOMPILED_HEADERS" = "false"))
15+
16+
withr::defer(
17+
cmdstan_make_local(cpp_options = make_local_orig, append = FALSE)
18+
)
19+
20+
hpp <- "
21+
#include <stan/math.hpp>
22+
#include <boost/math/tools/promotion.hpp>
23+
#include <ostream>
24+
25+
namespace bernoulli_external_model_namespace
26+
{
27+
template <typename T0__,
28+
stan::require_all_t<stan::is_stan_scalar<T0__>>* = nullptr>
29+
inline typename boost::math::tools::promote_args<T0__>::type make_odds(
30+
const T0__ & theta,
31+
std::ostream *pstream__
32+
)
33+
{
34+
return theta / (1 - theta);
35+
}
36+
}"
37+
38+
test_that("cmdstan_model works with user_header with mock", {
39+
tmpfile <- withr::local_tempfile(lines = hpp, fileext = ".hpp")
40+
41+
with_mocked_cli(
42+
compile_ret = list(status = 0),
43+
info_ret = list(),
44+
code = expect_mock_compile(
45+
mod <- cmdstan_model(
46+
stan_file = testing_stan_file("bernoulli_external"),
47+
exe_file = file_that_exists,
48+
user_header = tmpfile
49+
)
50+
)
51+
)
52+
53+
with_mocked_cli(
54+
compile_ret = list(status = 0),
55+
info_ret = list(),
56+
code = expect_mock_compile({
57+
mod_2 <- cmdstan_model(
58+
stan_file = testing_stan_file("bernoulli_external"),
59+
exe_file = file_that_doesnt_exist,
60+
cpp_options = list(USER_HEADER = tmpfile),
61+
stanc_options = list("allow-undefined")
62+
)
63+
})
64+
)
65+
66+
# Check recompilation upon changing header
67+
file.create(file_that_exists)
68+
with_mocked_cli(
69+
compile_ret = list(status = 0),
70+
info_ret = list(),
71+
code = expect_no_mock_compile({
72+
mod$compile(quiet = TRUE, user_header = tmpfile)
73+
})
74+
)
75+
76+
Sys.setFileTime(tmpfile, Sys.time() + 1) # touch file to trigger recompile
77+
with_mocked_cli(
78+
compile_ret = list(status = 0),
79+
info_ret = list(),
80+
code = expect_mock_compile({
81+
mod$compile(quiet = TRUE, user_header = tmpfile)
82+
})
83+
)
84+
85+
# mock does not automatically update file mtime
86+
Sys.setFileTime(mod$exe_file(), Sys.time() + 1) # touch file to trigger recompile
87+
88+
# Alternative spec of user header
89+
with_mocked_cli(
90+
compile_ret = list(status = 0),
91+
info_ret = list(),
92+
code = expect_no_mock_compile({
93+
mod$compile(
94+
quiet = TRUE,
95+
cpp_options = list(user_header = tmpfile),
96+
dry_run = TRUE
97+
)
98+
})
99+
)
100+
101+
# Error/warning messages
102+
with_mocked_cli(
103+
compile_ret = list(status = 1),
104+
info_ret = list(),
105+
code = expect_error(
106+
cmdstan_model(
107+
stan_file = testing_stan_file("bernoulli_external"),
108+
cpp_options = list(USER_HEADER = "non_existent.hpp"),
109+
stanc_options = list("allow-undefined")
110+
),
111+
"header file '[^']*' does not exist"
112+
)
113+
)
114+
115+
with_mocked_cli(
116+
compile_ret = list(status = 1),
117+
info_ret = list(),
118+
code = expect_warning(
119+
cmdstan_model(
120+
stan_file = testing_stan_file("bernoulli_external"),
121+
cpp_options = list(USER_HEADER = tmpfile, user_header = tmpfile),
122+
dry_run = TRUE
123+
),
124+
"User header specified both"
125+
)
126+
)
127+
with_mocked_cli(
128+
compile_ret = list(status = 1),
129+
info_ret = list(),
130+
code = expect_warning(
131+
cmdstan_model(
132+
stan_file = testing_stan_file("bernoulli_external"),
133+
user_header = tmpfile,
134+
cpp_options = list(USER_HEADER = tmpfile),
135+
dry_run = TRUE
136+
),
137+
"User header specified both"
138+
)
139+
)
140+
})
141+
142+
test_that("wsl path conversion is done as expected", {
143+
tmp_file <- withr::local_tempfile(lines = hpp, fileext = ".hpp")
144+
# Case 1: arg
145+
with_mocked_cli(
146+
compile_ret = list(status = 1),
147+
info_ret = list(),
148+
code = {
149+
mod <- cmdstan_model(
150+
stan_file = testing_stan_file("bernoulli_external"),
151+
user_header = tmp_file,
152+
dry_run = TRUE
153+
)
154+
}
155+
)
156+
157+
# USER_HEADER is converted
158+
# user_header is NULL
159+
expect_equal(mod$cpp_options()[['USER_HEADER']], w_path(tmp_file))
160+
expect_true(is.null(mod$cpp_options()[['user_header']]))
161+
162+
# Case 2: cpp opt USER_HEADER
163+
with_mocked_cli(
164+
compile_ret = list(status = 1),
165+
info_ret = list(),
166+
code = {
167+
mod <- cmdstan_model(
168+
stan_file = testing_stan_file("bernoulli_external"),
169+
cpp_options = list(
170+
USER_HEADER = tmp_file
171+
),
172+
dry_run = TRUE
173+
)
174+
}
175+
)
176+
177+
# USER_HEADER is converted
178+
# user_header is unconverted
179+
expect_equal(mod$cpp_options()[['USER_HEADER']], w_path(tmp_file))
180+
expect_true(is.null(mod$cpp_options()[['user_header']]))
181+
182+
# Case # 3: only user_header opt
183+
with_mocked_cli(
184+
compile_ret = list(status = 1),
185+
info_ret = list(),
186+
code = {
187+
mod <- cmdstan_model(
188+
stan_file = testing_stan_file("bernoulli_external"),
189+
cpp_options = list(
190+
user_header = tmp_file
191+
),
192+
dry_run = TRUE
193+
)
194+
}
195+
)
196+
197+
198+
# In other cases, in the *output* USER_HEADER is windows style user_header is not.
199+
# In this case, USER_HEADER is null.
200+
expect_true(is.null(mod$cpp_options()[['USER_HEADER']]))
201+
expect_equal(mod$cpp_options()[['user_header']], w_path(tmp_file))
202+
})
203+
204+
test_that("user_header precedence order is correct", {
205+
tmp_files <- sapply(1:3, function(n) withr::local_tempfile(
206+
lines = hpp,
207+
fileext = ".hpp",
208+
.local_envir = parent.frame(3)
209+
))
210+
211+
# Case # 1: all 3 specified
212+
with_mocked_cli(
213+
compile_ret = list(status = 1),
214+
info_ret = list(),
215+
code = expect_warning({
216+
mod <- cmdstan_model(
217+
stan_file = testing_stan_file("bernoulli_external"),
218+
user_header = tmp_files[1],
219+
cpp_options = list(
220+
USER_HEADER = tmp_files[2],
221+
user_header = tmp_files[3]
222+
),
223+
dry_run = TRUE
224+
)
225+
}, "User header specified both")
226+
)
227+
# In this case:
228+
# cpp_options[['USER_HEADER']] == tmp_files[1] <- actually used
229+
# cpp_options[['user_header']] == tmp_files[3] <- ignored
230+
# tmp_files[2] is not stored
231+
expect_equal(
232+
match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)),
233+
1
234+
)
235+
expect_equal(
236+
match(!!(mod$cpp_options()[['user_header']]), tmp_files),
237+
3
238+
)
239+
240+
# Case # 2: Both opts, but no arg
241+
with_mocked_cli(
242+
compile_ret = list(status = 1),
243+
info_ret = list(),
244+
code = expect_warning({
245+
mod <- cmdstan_model(
246+
stan_file = testing_stan_file("bernoulli_external"),
247+
cpp_options = list(
248+
USER_HEADER = tmp_files[2],
249+
user_header = tmp_files[3]
250+
),
251+
dry_run = TRUE
252+
)
253+
}, "User header specified both")
254+
)
255+
# In this case:
256+
# cpp_options[['USER_HEADER']] == tmp_files[2]
257+
# cpp_options[['user_header']] == tmp_files[3]
258+
# tmp_files[2] is not stored
259+
expect_equal(
260+
match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)),
261+
2
262+
)
263+
expect_equal(
264+
match(!!(mod$cpp_options()[['user_header']]), tmp_files),
265+
3
266+
)
267+
268+
# Case # 3: Both opts, other order
269+
with_mocked_cli(
270+
compile_ret = list(status = 1),
271+
info_ret = list(),
272+
code = expect_warning({
273+
mod <- cmdstan_model(
274+
stan_file = testing_stan_file("bernoulli_external"),
275+
cpp_options = list(
276+
user_header = tmp_files[3],
277+
USER_HEADER = tmp_files[2]
278+
),
279+
dry_run = TRUE
280+
)
281+
}, "User header specified both")
282+
)
283+
# Same as Case #2
284+
expect_equal(
285+
match(!!(mod$cpp_options()[['USER_HEADER']]), w_path(tmp_files)),
286+
2
287+
)
288+
expect_equal(
289+
match(!!(mod$cpp_options()[['user_header']]), tmp_files),
290+
3
291+
)
292+
})

0 commit comments

Comments
 (0)