From d6cd0c1011a4e2c1eaaa90d1c789a84834587df1 Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Mon, 9 Mar 2026 23:49:54 -0700 Subject: [PATCH 1/3] Warn on reserved words --- R/utils.R | 26 + tests/testthat/test-model-expose-functions.R | 895 ++++++++++--------- 2 files changed, 505 insertions(+), 416 deletions(-) diff --git a/R/utils.R b/R/utils.R index 94a531373..c5b5f9b38 100644 --- a/R/utils.R +++ b/R/utils.R @@ -944,6 +944,32 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { funs <- grep("// [[stan::function]]", env$hpp_code, fixed = TRUE) funs <- c(funs, length(env$hpp_code)) + reserved_names <- unique(unlist(lapply(seq_len(length(funs) - 1), function(ind) { + fun_end <- funs[ind + 1] + fun_end <- ifelse(env$hpp_code[fun_end] == "}", fun_end, fun_end - 1) + fun_signature <- sub("\\{.*", "", paste(env$hpp_code[(funs[ind] + 1):fun_end], collapse = " ")) + sub( + "^_stan_", + "", + regmatches( + fun_signature, + gregexpr("_stan_[[:alnum:]_]+", fun_signature, perl = TRUE) + )[[1]] + ) + }), use.names = FALSE)) + if (length(reserved_names) > 0) { + warning( + paste0( + "expose_functions() can't expose this Stan function because the function ", + "name and/or one or more argument names use a reserved keyword ", + "(typically in the C++ toolchain used to compile Stan). Please rename ", + "the function/arguments in your Stan functions block and try again. ", + "Conflicting names: ", paste(reserved_names, collapse = ", ") + ), + call. = FALSE + ) + } + stan_funs <- sapply(seq_len(length(funs) - 1), function(ind) { fun_end <- funs[ind + 1] fun_end <- ifelse(env$hpp_code[fun_end] == "}", fun_end, fun_end - 1) diff --git a/tests/testthat/test-model-expose-functions.R b/tests/testthat/test-model-expose-functions.R index 4adc74a90..3382bed1e 100644 --- a/tests/testthat/test-model-expose-functions.R +++ b/tests/testthat/test-model-expose-functions.R @@ -1,441 +1,504 @@ -context("model-expose-functions") - -# Standalone functions not expected to work on WSL yet -skip_if(os_is_wsl()) - -set_cmdstan_path() - -function_decl <- " -functions { - int rtn_int(int x) { return x; } - real rtn_real(real x) { return x; } - vector rtn_vec(vector x) { return x; } - row_vector rtn_rowvec(row_vector x) { return x; } - matrix rtn_matrix(matrix x) { return x; } - - array[] int rtn_int_array(array[] int x) { return x; } - array[] real rtn_real_array(array[] real x) { return x; } - array[] vector rtn_vec_array(array[] vector x) { return x; } - array[] row_vector rtn_rowvec_array(array[] row_vector x) { return x; } - array[] matrix rtn_matrix_array(array[] matrix x) { return x; } - - tuple(int, int) rtn_tuple_int(tuple(int, int) x) { return x; } - tuple(real, real) rtn_tuple_real(tuple(real, real) x) { return x; } - tuple(vector, vector) rtn_tuple_vec(tuple(vector, vector) x) { return x; } - tuple(row_vector, row_vector) rtn_tuple_rowvec(tuple(row_vector, row_vector) x) { return x; } - tuple(matrix, matrix) rtn_tuple_matrix(tuple(matrix, matrix) x) { return x; } - - tuple(array[] int, array[] int) rtn_tuple_int_array(tuple(array[] int, array[] int) x) { return x; } - tuple(array[] real, array[] real) rtn_tuple_real_array(tuple(array[] real, array[] real) x) { return x; } - tuple(array[] vector, array[] vector) rtn_tuple_vec_array(tuple(array[] vector, array[] vector) x) { return x; } - tuple(array[] row_vector, array[] row_vector) rtn_tuple_rowvec_array(tuple(array[] row_vector, array[] row_vector) x) { return x; } - tuple(array[] matrix, array[] matrix) rtn_tuple_matrix_array(tuple(array[] matrix, array[] matrix) x) { return x; } - - tuple(int, tuple(int, int)) rtn_nest_tuple_int(tuple(int, tuple(int, int)) x) { return x; } - tuple(int, tuple(real, real)) rtn_nest_tuple_real(tuple(int, tuple(real, real)) x) { return x; } - tuple(int, tuple(vector, vector)) rtn_nest_tuple_vec(tuple(int, tuple(vector, vector)) x) { return x; } - tuple(int, tuple(row_vector, row_vector)) rtn_nest_tuple_rowvec(tuple(int, tuple(row_vector, row_vector)) x) { return x; } - tuple(int, tuple(matrix, matrix)) rtn_nest_tuple_matrix(tuple(int, tuple(matrix, matrix)) x) { return x; } - - tuple(int, tuple(array[] int, array[] int)) rtn_nest_tuple_int_array(tuple(int, tuple(array[] int, array[] int)) x) { return x; } - tuple(int, tuple(array[] real, array[] real)) rtn_nest_tuple_real_array(tuple(int, tuple(array[] real, array[] real)) x) { return x; } - tuple(int, tuple(array[] vector, array[] vector)) rtn_nest_tuple_vec_array(tuple(int, tuple(array[] vector, array[] vector)) x) { return x; } - tuple(int, tuple(array[] row_vector, array[] row_vector)) rtn_nest_tuple_rowvec_array(tuple(int, tuple(array[] row_vector, array[] row_vector)) x) { return x; } - tuple(int, tuple(array[] matrix, array[] matrix)) rtn_nest_tuple_matrix_array(tuple(int, tuple(array[] matrix, array[] matrix)) x) { return x; } - - complex rtn_complex(complex x) { return x; } - complex_vector rtn_complex_vec(complex_vector x) { return x; } - complex_row_vector rtn_complex_rowvec(complex_row_vector x) { return x; } - complex_matrix rtn_complex_matrix(complex_matrix x) { return x; } - - array[] complex rtn_complex_array(array[] complex x) { return x; } - array[] complex_vector rtn_complex_vec_array(array[] complex_vector x) { return x; } - array[] complex_row_vector rtn_complex_rowvec_array(array[] complex_row_vector x) { return x; } - array[] complex_matrix rtn_complex_matrix_array(array[] complex_matrix x) { return x; } - - tuple(complex, complex) rtn_tuple_complex(tuple(complex, complex) x) { return x; } - tuple(complex_vector, complex_vector) rtn_tuple_complex_vec(tuple(complex_vector, complex_vector) x) { return x; } - tuple(complex_row_vector, complex_row_vector) rtn_tuple_complex_rowvec(tuple(complex_row_vector, complex_row_vector) x) { return x; } - tuple(complex_matrix, complex_matrix) rtn_tuple_complex_matrix(tuple(complex_matrix, complex_matrix) x) { return x; } - - tuple(array[] complex, array[] complex) rtn_tuple_complex_array(tuple(array[] complex, array[] complex) x) { return x; } - tuple(array[] complex_vector, array[] complex_vector) rtn_tuple_complex_vec_array(tuple(array[] complex_vector, array[] complex_vector) x) { return x; } - tuple(array[] complex_row_vector, array[] complex_row_vector) rtn_tuple_complex_rowvec_array(tuple(array[] complex_row_vector, array[] complex_row_vector) x) { return x; } - tuple(array[] complex_matrix, array[] complex_matrix) rtn_tuple_complex_matrix_array(tuple(array[] complex_matrix, array[] complex_matrix) x) { return x; } - - tuple(int, tuple(complex, complex)) rtn_nest_tuple_complex(tuple(int, tuple(complex, complex)) x) { return x; } - tuple(int, tuple(complex_vector, complex_vector)) rtn_nest_tuple_complex_vec(tuple(int, tuple(complex_vector, complex_vector)) x) { return x; } - tuple(int, tuple(complex_row_vector, complex_row_vector)) rtn_nest_tuple_complex_rowvec(tuple(int, tuple(complex_row_vector, complex_row_vector)) x) { return x; } - tuple(int, tuple(complex_matrix, complex_matrix)) rtn_nest_tuple_complex_matrix(tuple(int, tuple(complex_matrix, complex_matrix)) x) { return x; } - - tuple(int, tuple(array[] complex, array[] complex)) rtn_nest_tuple_complex_array(tuple(int, tuple(array[] complex, array[] complex)) x) { return x; } - tuple(int, tuple(array[] complex_vector, array[] complex_vector)) rtn_nest_tuple_complex_vec_array(tuple(int, tuple(array[] complex_vector, array[] complex_vector)) x) { return x; } - tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) rtn_nest_tuple_complex_rowvec_array(tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) x) { return x; } - tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) rtn_nest_tuple_complex_matrix_array(tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) x) { return x; } -}" -stan_prog <- paste(function_decl, - paste(readLines(testing_stan_file("bernoulli")), - collapse = "\n"), - collapse = "\n") -model <- write_stan_file(stan_prog) -data_list <- testing_data("bernoulli") -mod <- cmdstan_model(model, force_recompile = TRUE) -utils::capture.output( - fit <- mod$sample(data = data_list) -) - - -test_that("Functions can be exposed in model object", { - expect_no_error(mod$expose_functions()) -}) - - -test_that("Functions handle types correctly", { - ### Scalar - - expect_equal(mod$functions$rtn_int(10), 10) - expect_equal(mod$functions$rtn_real(1.67), 1.67) - - ### Container - - vec <- c(1.2,234,0.3,-0.4) - rowvec <- t(vec) - matrix <- matrix(c(2.11, -6.35, 4.87, -0.9871), nrow = 2, ncol = 2) - - expect_equal(mod$functions$rtn_vec(vec), vec) - expect_equal(mod$functions$rtn_rowvec(vec), t(vec)) - expect_equal(mod$functions$rtn_matrix(matrix), matrix) - expect_equal(mod$functions$rtn_int_array(1:5), 1:5) - expect_equal(mod$functions$rtn_real_array(vec), vec) - - ### Array of Container - - vec_array <- list(vec, vec * 2, vec + 0.1) - rowvec_array <- list(rowvec, rowvec * 2, rowvec + 0.1) - matrix_array <- list(matrix, matrix * 2, matrix + 0.1) - - expect_equal(mod$functions$rtn_vec_array(vec_array), vec_array) - expect_equal(mod$functions$rtn_rowvec_array(rowvec_array), rowvec_array) - expect_equal(mod$functions$rtn_matrix_array(matrix_array), matrix_array) - - ### Tuple of Scalar - - tuple_int <- list(10, 35) - tuple_dbl <- list(31.87, -19.09) - expect_equal(mod$functions$rtn_tuple_int(tuple_int), tuple_int) - expect_equal(mod$functions$rtn_tuple_real(tuple_dbl), tuple_dbl) - - ### Tuple of Container - - tuple_vec <- list(vec, vec * 12) - tuple_rowvec <- list(rowvec, rowvec * 0.5) - tuple_matrix <- list(matrix, matrix * 0.23) - tuple_int_array <- list(1:10, -3:2) - - expect_equal(mod$functions$rtn_tuple_vec(tuple_vec), tuple_vec) - expect_equal(mod$functions$rtn_tuple_rowvec(tuple_rowvec), tuple_rowvec) - expect_equal(mod$functions$rtn_tuple_matrix(tuple_matrix), tuple_matrix) - expect_equal(mod$functions$rtn_tuple_int_array(tuple_int_array), tuple_int_array) - expect_equal(mod$functions$rtn_tuple_real_array(tuple_vec), tuple_vec) - - ### Tuple of Container Arrays - - tuple_vec_array <- list(vec_array, vec_array) - tuple_rowvec_array <- list(rowvec_array, rowvec_array) - tuple_matrix_array <- list(matrix_array, matrix_array) - - expect_equal(mod$functions$rtn_tuple_vec_array(tuple_vec_array), tuple_vec_array) - expect_equal(mod$functions$rtn_tuple_rowvec_array(tuple_rowvec_array), tuple_rowvec_array) - expect_equal(mod$functions$rtn_tuple_matrix_array(tuple_matrix_array), tuple_matrix_array) - - ### Nested Tuple of Scalar - - nest_tuple_int <- list(10, tuple_int) - nest_tuple_dbl <- list(31, tuple_dbl) - expect_equal(mod$functions$rtn_nest_tuple_int(nest_tuple_int), nest_tuple_int) - expect_equal(mod$functions$rtn_nest_tuple_real(nest_tuple_dbl), nest_tuple_dbl) - - ### Nested Tuple of Container - - nest_tuple_vec <- list(12, tuple_vec) - nest_tuple_rowvec <- list(2, tuple_rowvec) - nest_tuple_matrix <- list(-23, tuple_matrix) - nest_tuple_int_array <- list(21, tuple_int_array) - - expect_equal(mod$functions$rtn_nest_tuple_vec(nest_tuple_vec), nest_tuple_vec) - expect_equal(mod$functions$rtn_nest_tuple_rowvec(nest_tuple_rowvec), nest_tuple_rowvec) - expect_equal(mod$functions$rtn_nest_tuple_matrix(nest_tuple_matrix), nest_tuple_matrix) - expect_equal(mod$functions$rtn_nest_tuple_int_array(nest_tuple_int_array), nest_tuple_int_array) - expect_equal(mod$functions$rtn_nest_tuple_real_array(nest_tuple_vec), nest_tuple_vec) - - ### Nested Tuple of Container Arrays - - nest_tuple_vec_array <- list(-21, tuple_vec_array) - nest_tuple_rowvec_array <- list(1000, tuple_rowvec_array) - nest_tuple_matrix_array <- list(0, tuple_matrix_array) - - expect_equal(mod$functions$rtn_nest_tuple_vec_array(nest_tuple_vec_array), nest_tuple_vec_array) - expect_equal(mod$functions$rtn_nest_tuple_rowvec_array(nest_tuple_rowvec_array), nest_tuple_rowvec_array) - expect_equal(mod$functions$rtn_nest_tuple_matrix_array(nest_tuple_matrix_array), nest_tuple_matrix_array) -}) - -test_that("Functions handle complex types correctly", { - ### Scalar - - complex_scalar <- complex(real = 2.1, imaginary = 21.3) - - expect_equal(mod$functions$rtn_complex(complex_scalar), complex_scalar) - - ### Container - - complex_vec <- complex(real = c(2,1.5,0.11, 1.2), imaginary = c(11.2,21.5,6.1,3.2)) - complex_rowvec <- t(complex_vec) - complex_matrix <- matrix(complex_vec, nrow=2, ncol=2) - - expect_equal(mod$functions$rtn_complex_vec(complex_vec), complex_vec) - expect_equal(mod$functions$rtn_complex_rowvec(complex_rowvec), complex_rowvec) - expect_equal(mod$functions$rtn_complex_matrix(complex_matrix), complex_matrix) - expect_equal(mod$functions$rtn_complex_array(complex_vec), complex_vec) - - ### Array of Container - - complex_vec_array <- list(complex_vec, complex_vec * 2, complex_vec + 0.1) - complex_rowvec_array <- list(complex_rowvec, complex_rowvec * 2, complex_rowvec + 0.1) - complex_matrix_array <- list(complex_matrix, complex_matrix * 2, complex_matrix + 0.1) - - expect_equal(mod$functions$rtn_complex_vec_array(complex_vec_array), complex_vec_array) - expect_equal(mod$functions$rtn_complex_rowvec_array(complex_rowvec_array), complex_rowvec_array) - expect_equal(mod$functions$rtn_complex_matrix_array(complex_matrix_array), complex_matrix_array) - - ### Tuple of Scalar - - tuple_complex <- list(complex_vec[1], complex_vec[2]) - expect_equal(mod$functions$rtn_tuple_complex(tuple_complex), tuple_complex) - - ### Tuple of Container - - tuple_complex_vec <- list(complex_vec, complex_vec * 1.2) - tuple_complex_rowvec <- list(complex_rowvec, complex_rowvec * 0.5) - tuple_complex_matrix <- list(complex_matrix, complex_matrix * 10.2) - - expect_equal(mod$functions$rtn_tuple_complex_array(tuple_complex_vec), tuple_complex_vec) - expect_equal(mod$functions$rtn_tuple_complex_vec(tuple_complex_vec), tuple_complex_vec) - expect_equal(mod$functions$rtn_tuple_complex_rowvec(tuple_complex_rowvec), tuple_complex_rowvec) - expect_equal(mod$functions$rtn_tuple_complex_matrix(tuple_complex_matrix), tuple_complex_matrix) - - ### Tuple of Container Arrays - - tuple_complex_vec_array <- list(complex_vec_array, complex_vec_array) - tuple_complex_rowvec_array <- list(complex_rowvec_array, complex_rowvec_array) - tuple_complex_matrix_array <- list(complex_matrix_array, complex_matrix_array) - - expect_equal(mod$functions$rtn_tuple_complex_vec_array(tuple_complex_vec_array), tuple_complex_vec_array) - expect_equal(mod$functions$rtn_tuple_complex_rowvec_array(tuple_complex_rowvec_array), tuple_complex_rowvec_array) - expect_equal(mod$functions$rtn_tuple_complex_matrix_array(tuple_complex_matrix_array), tuple_complex_matrix_array) - - ### Nested Tuple of Scalar - - nest_tuple_complex <- list(31, tuple_complex) - expect_equal(mod$functions$rtn_nest_tuple_complex(nest_tuple_complex), nest_tuple_complex) - - ### Nested Tuple of Container - - nest_tuple_complex_vec <- list(12, tuple_complex_vec) - nest_tuple_complex_rowvec <- list(2, tuple_complex_rowvec) - nest_tuple_complex_matrix <- list(-23, tuple_complex_matrix) - nest_tuple_complex_array <- list(21, tuple_complex_vec) - - expect_equal(mod$functions$rtn_nest_tuple_complex_array(nest_tuple_complex_vec), nest_tuple_complex_vec) - expect_equal(mod$functions$rtn_nest_tuple_complex_vec(nest_tuple_complex_vec), nest_tuple_complex_vec) - expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec(nest_tuple_complex_rowvec), nest_tuple_complex_rowvec) - expect_equal(mod$functions$rtn_nest_tuple_complex_matrix(nest_tuple_complex_matrix), nest_tuple_complex_matrix) - - ### Nested Tuple of Container Arrays - - nest_tuple_complex_vec_array <- list(-21, tuple_complex_vec_array) - nest_tuple_complex_rowvec_array <- list(1000, tuple_complex_rowvec_array) - nest_tuple_complex_matrix_array <- list(0, tuple_complex_matrix_array) - - expect_equal(mod$functions$rtn_nest_tuple_complex_vec_array(nest_tuple_complex_vec_array), nest_tuple_complex_vec_array) - expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec_array(nest_tuple_complex_rowvec_array), nest_tuple_complex_rowvec_array) - expect_equal(mod$functions$rtn_nest_tuple_complex_matrix_array(nest_tuple_complex_matrix_array), nest_tuple_complex_matrix_array) -}) - -test_that("Functions can be exposed in fit object", { - fit$expose_functions() - - expect_equal( - fit$functions$rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) -}) - -test_that("Compiled functions can be copied to global environment", { - expect_message( - fit$expose_functions(global = TRUE), - "Functions already compiled, copying to global environment", - fixed = TRUE - ) - - expect_equal( - rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) +context("model-expose-functions") + +# Standalone functions not expected to work on WSL yet +skip_if(os_is_wsl()) + +set_cmdstan_path() + +function_decl <- " +functions { + int rtn_int(int x) { return x; } + real rtn_real(real x) { return x; } + vector rtn_vec(vector x) { return x; } + row_vector rtn_rowvec(row_vector x) { return x; } + matrix rtn_matrix(matrix x) { return x; } + + array[] int rtn_int_array(array[] int x) { return x; } + array[] real rtn_real_array(array[] real x) { return x; } + array[] vector rtn_vec_array(array[] vector x) { return x; } + array[] row_vector rtn_rowvec_array(array[] row_vector x) { return x; } + array[] matrix rtn_matrix_array(array[] matrix x) { return x; } + + tuple(int, int) rtn_tuple_int(tuple(int, int) x) { return x; } + tuple(real, real) rtn_tuple_real(tuple(real, real) x) { return x; } + tuple(vector, vector) rtn_tuple_vec(tuple(vector, vector) x) { return x; } + tuple(row_vector, row_vector) rtn_tuple_rowvec(tuple(row_vector, row_vector) x) { return x; } + tuple(matrix, matrix) rtn_tuple_matrix(tuple(matrix, matrix) x) { return x; } + + tuple(array[] int, array[] int) rtn_tuple_int_array(tuple(array[] int, array[] int) x) { return x; } + tuple(array[] real, array[] real) rtn_tuple_real_array(tuple(array[] real, array[] real) x) { return x; } + tuple(array[] vector, array[] vector) rtn_tuple_vec_array(tuple(array[] vector, array[] vector) x) { return x; } + tuple(array[] row_vector, array[] row_vector) rtn_tuple_rowvec_array(tuple(array[] row_vector, array[] row_vector) x) { return x; } + tuple(array[] matrix, array[] matrix) rtn_tuple_matrix_array(tuple(array[] matrix, array[] matrix) x) { return x; } + + tuple(int, tuple(int, int)) rtn_nest_tuple_int(tuple(int, tuple(int, int)) x) { return x; } + tuple(int, tuple(real, real)) rtn_nest_tuple_real(tuple(int, tuple(real, real)) x) { return x; } + tuple(int, tuple(vector, vector)) rtn_nest_tuple_vec(tuple(int, tuple(vector, vector)) x) { return x; } + tuple(int, tuple(row_vector, row_vector)) rtn_nest_tuple_rowvec(tuple(int, tuple(row_vector, row_vector)) x) { return x; } + tuple(int, tuple(matrix, matrix)) rtn_nest_tuple_matrix(tuple(int, tuple(matrix, matrix)) x) { return x; } + + tuple(int, tuple(array[] int, array[] int)) rtn_nest_tuple_int_array(tuple(int, tuple(array[] int, array[] int)) x) { return x; } + tuple(int, tuple(array[] real, array[] real)) rtn_nest_tuple_real_array(tuple(int, tuple(array[] real, array[] real)) x) { return x; } + tuple(int, tuple(array[] vector, array[] vector)) rtn_nest_tuple_vec_array(tuple(int, tuple(array[] vector, array[] vector)) x) { return x; } + tuple(int, tuple(array[] row_vector, array[] row_vector)) rtn_nest_tuple_rowvec_array(tuple(int, tuple(array[] row_vector, array[] row_vector)) x) { return x; } + tuple(int, tuple(array[] matrix, array[] matrix)) rtn_nest_tuple_matrix_array(tuple(int, tuple(array[] matrix, array[] matrix)) x) { return x; } + + complex rtn_complex(complex x) { return x; } + complex_vector rtn_complex_vec(complex_vector x) { return x; } + complex_row_vector rtn_complex_rowvec(complex_row_vector x) { return x; } + complex_matrix rtn_complex_matrix(complex_matrix x) { return x; } + + array[] complex rtn_complex_array(array[] complex x) { return x; } + array[] complex_vector rtn_complex_vec_array(array[] complex_vector x) { return x; } + array[] complex_row_vector rtn_complex_rowvec_array(array[] complex_row_vector x) { return x; } + array[] complex_matrix rtn_complex_matrix_array(array[] complex_matrix x) { return x; } + + tuple(complex, complex) rtn_tuple_complex(tuple(complex, complex) x) { return x; } + tuple(complex_vector, complex_vector) rtn_tuple_complex_vec(tuple(complex_vector, complex_vector) x) { return x; } + tuple(complex_row_vector, complex_row_vector) rtn_tuple_complex_rowvec(tuple(complex_row_vector, complex_row_vector) x) { return x; } + tuple(complex_matrix, complex_matrix) rtn_tuple_complex_matrix(tuple(complex_matrix, complex_matrix) x) { return x; } + + tuple(array[] complex, array[] complex) rtn_tuple_complex_array(tuple(array[] complex, array[] complex) x) { return x; } + tuple(array[] complex_vector, array[] complex_vector) rtn_tuple_complex_vec_array(tuple(array[] complex_vector, array[] complex_vector) x) { return x; } + tuple(array[] complex_row_vector, array[] complex_row_vector) rtn_tuple_complex_rowvec_array(tuple(array[] complex_row_vector, array[] complex_row_vector) x) { return x; } + tuple(array[] complex_matrix, array[] complex_matrix) rtn_tuple_complex_matrix_array(tuple(array[] complex_matrix, array[] complex_matrix) x) { return x; } + + tuple(int, tuple(complex, complex)) rtn_nest_tuple_complex(tuple(int, tuple(complex, complex)) x) { return x; } + tuple(int, tuple(complex_vector, complex_vector)) rtn_nest_tuple_complex_vec(tuple(int, tuple(complex_vector, complex_vector)) x) { return x; } + tuple(int, tuple(complex_row_vector, complex_row_vector)) rtn_nest_tuple_complex_rowvec(tuple(int, tuple(complex_row_vector, complex_row_vector)) x) { return x; } + tuple(int, tuple(complex_matrix, complex_matrix)) rtn_nest_tuple_complex_matrix(tuple(int, tuple(complex_matrix, complex_matrix)) x) { return x; } + + tuple(int, tuple(array[] complex, array[] complex)) rtn_nest_tuple_complex_array(tuple(int, tuple(array[] complex, array[] complex)) x) { return x; } + tuple(int, tuple(array[] complex_vector, array[] complex_vector)) rtn_nest_tuple_complex_vec_array(tuple(int, tuple(array[] complex_vector, array[] complex_vector)) x) { return x; } + tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) rtn_nest_tuple_complex_rowvec_array(tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) x) { return x; } + tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) rtn_nest_tuple_complex_matrix_array(tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) x) { return x; } +}" +stan_prog <- paste(function_decl, + paste(readLines(testing_stan_file("bernoulli")), + collapse = "\n"), + collapse = "\n") +model <- write_stan_file(stan_prog) +data_list <- testing_data("bernoulli") +mod <- cmdstan_model(model, force_recompile = TRUE) +utils::capture.output( + fit <- mod$sample(data = data_list) +) + + +test_that("Functions can be exposed in model object", { + expect_no_error(mod$expose_functions()) +}) + + +test_that("Functions handle types correctly", { + ### Scalar + + expect_equal(mod$functions$rtn_int(10), 10) + expect_equal(mod$functions$rtn_real(1.67), 1.67) + + ### Container + + vec <- c(1.2,234,0.3,-0.4) + rowvec <- t(vec) + matrix <- matrix(c(2.11, -6.35, 4.87, -0.9871), nrow = 2, ncol = 2) + + expect_equal(mod$functions$rtn_vec(vec), vec) + expect_equal(mod$functions$rtn_rowvec(vec), t(vec)) + expect_equal(mod$functions$rtn_matrix(matrix), matrix) + expect_equal(mod$functions$rtn_int_array(1:5), 1:5) + expect_equal(mod$functions$rtn_real_array(vec), vec) + + ### Array of Container + + vec_array <- list(vec, vec * 2, vec + 0.1) + rowvec_array <- list(rowvec, rowvec * 2, rowvec + 0.1) + matrix_array <- list(matrix, matrix * 2, matrix + 0.1) + + expect_equal(mod$functions$rtn_vec_array(vec_array), vec_array) + expect_equal(mod$functions$rtn_rowvec_array(rowvec_array), rowvec_array) + expect_equal(mod$functions$rtn_matrix_array(matrix_array), matrix_array) + + ### Tuple of Scalar + + tuple_int <- list(10, 35) + tuple_dbl <- list(31.87, -19.09) + expect_equal(mod$functions$rtn_tuple_int(tuple_int), tuple_int) + expect_equal(mod$functions$rtn_tuple_real(tuple_dbl), tuple_dbl) + + ### Tuple of Container + + tuple_vec <- list(vec, vec * 12) + tuple_rowvec <- list(rowvec, rowvec * 0.5) + tuple_matrix <- list(matrix, matrix * 0.23) + tuple_int_array <- list(1:10, -3:2) + + expect_equal(mod$functions$rtn_tuple_vec(tuple_vec), tuple_vec) + expect_equal(mod$functions$rtn_tuple_rowvec(tuple_rowvec), tuple_rowvec) + expect_equal(mod$functions$rtn_tuple_matrix(tuple_matrix), tuple_matrix) + expect_equal(mod$functions$rtn_tuple_int_array(tuple_int_array), tuple_int_array) + expect_equal(mod$functions$rtn_tuple_real_array(tuple_vec), tuple_vec) + + ### Tuple of Container Arrays + + tuple_vec_array <- list(vec_array, vec_array) + tuple_rowvec_array <- list(rowvec_array, rowvec_array) + tuple_matrix_array <- list(matrix_array, matrix_array) + + expect_equal(mod$functions$rtn_tuple_vec_array(tuple_vec_array), tuple_vec_array) + expect_equal(mod$functions$rtn_tuple_rowvec_array(tuple_rowvec_array), tuple_rowvec_array) + expect_equal(mod$functions$rtn_tuple_matrix_array(tuple_matrix_array), tuple_matrix_array) + + ### Nested Tuple of Scalar + + nest_tuple_int <- list(10, tuple_int) + nest_tuple_dbl <- list(31, tuple_dbl) + expect_equal(mod$functions$rtn_nest_tuple_int(nest_tuple_int), nest_tuple_int) + expect_equal(mod$functions$rtn_nest_tuple_real(nest_tuple_dbl), nest_tuple_dbl) + + ### Nested Tuple of Container + + nest_tuple_vec <- list(12, tuple_vec) + nest_tuple_rowvec <- list(2, tuple_rowvec) + nest_tuple_matrix <- list(-23, tuple_matrix) + nest_tuple_int_array <- list(21, tuple_int_array) + + expect_equal(mod$functions$rtn_nest_tuple_vec(nest_tuple_vec), nest_tuple_vec) + expect_equal(mod$functions$rtn_nest_tuple_rowvec(nest_tuple_rowvec), nest_tuple_rowvec) + expect_equal(mod$functions$rtn_nest_tuple_matrix(nest_tuple_matrix), nest_tuple_matrix) + expect_equal(mod$functions$rtn_nest_tuple_int_array(nest_tuple_int_array), nest_tuple_int_array) + expect_equal(mod$functions$rtn_nest_tuple_real_array(nest_tuple_vec), nest_tuple_vec) + + ### Nested Tuple of Container Arrays + + nest_tuple_vec_array <- list(-21, tuple_vec_array) + nest_tuple_rowvec_array <- list(1000, tuple_rowvec_array) + nest_tuple_matrix_array <- list(0, tuple_matrix_array) + + expect_equal(mod$functions$rtn_nest_tuple_vec_array(nest_tuple_vec_array), nest_tuple_vec_array) + expect_equal(mod$functions$rtn_nest_tuple_rowvec_array(nest_tuple_rowvec_array), nest_tuple_rowvec_array) + expect_equal(mod$functions$rtn_nest_tuple_matrix_array(nest_tuple_matrix_array), nest_tuple_matrix_array) +}) + +test_that("Functions handle complex types correctly", { + ### Scalar + + complex_scalar <- complex(real = 2.1, imaginary = 21.3) + + expect_equal(mod$functions$rtn_complex(complex_scalar), complex_scalar) + + ### Container + + complex_vec <- complex(real = c(2,1.5,0.11, 1.2), imaginary = c(11.2,21.5,6.1,3.2)) + complex_rowvec <- t(complex_vec) + complex_matrix <- matrix(complex_vec, nrow=2, ncol=2) + + expect_equal(mod$functions$rtn_complex_vec(complex_vec), complex_vec) + expect_equal(mod$functions$rtn_complex_rowvec(complex_rowvec), complex_rowvec) + expect_equal(mod$functions$rtn_complex_matrix(complex_matrix), complex_matrix) + expect_equal(mod$functions$rtn_complex_array(complex_vec), complex_vec) + + ### Array of Container + + complex_vec_array <- list(complex_vec, complex_vec * 2, complex_vec + 0.1) + complex_rowvec_array <- list(complex_rowvec, complex_rowvec * 2, complex_rowvec + 0.1) + complex_matrix_array <- list(complex_matrix, complex_matrix * 2, complex_matrix + 0.1) + + expect_equal(mod$functions$rtn_complex_vec_array(complex_vec_array), complex_vec_array) + expect_equal(mod$functions$rtn_complex_rowvec_array(complex_rowvec_array), complex_rowvec_array) + expect_equal(mod$functions$rtn_complex_matrix_array(complex_matrix_array), complex_matrix_array) + + ### Tuple of Scalar + + tuple_complex <- list(complex_vec[1], complex_vec[2]) + expect_equal(mod$functions$rtn_tuple_complex(tuple_complex), tuple_complex) + + ### Tuple of Container + + tuple_complex_vec <- list(complex_vec, complex_vec * 1.2) + tuple_complex_rowvec <- list(complex_rowvec, complex_rowvec * 0.5) + tuple_complex_matrix <- list(complex_matrix, complex_matrix * 10.2) + + expect_equal(mod$functions$rtn_tuple_complex_array(tuple_complex_vec), tuple_complex_vec) + expect_equal(mod$functions$rtn_tuple_complex_vec(tuple_complex_vec), tuple_complex_vec) + expect_equal(mod$functions$rtn_tuple_complex_rowvec(tuple_complex_rowvec), tuple_complex_rowvec) + expect_equal(mod$functions$rtn_tuple_complex_matrix(tuple_complex_matrix), tuple_complex_matrix) + + ### Tuple of Container Arrays + + tuple_complex_vec_array <- list(complex_vec_array, complex_vec_array) + tuple_complex_rowvec_array <- list(complex_rowvec_array, complex_rowvec_array) + tuple_complex_matrix_array <- list(complex_matrix_array, complex_matrix_array) + + expect_equal(mod$functions$rtn_tuple_complex_vec_array(tuple_complex_vec_array), tuple_complex_vec_array) + expect_equal(mod$functions$rtn_tuple_complex_rowvec_array(tuple_complex_rowvec_array), tuple_complex_rowvec_array) + expect_equal(mod$functions$rtn_tuple_complex_matrix_array(tuple_complex_matrix_array), tuple_complex_matrix_array) + + ### Nested Tuple of Scalar + + nest_tuple_complex <- list(31, tuple_complex) + expect_equal(mod$functions$rtn_nest_tuple_complex(nest_tuple_complex), nest_tuple_complex) + + ### Nested Tuple of Container + + nest_tuple_complex_vec <- list(12, tuple_complex_vec) + nest_tuple_complex_rowvec <- list(2, tuple_complex_rowvec) + nest_tuple_complex_matrix <- list(-23, tuple_complex_matrix) + nest_tuple_complex_array <- list(21, tuple_complex_vec) + + expect_equal(mod$functions$rtn_nest_tuple_complex_array(nest_tuple_complex_vec), nest_tuple_complex_vec) + expect_equal(mod$functions$rtn_nest_tuple_complex_vec(nest_tuple_complex_vec), nest_tuple_complex_vec) + expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec(nest_tuple_complex_rowvec), nest_tuple_complex_rowvec) + expect_equal(mod$functions$rtn_nest_tuple_complex_matrix(nest_tuple_complex_matrix), nest_tuple_complex_matrix) + + ### Nested Tuple of Container Arrays + + nest_tuple_complex_vec_array <- list(-21, tuple_complex_vec_array) + nest_tuple_complex_rowvec_array <- list(1000, tuple_complex_rowvec_array) + nest_tuple_complex_matrix_array <- list(0, tuple_complex_matrix_array) + + expect_equal(mod$functions$rtn_nest_tuple_complex_vec_array(nest_tuple_complex_vec_array), nest_tuple_complex_vec_array) + expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec_array(nest_tuple_complex_rowvec_array), nest_tuple_complex_rowvec_array) + expect_equal(mod$functions$rtn_nest_tuple_complex_matrix_array(nest_tuple_complex_matrix_array), nest_tuple_complex_matrix_array) +}) + +test_that("Functions can be exposed in fit object", { + fit$expose_functions() + + expect_equal( + fit$functions$rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + +test_that("Compiled functions can be copied to global environment", { + expect_message( + fit$expose_functions(global = TRUE), + "Functions already compiled, copying to global environment", + fixed = TRUE + ) + + expect_equal( + rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + + +test_that("Functions can be compiled with model", { + mod <- cmdstan_model(model, force_recompile = TRUE, compile_standalone = TRUE) + utils::capture.output( + fit <- mod$sample(data = data_list) + ) + + expect_message( + fit$expose_functions(), + "Functions already compiled, nothing to do!", + fixed = TRUE + ) + + expect_equal( + fit$functions$rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) + + expect_message( + fit$expose_functions(global = TRUE), + "Functions already compiled, copying to global environment", + fixed = TRUE + ) + + expect_equal( + rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + +test_that("compile_standalone warns but doesn't error if no functions", { + stan_no_funs_block <- write_stan_file(" + parameters { + real x; + } + model { + x ~ std_normal(); + } + ") + expect_warning( + mod1 <- cmdstan_model(stan_no_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), + "No standalone functions found to compile and expose to R" + ) + checkmate::expect_r6(mod1, "CmdStanModel") + + stan_empty_funs_block <- write_stan_file(" + functions { + } + ") + expect_warning( + mod2 <- cmdstan_model(stan_empty_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), + "No standalone functions found to compile and expose to R" + ) + checkmate::expect_r6(mod2, "CmdStanModel") +}) + +test_that("rng functions can be exposed", { + function_decl <- "functions { real wrap_normal_rng(real mu, real sigma) { return normal_rng(mu, sigma); } }" + stan_prog <- paste(function_decl, + paste(readLines(testing_stan_file("bernoulli")), + collapse = "\n"), + collapse = "\n") + model <- write_stan_file(stan_prog) + data_list <- testing_data("bernoulli") + mod <- cmdstan_model(model, force_recompile = TRUE) + utils::capture.output( + fit <- mod$sample(data = data_list) + ) + + fit$expose_functions() + set.seed(10) + res1_1 <- fit$functions$wrap_normal_rng(5,10) + res2_1 <- fit$functions$wrap_normal_rng(5,10) + set.seed(10) + res1_2 <- fit$functions$wrap_normal_rng(5,10) + res2_2 <- fit$functions$wrap_normal_rng(5,10) + + expect_equal(res1_1, res1_2) + expect_equal(res2_1, res2_2) +}) + +test_that("Overloaded functions give meaningful errors", { + funcode <- " + functions { + real fun1(real x) { return x; } + vector fun1(vector x) { return x; } + real fun2(real x) { return x; } + matrix fun3(matrix x) { return x; } + real fun3(real x) { return x; } + } + " + + funmod <- cmdstan_model(write_stan_file(funcode), force_recompile = TRUE) + expect_error(funmod$expose_functions(), + "Overloaded functions are currently not able to be exposed to R! The following overloaded functions were found: fun1, fun3") }) - -test_that("Functions can be compiled with model", { - mod <- cmdstan_model(model, force_recompile = TRUE, compile_standalone = TRUE) - utils::capture.output( - fit <- mod$sample(data = data_list) +reserved_names_msg <- function(names) { + paste( + "expose_functions() can't expose this Stan function because the function", + "name and/or one or more argument names use a reserved keyword", + "(typically in the C++ toolchain used to compile Stan). Please rename", + "the function/arguments in your Stan functions block and try again.", + paste("Conflicting names:", paste(names, collapse = ", ")) ) +} - expect_message( - fit$expose_functions(), - "Functions already compiled, nothing to do!", - fixed = TRUE - ) - - expect_equal( - fit$functions$rtn_vec(c(1,2,3,4)), - c(1,2,3,4) +test_that("Reserved names in Stan code give the same error", { + stan_file <- write_stan_file( + " + functions { + real min(real max, real class) { + return max - class; + } + } + " ) - expect_message( - fit$expose_functions(global = TRUE), - "Functions already compiled, copying to global environment", + funmod <- cmdstan_model(stan_file, force_recompile = TRUE) + expect_warning( + funmod$expose_functions(), + reserved_names_msg(c("min", "max", "class")), fixed = TRUE ) - - expect_equal( - rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) }) -test_that("compile_standalone warns but doesn't error if no functions", { - stan_no_funs_block <- write_stan_file(" - parameters { - real x; - } - model { - x ~ std_normal(); +test_that("Multiple reserved C++ keywords in Stan code give the same error", { + stan_file <- write_stan_file( + " + functions { + real template(real class, real namespace, real private) { + return class + namespace + private; } - ") - expect_warning( - mod1 <- cmdstan_model(stan_no_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), - "No standalone functions found to compile and expose to R" + } + " ) - checkmate::expect_r6(mod1, "CmdStanModel") - stan_empty_funs_block <- write_stan_file(" - functions { - } - ") + funmod <- cmdstan_model(stan_file, force_recompile = TRUE) expect_warning( - mod2 <- cmdstan_model(stan_empty_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), - "No standalone functions found to compile and expose to R" - ) - checkmate::expect_r6(mod2, "CmdStanModel") -}) - -test_that("rng functions can be exposed", { - function_decl <- "functions { real wrap_normal_rng(real mu, real sigma) { return normal_rng(mu, sigma); } }" - stan_prog <- paste(function_decl, - paste(readLines(testing_stan_file("bernoulli")), - collapse = "\n"), - collapse = "\n") - model <- write_stan_file(stan_prog) - data_list <- testing_data("bernoulli") - mod <- cmdstan_model(model, force_recompile = TRUE) - utils::capture.output( - fit <- mod$sample(data = data_list) + funmod$expose_functions(), + reserved_names_msg(c("template", "class", "namespace", "private")), + fixed = TRUE ) - - fit$expose_functions() - set.seed(10) - res1_1 <- fit$functions$wrap_normal_rng(5,10) - res2_1 <- fit$functions$wrap_normal_rng(5,10) - set.seed(10) - res1_2 <- fit$functions$wrap_normal_rng(5,10) - res2_2 <- fit$functions$wrap_normal_rng(5,10) - - expect_equal(res1_1, res1_2) - expect_equal(res2_1, res2_2) }) -test_that("Overloaded functions give meaningful errors", { - funcode <- " +test_that("Stan code with no reserved names exposes functions", { + stan_file <- write_stan_file( + " functions { - real fun1(real x) { return x; } - vector fun1(vector x) { return x; } - real fun2(real x) { return x; } - matrix fun3(matrix x) { return x; } - real fun3(real x) { return x; } + real add(real left, real right) { + return left + right; + } } " + ) - funmod <- cmdstan_model(write_stan_file(funcode), force_recompile = TRUE) - expect_error(funmod$expose_functions(), - "Overloaded functions are currently not able to be exposed to R! The following overloaded functions were found: fun1, fun3") + funmod <- cmdstan_model(stan_file, force_recompile = TRUE) + expect_no_error(funmod$expose_functions()) }) test_that("Exposing external functions errors before v2.32", { fake_cmdstan_version("2.26.0") - - tmpfile <- tempfile(fileext = ".hpp") - hpp <- - " - #include - namespace standalone_external_model_namespace { - int rtn_int(int x, std::ostream *pstream__) { return x; } - }" - cat(hpp, file = tmpfile, sep = "\n") - stanfile <- file.path(tempdir(), "standalone_external.stan") - cat("functions { int rtn_int(int x); }\n", file = stanfile) - expect_error({ - cmdstan_model( - stan_file = stanfile, - user_header = tmpfile, - compile_standalone = TRUE - ) - }, - "Exporting standalone functions with external C++ is not available before CmdStan 2.32", - fixed = TRUE) - - reset_cmdstan_version() -}) - -test_that("Exposing functions with precompiled model gives meaningful error", { - stan_file <- write_stan_file(" - functions { - real a_plus_b(real a, real b) { return a + b; } - } - parameters { real x; } - model { x ~ std_normal(); } - ") - mod1 <- cmdstan_model(stan_file, compile_standalone = TRUE, - force_recompile = TRUE) - expect_equal(7.5, mod1$functions$a_plus_b(5, 2.5)) - - mod2 <- cmdstan_model(stan_file) - expect_error( - mod2$expose_functions(), - "Exporting standalone functions is not possible with a pre-compiled Stan model!", - fixed = TRUE - ) -}) - -test_that("Functions with SUNDIALS/KINSOL methods link correctly", { - modcode <- " - functions { - vector dummy_functor(vector guess, vector theta, data array[] real tails, data array[] int x_i) { - return [1, 1]'; - } - vector call_solver(vector guess, vector theta, data array[] real tails, data array[] int x_i) { - return algebra_solver_newton(dummy_functor, guess, theta, tails, x_i); - } - }" - mod <- cmdstan_model(write_stan_file(modcode), force_recompile=TRUE) - expect_no_error(mod$expose_functions()) -}) + + tmpfile <- tempfile(fileext = ".hpp") + hpp <- + " + #include + namespace standalone_external_model_namespace { + int rtn_int(int x, std::ostream *pstream__) { return x; } + }" + cat(hpp, file = tmpfile, sep = "\n") + stanfile <- file.path(tempdir(), "standalone_external.stan") + cat("functions { int rtn_int(int x); }\n", file = stanfile) + expect_error({ + cmdstan_model( + stan_file = stanfile, + user_header = tmpfile, + compile_standalone = TRUE + ) + }, + "Exporting standalone functions with external C++ is not available before CmdStan 2.32", + fixed = TRUE) + + reset_cmdstan_version() +}) + +test_that("Exposing functions with precompiled model gives meaningful error", { + stan_file <- write_stan_file(" + functions { + real a_plus_b(real a, real b) { return a + b; } + } + parameters { real x; } + model { x ~ std_normal(); } + ") + mod1 <- cmdstan_model(stan_file, compile_standalone = TRUE, + force_recompile = TRUE) + expect_equal(7.5, mod1$functions$a_plus_b(5, 2.5)) + + mod2 <- cmdstan_model(stan_file) + expect_error( + mod2$expose_functions(), + "Exporting standalone functions is not possible with a pre-compiled Stan model!", + fixed = TRUE + ) +}) + +test_that("Functions with SUNDIALS/KINSOL methods link correctly", { + modcode <- " + functions { + vector dummy_functor(vector guess, vector theta, data array[] real tails, data array[] int x_i) { + return [1, 1]'; + } + vector call_solver(vector guess, vector theta, data array[] real tails, data array[] int x_i) { + return algebra_solver_newton(dummy_functor, guess, theta, tails, x_i); + } + }" + mod <- cmdstan_model(write_stan_file(modcode), force_recompile=TRUE) + expect_no_error(mod$expose_functions()) +}) From 09b43e5822115ff2c9733f23ebbacea0f60c7b6c Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Tue, 10 Mar 2026 10:14:23 -0700 Subject: [PATCH 2/3] Error out, simplify detection --- R/utils.R | 26 +++++++++----------- tests/testthat/test-model-expose-functions.R | 8 +++--- 2 files changed, 15 insertions(+), 19 deletions(-) diff --git a/R/utils.R b/R/utils.R index c5b5f9b38..55363ab02 100644 --- a/R/utils.R +++ b/R/utils.R @@ -944,27 +944,23 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { funs <- grep("// [[stan::function]]", env$hpp_code, fixed = TRUE) funs <- c(funs, length(env$hpp_code)) - reserved_names <- unique(unlist(lapply(seq_len(length(funs) - 1), function(ind) { - fun_end <- funs[ind + 1] - fun_end <- ifelse(env$hpp_code[fun_end] == "}", fun_end, fun_end - 1) - fun_signature <- sub("\\{.*", "", paste(env$hpp_code[(funs[ind] + 1):fun_end], collapse = " ")) - sub( - "^_stan_", - "", - regmatches( - fun_signature, - gregexpr("_stan_[[:alnum:]_]+", fun_signature, perl = TRUE) - )[[1]] - ) - }), use.names = FALSE)) + hpp_code <- paste(env$hpp_code, collapse = " ") + reserved_names <- unique( + regmatches( + hpp_code, + gregexpr("(?<=_stan_)[[:alnum:]_]+", hpp_code, perl = TRUE) + )[[1]] + ) + if (length(reserved_names) > 0) { - warning( + stop( paste0( "expose_functions() can't expose this Stan function because the function ", "name and/or one or more argument names use a reserved keyword ", "(typically in the C++ toolchain used to compile Stan). Please rename ", "the function/arguments in your Stan functions block and try again. ", - "Conflicting names: ", paste(reserved_names, collapse = ", ") + "Conflicting names: ", + paste(reserved_names, collapse = ", ") ), call. = FALSE ) diff --git a/tests/testthat/test-model-expose-functions.R b/tests/testthat/test-model-expose-functions.R index 3382bed1e..2d34554de 100644 --- a/tests/testthat/test-model-expose-functions.R +++ b/tests/testthat/test-model-expose-functions.R @@ -398,11 +398,11 @@ test_that("Reserved names in Stan code give the same error", { return max - class; } } - " + " ) funmod <- cmdstan_model(stan_file, force_recompile = TRUE) - expect_warning( + expect_error( funmod$expose_functions(), reserved_names_msg(c("min", "max", "class")), fixed = TRUE @@ -421,7 +421,7 @@ test_that("Multiple reserved C++ keywords in Stan code give the same error", { ) funmod <- cmdstan_model(stan_file, force_recompile = TRUE) - expect_warning( + expect_error( funmod$expose_functions(), reserved_names_msg(c("template", "class", "namespace", "private")), fixed = TRUE @@ -432,7 +432,7 @@ test_that("Stan code with no reserved names exposes functions", { stan_file <- write_stan_file( " functions { - real add(real left, real right) { + real add_pair(real left, real right) { return left + right; } } From 818c32e25a4cee4b4c3e34705afd575b24ed64bb Mon Sep 17 00:00:00 2001 From: VisruthSK <67435125+VisruthSK@users.noreply.github.com> Date: Wed, 11 Mar 2026 16:42:05 -0700 Subject: [PATCH 3/3] Look wrapper sigs; force lf line ending --- .gitattributes | 2 + R/utils.R | 26 +- tests/testthat/test-model-expose-functions.R | 887 ++++++++++--------- 3 files changed, 469 insertions(+), 446 deletions(-) create mode 100644 .gitattributes diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 000000000..35c0dc0e9 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +* text=auto eol=lf +*.rda binary diff --git a/R/utils.R b/R/utils.R index 55363ab02..3bb907700 100644 --- a/R/utils.R +++ b/R/utils.R @@ -944,12 +944,22 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { funs <- grep("// [[stan::function]]", env$hpp_code, fixed = TRUE) funs <- c(funs, length(env$hpp_code)) - hpp_code <- paste(env$hpp_code, collapse = " ") + stan_funs <- sapply(seq_len(length(funs) - 1), function(ind) { + fun_end <- funs[ind + 1] + fun_end <- ifelse(env$hpp_code[fun_end] == "}", fun_end, fun_end - 1) + prep_fun_cpp(funs[ind], fun_end, env$hpp_code) + }) + reserved_names <- unique( - regmatches( - hpp_code, - gregexpr("(?<=_stan_)[[:alnum:]_]+", hpp_code, perl = TRUE) - )[[1]] + unlist( + lapply(stan_funs, function(stan_fun) { + regmatches( + stan_fun, + gregexpr("(?<=_stan_)[[:alnum:]_]+", stan_fun, perl = TRUE) + )[[1]] + }), + use.names = FALSE + ) ) if (length(reserved_names) > 0) { @@ -966,12 +976,6 @@ compile_functions <- function(env, verbose = FALSE, global = FALSE) { ) } - stan_funs <- sapply(seq_len(length(funs) - 1), function(ind) { - fun_end <- funs[ind + 1] - fun_end <- ifelse(env$hpp_code[fun_end] == "}", fun_end, fun_end - 1) - prep_fun_cpp(funs[ind], fun_end, env$hpp_code) - }) - env$fun_names <- sapply(seq_len(length(funs) - 1), function(ind) { get_function_name(funs[ind], funs[ind + 1], env$hpp_code) }) diff --git a/tests/testthat/test-model-expose-functions.R b/tests/testthat/test-model-expose-functions.R index 2d34554de..7373cfad8 100644 --- a/tests/testthat/test-model-expose-functions.R +++ b/tests/testthat/test-model-expose-functions.R @@ -1,381 +1,381 @@ -context("model-expose-functions") - -# Standalone functions not expected to work on WSL yet -skip_if(os_is_wsl()) - -set_cmdstan_path() - -function_decl <- " -functions { - int rtn_int(int x) { return x; } - real rtn_real(real x) { return x; } - vector rtn_vec(vector x) { return x; } - row_vector rtn_rowvec(row_vector x) { return x; } - matrix rtn_matrix(matrix x) { return x; } - - array[] int rtn_int_array(array[] int x) { return x; } - array[] real rtn_real_array(array[] real x) { return x; } - array[] vector rtn_vec_array(array[] vector x) { return x; } - array[] row_vector rtn_rowvec_array(array[] row_vector x) { return x; } - array[] matrix rtn_matrix_array(array[] matrix x) { return x; } - - tuple(int, int) rtn_tuple_int(tuple(int, int) x) { return x; } - tuple(real, real) rtn_tuple_real(tuple(real, real) x) { return x; } - tuple(vector, vector) rtn_tuple_vec(tuple(vector, vector) x) { return x; } - tuple(row_vector, row_vector) rtn_tuple_rowvec(tuple(row_vector, row_vector) x) { return x; } - tuple(matrix, matrix) rtn_tuple_matrix(tuple(matrix, matrix) x) { return x; } - - tuple(array[] int, array[] int) rtn_tuple_int_array(tuple(array[] int, array[] int) x) { return x; } - tuple(array[] real, array[] real) rtn_tuple_real_array(tuple(array[] real, array[] real) x) { return x; } - tuple(array[] vector, array[] vector) rtn_tuple_vec_array(tuple(array[] vector, array[] vector) x) { return x; } - tuple(array[] row_vector, array[] row_vector) rtn_tuple_rowvec_array(tuple(array[] row_vector, array[] row_vector) x) { return x; } - tuple(array[] matrix, array[] matrix) rtn_tuple_matrix_array(tuple(array[] matrix, array[] matrix) x) { return x; } - - tuple(int, tuple(int, int)) rtn_nest_tuple_int(tuple(int, tuple(int, int)) x) { return x; } - tuple(int, tuple(real, real)) rtn_nest_tuple_real(tuple(int, tuple(real, real)) x) { return x; } - tuple(int, tuple(vector, vector)) rtn_nest_tuple_vec(tuple(int, tuple(vector, vector)) x) { return x; } - tuple(int, tuple(row_vector, row_vector)) rtn_nest_tuple_rowvec(tuple(int, tuple(row_vector, row_vector)) x) { return x; } - tuple(int, tuple(matrix, matrix)) rtn_nest_tuple_matrix(tuple(int, tuple(matrix, matrix)) x) { return x; } - - tuple(int, tuple(array[] int, array[] int)) rtn_nest_tuple_int_array(tuple(int, tuple(array[] int, array[] int)) x) { return x; } - tuple(int, tuple(array[] real, array[] real)) rtn_nest_tuple_real_array(tuple(int, tuple(array[] real, array[] real)) x) { return x; } - tuple(int, tuple(array[] vector, array[] vector)) rtn_nest_tuple_vec_array(tuple(int, tuple(array[] vector, array[] vector)) x) { return x; } - tuple(int, tuple(array[] row_vector, array[] row_vector)) rtn_nest_tuple_rowvec_array(tuple(int, tuple(array[] row_vector, array[] row_vector)) x) { return x; } - tuple(int, tuple(array[] matrix, array[] matrix)) rtn_nest_tuple_matrix_array(tuple(int, tuple(array[] matrix, array[] matrix)) x) { return x; } - - complex rtn_complex(complex x) { return x; } - complex_vector rtn_complex_vec(complex_vector x) { return x; } - complex_row_vector rtn_complex_rowvec(complex_row_vector x) { return x; } - complex_matrix rtn_complex_matrix(complex_matrix x) { return x; } - - array[] complex rtn_complex_array(array[] complex x) { return x; } - array[] complex_vector rtn_complex_vec_array(array[] complex_vector x) { return x; } - array[] complex_row_vector rtn_complex_rowvec_array(array[] complex_row_vector x) { return x; } - array[] complex_matrix rtn_complex_matrix_array(array[] complex_matrix x) { return x; } - - tuple(complex, complex) rtn_tuple_complex(tuple(complex, complex) x) { return x; } - tuple(complex_vector, complex_vector) rtn_tuple_complex_vec(tuple(complex_vector, complex_vector) x) { return x; } - tuple(complex_row_vector, complex_row_vector) rtn_tuple_complex_rowvec(tuple(complex_row_vector, complex_row_vector) x) { return x; } - tuple(complex_matrix, complex_matrix) rtn_tuple_complex_matrix(tuple(complex_matrix, complex_matrix) x) { return x; } - - tuple(array[] complex, array[] complex) rtn_tuple_complex_array(tuple(array[] complex, array[] complex) x) { return x; } - tuple(array[] complex_vector, array[] complex_vector) rtn_tuple_complex_vec_array(tuple(array[] complex_vector, array[] complex_vector) x) { return x; } - tuple(array[] complex_row_vector, array[] complex_row_vector) rtn_tuple_complex_rowvec_array(tuple(array[] complex_row_vector, array[] complex_row_vector) x) { return x; } - tuple(array[] complex_matrix, array[] complex_matrix) rtn_tuple_complex_matrix_array(tuple(array[] complex_matrix, array[] complex_matrix) x) { return x; } - - tuple(int, tuple(complex, complex)) rtn_nest_tuple_complex(tuple(int, tuple(complex, complex)) x) { return x; } - tuple(int, tuple(complex_vector, complex_vector)) rtn_nest_tuple_complex_vec(tuple(int, tuple(complex_vector, complex_vector)) x) { return x; } - tuple(int, tuple(complex_row_vector, complex_row_vector)) rtn_nest_tuple_complex_rowvec(tuple(int, tuple(complex_row_vector, complex_row_vector)) x) { return x; } - tuple(int, tuple(complex_matrix, complex_matrix)) rtn_nest_tuple_complex_matrix(tuple(int, tuple(complex_matrix, complex_matrix)) x) { return x; } - - tuple(int, tuple(array[] complex, array[] complex)) rtn_nest_tuple_complex_array(tuple(int, tuple(array[] complex, array[] complex)) x) { return x; } - tuple(int, tuple(array[] complex_vector, array[] complex_vector)) rtn_nest_tuple_complex_vec_array(tuple(int, tuple(array[] complex_vector, array[] complex_vector)) x) { return x; } - tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) rtn_nest_tuple_complex_rowvec_array(tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) x) { return x; } - tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) rtn_nest_tuple_complex_matrix_array(tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) x) { return x; } -}" -stan_prog <- paste(function_decl, - paste(readLines(testing_stan_file("bernoulli")), - collapse = "\n"), - collapse = "\n") -model <- write_stan_file(stan_prog) -data_list <- testing_data("bernoulli") -mod <- cmdstan_model(model, force_recompile = TRUE) -utils::capture.output( - fit <- mod$sample(data = data_list) -) - - -test_that("Functions can be exposed in model object", { - expect_no_error(mod$expose_functions()) -}) - - -test_that("Functions handle types correctly", { - ### Scalar - - expect_equal(mod$functions$rtn_int(10), 10) - expect_equal(mod$functions$rtn_real(1.67), 1.67) - - ### Container - - vec <- c(1.2,234,0.3,-0.4) - rowvec <- t(vec) - matrix <- matrix(c(2.11, -6.35, 4.87, -0.9871), nrow = 2, ncol = 2) - - expect_equal(mod$functions$rtn_vec(vec), vec) - expect_equal(mod$functions$rtn_rowvec(vec), t(vec)) - expect_equal(mod$functions$rtn_matrix(matrix), matrix) - expect_equal(mod$functions$rtn_int_array(1:5), 1:5) - expect_equal(mod$functions$rtn_real_array(vec), vec) - - ### Array of Container - - vec_array <- list(vec, vec * 2, vec + 0.1) - rowvec_array <- list(rowvec, rowvec * 2, rowvec + 0.1) - matrix_array <- list(matrix, matrix * 2, matrix + 0.1) - - expect_equal(mod$functions$rtn_vec_array(vec_array), vec_array) - expect_equal(mod$functions$rtn_rowvec_array(rowvec_array), rowvec_array) - expect_equal(mod$functions$rtn_matrix_array(matrix_array), matrix_array) - - ### Tuple of Scalar - - tuple_int <- list(10, 35) - tuple_dbl <- list(31.87, -19.09) - expect_equal(mod$functions$rtn_tuple_int(tuple_int), tuple_int) - expect_equal(mod$functions$rtn_tuple_real(tuple_dbl), tuple_dbl) - - ### Tuple of Container - - tuple_vec <- list(vec, vec * 12) - tuple_rowvec <- list(rowvec, rowvec * 0.5) - tuple_matrix <- list(matrix, matrix * 0.23) - tuple_int_array <- list(1:10, -3:2) - - expect_equal(mod$functions$rtn_tuple_vec(tuple_vec), tuple_vec) - expect_equal(mod$functions$rtn_tuple_rowvec(tuple_rowvec), tuple_rowvec) - expect_equal(mod$functions$rtn_tuple_matrix(tuple_matrix), tuple_matrix) - expect_equal(mod$functions$rtn_tuple_int_array(tuple_int_array), tuple_int_array) - expect_equal(mod$functions$rtn_tuple_real_array(tuple_vec), tuple_vec) - - ### Tuple of Container Arrays - - tuple_vec_array <- list(vec_array, vec_array) - tuple_rowvec_array <- list(rowvec_array, rowvec_array) - tuple_matrix_array <- list(matrix_array, matrix_array) - - expect_equal(mod$functions$rtn_tuple_vec_array(tuple_vec_array), tuple_vec_array) - expect_equal(mod$functions$rtn_tuple_rowvec_array(tuple_rowvec_array), tuple_rowvec_array) - expect_equal(mod$functions$rtn_tuple_matrix_array(tuple_matrix_array), tuple_matrix_array) - - ### Nested Tuple of Scalar - - nest_tuple_int <- list(10, tuple_int) - nest_tuple_dbl <- list(31, tuple_dbl) - expect_equal(mod$functions$rtn_nest_tuple_int(nest_tuple_int), nest_tuple_int) - expect_equal(mod$functions$rtn_nest_tuple_real(nest_tuple_dbl), nest_tuple_dbl) - - ### Nested Tuple of Container - - nest_tuple_vec <- list(12, tuple_vec) - nest_tuple_rowvec <- list(2, tuple_rowvec) - nest_tuple_matrix <- list(-23, tuple_matrix) - nest_tuple_int_array <- list(21, tuple_int_array) - - expect_equal(mod$functions$rtn_nest_tuple_vec(nest_tuple_vec), nest_tuple_vec) - expect_equal(mod$functions$rtn_nest_tuple_rowvec(nest_tuple_rowvec), nest_tuple_rowvec) - expect_equal(mod$functions$rtn_nest_tuple_matrix(nest_tuple_matrix), nest_tuple_matrix) - expect_equal(mod$functions$rtn_nest_tuple_int_array(nest_tuple_int_array), nest_tuple_int_array) - expect_equal(mod$functions$rtn_nest_tuple_real_array(nest_tuple_vec), nest_tuple_vec) - - ### Nested Tuple of Container Arrays - - nest_tuple_vec_array <- list(-21, tuple_vec_array) - nest_tuple_rowvec_array <- list(1000, tuple_rowvec_array) - nest_tuple_matrix_array <- list(0, tuple_matrix_array) - - expect_equal(mod$functions$rtn_nest_tuple_vec_array(nest_tuple_vec_array), nest_tuple_vec_array) - expect_equal(mod$functions$rtn_nest_tuple_rowvec_array(nest_tuple_rowvec_array), nest_tuple_rowvec_array) - expect_equal(mod$functions$rtn_nest_tuple_matrix_array(nest_tuple_matrix_array), nest_tuple_matrix_array) -}) - -test_that("Functions handle complex types correctly", { - ### Scalar - - complex_scalar <- complex(real = 2.1, imaginary = 21.3) - - expect_equal(mod$functions$rtn_complex(complex_scalar), complex_scalar) - - ### Container - - complex_vec <- complex(real = c(2,1.5,0.11, 1.2), imaginary = c(11.2,21.5,6.1,3.2)) - complex_rowvec <- t(complex_vec) - complex_matrix <- matrix(complex_vec, nrow=2, ncol=2) - - expect_equal(mod$functions$rtn_complex_vec(complex_vec), complex_vec) - expect_equal(mod$functions$rtn_complex_rowvec(complex_rowvec), complex_rowvec) - expect_equal(mod$functions$rtn_complex_matrix(complex_matrix), complex_matrix) - expect_equal(mod$functions$rtn_complex_array(complex_vec), complex_vec) - - ### Array of Container - - complex_vec_array <- list(complex_vec, complex_vec * 2, complex_vec + 0.1) - complex_rowvec_array <- list(complex_rowvec, complex_rowvec * 2, complex_rowvec + 0.1) - complex_matrix_array <- list(complex_matrix, complex_matrix * 2, complex_matrix + 0.1) - - expect_equal(mod$functions$rtn_complex_vec_array(complex_vec_array), complex_vec_array) - expect_equal(mod$functions$rtn_complex_rowvec_array(complex_rowvec_array), complex_rowvec_array) - expect_equal(mod$functions$rtn_complex_matrix_array(complex_matrix_array), complex_matrix_array) - - ### Tuple of Scalar - - tuple_complex <- list(complex_vec[1], complex_vec[2]) - expect_equal(mod$functions$rtn_tuple_complex(tuple_complex), tuple_complex) - - ### Tuple of Container - - tuple_complex_vec <- list(complex_vec, complex_vec * 1.2) - tuple_complex_rowvec <- list(complex_rowvec, complex_rowvec * 0.5) - tuple_complex_matrix <- list(complex_matrix, complex_matrix * 10.2) - - expect_equal(mod$functions$rtn_tuple_complex_array(tuple_complex_vec), tuple_complex_vec) - expect_equal(mod$functions$rtn_tuple_complex_vec(tuple_complex_vec), tuple_complex_vec) - expect_equal(mod$functions$rtn_tuple_complex_rowvec(tuple_complex_rowvec), tuple_complex_rowvec) - expect_equal(mod$functions$rtn_tuple_complex_matrix(tuple_complex_matrix), tuple_complex_matrix) - - ### Tuple of Container Arrays - - tuple_complex_vec_array <- list(complex_vec_array, complex_vec_array) - tuple_complex_rowvec_array <- list(complex_rowvec_array, complex_rowvec_array) - tuple_complex_matrix_array <- list(complex_matrix_array, complex_matrix_array) - - expect_equal(mod$functions$rtn_tuple_complex_vec_array(tuple_complex_vec_array), tuple_complex_vec_array) - expect_equal(mod$functions$rtn_tuple_complex_rowvec_array(tuple_complex_rowvec_array), tuple_complex_rowvec_array) - expect_equal(mod$functions$rtn_tuple_complex_matrix_array(tuple_complex_matrix_array), tuple_complex_matrix_array) - - ### Nested Tuple of Scalar - - nest_tuple_complex <- list(31, tuple_complex) - expect_equal(mod$functions$rtn_nest_tuple_complex(nest_tuple_complex), nest_tuple_complex) - - ### Nested Tuple of Container - - nest_tuple_complex_vec <- list(12, tuple_complex_vec) - nest_tuple_complex_rowvec <- list(2, tuple_complex_rowvec) - nest_tuple_complex_matrix <- list(-23, tuple_complex_matrix) - nest_tuple_complex_array <- list(21, tuple_complex_vec) - - expect_equal(mod$functions$rtn_nest_tuple_complex_array(nest_tuple_complex_vec), nest_tuple_complex_vec) - expect_equal(mod$functions$rtn_nest_tuple_complex_vec(nest_tuple_complex_vec), nest_tuple_complex_vec) - expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec(nest_tuple_complex_rowvec), nest_tuple_complex_rowvec) - expect_equal(mod$functions$rtn_nest_tuple_complex_matrix(nest_tuple_complex_matrix), nest_tuple_complex_matrix) - - ### Nested Tuple of Container Arrays - - nest_tuple_complex_vec_array <- list(-21, tuple_complex_vec_array) - nest_tuple_complex_rowvec_array <- list(1000, tuple_complex_rowvec_array) - nest_tuple_complex_matrix_array <- list(0, tuple_complex_matrix_array) - - expect_equal(mod$functions$rtn_nest_tuple_complex_vec_array(nest_tuple_complex_vec_array), nest_tuple_complex_vec_array) - expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec_array(nest_tuple_complex_rowvec_array), nest_tuple_complex_rowvec_array) - expect_equal(mod$functions$rtn_nest_tuple_complex_matrix_array(nest_tuple_complex_matrix_array), nest_tuple_complex_matrix_array) -}) - -test_that("Functions can be exposed in fit object", { - fit$expose_functions() - - expect_equal( - fit$functions$rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) -}) - -test_that("Compiled functions can be copied to global environment", { - expect_message( - fit$expose_functions(global = TRUE), - "Functions already compiled, copying to global environment", - fixed = TRUE - ) - - expect_equal( - rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) -}) - - -test_that("Functions can be compiled with model", { - mod <- cmdstan_model(model, force_recompile = TRUE, compile_standalone = TRUE) - utils::capture.output( - fit <- mod$sample(data = data_list) - ) - - expect_message( - fit$expose_functions(), - "Functions already compiled, nothing to do!", - fixed = TRUE - ) - - expect_equal( - fit$functions$rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) - - expect_message( - fit$expose_functions(global = TRUE), - "Functions already compiled, copying to global environment", - fixed = TRUE - ) - - expect_equal( - rtn_vec(c(1,2,3,4)), - c(1,2,3,4) - ) -}) - -test_that("compile_standalone warns but doesn't error if no functions", { - stan_no_funs_block <- write_stan_file(" - parameters { - real x; - } - model { - x ~ std_normal(); - } - ") - expect_warning( - mod1 <- cmdstan_model(stan_no_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), - "No standalone functions found to compile and expose to R" - ) - checkmate::expect_r6(mod1, "CmdStanModel") - - stan_empty_funs_block <- write_stan_file(" - functions { - } - ") - expect_warning( - mod2 <- cmdstan_model(stan_empty_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), - "No standalone functions found to compile and expose to R" - ) - checkmate::expect_r6(mod2, "CmdStanModel") -}) - -test_that("rng functions can be exposed", { - function_decl <- "functions { real wrap_normal_rng(real mu, real sigma) { return normal_rng(mu, sigma); } }" - stan_prog <- paste(function_decl, - paste(readLines(testing_stan_file("bernoulli")), - collapse = "\n"), - collapse = "\n") - model <- write_stan_file(stan_prog) - data_list <- testing_data("bernoulli") - mod <- cmdstan_model(model, force_recompile = TRUE) - utils::capture.output( - fit <- mod$sample(data = data_list) - ) - - fit$expose_functions() - set.seed(10) - res1_1 <- fit$functions$wrap_normal_rng(5,10) - res2_1 <- fit$functions$wrap_normal_rng(5,10) - set.seed(10) - res1_2 <- fit$functions$wrap_normal_rng(5,10) - res2_2 <- fit$functions$wrap_normal_rng(5,10) - - expect_equal(res1_1, res1_2) - expect_equal(res2_1, res2_2) -}) - +context("model-expose-functions") + +# Standalone functions not expected to work on WSL yet +skip_if(os_is_wsl()) + +set_cmdstan_path() + +function_decl <- " +functions { + int rtn_int(int x) { return x; } + real rtn_real(real x) { return x; } + vector rtn_vec(vector x) { return x; } + row_vector rtn_rowvec(row_vector x) { return x; } + matrix rtn_matrix(matrix x) { return x; } + + array[] int rtn_int_array(array[] int x) { return x; } + array[] real rtn_real_array(array[] real x) { return x; } + array[] vector rtn_vec_array(array[] vector x) { return x; } + array[] row_vector rtn_rowvec_array(array[] row_vector x) { return x; } + array[] matrix rtn_matrix_array(array[] matrix x) { return x; } + + tuple(int, int) rtn_tuple_int(tuple(int, int) x) { return x; } + tuple(real, real) rtn_tuple_real(tuple(real, real) x) { return x; } + tuple(vector, vector) rtn_tuple_vec(tuple(vector, vector) x) { return x; } + tuple(row_vector, row_vector) rtn_tuple_rowvec(tuple(row_vector, row_vector) x) { return x; } + tuple(matrix, matrix) rtn_tuple_matrix(tuple(matrix, matrix) x) { return x; } + + tuple(array[] int, array[] int) rtn_tuple_int_array(tuple(array[] int, array[] int) x) { return x; } + tuple(array[] real, array[] real) rtn_tuple_real_array(tuple(array[] real, array[] real) x) { return x; } + tuple(array[] vector, array[] vector) rtn_tuple_vec_array(tuple(array[] vector, array[] vector) x) { return x; } + tuple(array[] row_vector, array[] row_vector) rtn_tuple_rowvec_array(tuple(array[] row_vector, array[] row_vector) x) { return x; } + tuple(array[] matrix, array[] matrix) rtn_tuple_matrix_array(tuple(array[] matrix, array[] matrix) x) { return x; } + + tuple(int, tuple(int, int)) rtn_nest_tuple_int(tuple(int, tuple(int, int)) x) { return x; } + tuple(int, tuple(real, real)) rtn_nest_tuple_real(tuple(int, tuple(real, real)) x) { return x; } + tuple(int, tuple(vector, vector)) rtn_nest_tuple_vec(tuple(int, tuple(vector, vector)) x) { return x; } + tuple(int, tuple(row_vector, row_vector)) rtn_nest_tuple_rowvec(tuple(int, tuple(row_vector, row_vector)) x) { return x; } + tuple(int, tuple(matrix, matrix)) rtn_nest_tuple_matrix(tuple(int, tuple(matrix, matrix)) x) { return x; } + + tuple(int, tuple(array[] int, array[] int)) rtn_nest_tuple_int_array(tuple(int, tuple(array[] int, array[] int)) x) { return x; } + tuple(int, tuple(array[] real, array[] real)) rtn_nest_tuple_real_array(tuple(int, tuple(array[] real, array[] real)) x) { return x; } + tuple(int, tuple(array[] vector, array[] vector)) rtn_nest_tuple_vec_array(tuple(int, tuple(array[] vector, array[] vector)) x) { return x; } + tuple(int, tuple(array[] row_vector, array[] row_vector)) rtn_nest_tuple_rowvec_array(tuple(int, tuple(array[] row_vector, array[] row_vector)) x) { return x; } + tuple(int, tuple(array[] matrix, array[] matrix)) rtn_nest_tuple_matrix_array(tuple(int, tuple(array[] matrix, array[] matrix)) x) { return x; } + + complex rtn_complex(complex x) { return x; } + complex_vector rtn_complex_vec(complex_vector x) { return x; } + complex_row_vector rtn_complex_rowvec(complex_row_vector x) { return x; } + complex_matrix rtn_complex_matrix(complex_matrix x) { return x; } + + array[] complex rtn_complex_array(array[] complex x) { return x; } + array[] complex_vector rtn_complex_vec_array(array[] complex_vector x) { return x; } + array[] complex_row_vector rtn_complex_rowvec_array(array[] complex_row_vector x) { return x; } + array[] complex_matrix rtn_complex_matrix_array(array[] complex_matrix x) { return x; } + + tuple(complex, complex) rtn_tuple_complex(tuple(complex, complex) x) { return x; } + tuple(complex_vector, complex_vector) rtn_tuple_complex_vec(tuple(complex_vector, complex_vector) x) { return x; } + tuple(complex_row_vector, complex_row_vector) rtn_tuple_complex_rowvec(tuple(complex_row_vector, complex_row_vector) x) { return x; } + tuple(complex_matrix, complex_matrix) rtn_tuple_complex_matrix(tuple(complex_matrix, complex_matrix) x) { return x; } + + tuple(array[] complex, array[] complex) rtn_tuple_complex_array(tuple(array[] complex, array[] complex) x) { return x; } + tuple(array[] complex_vector, array[] complex_vector) rtn_tuple_complex_vec_array(tuple(array[] complex_vector, array[] complex_vector) x) { return x; } + tuple(array[] complex_row_vector, array[] complex_row_vector) rtn_tuple_complex_rowvec_array(tuple(array[] complex_row_vector, array[] complex_row_vector) x) { return x; } + tuple(array[] complex_matrix, array[] complex_matrix) rtn_tuple_complex_matrix_array(tuple(array[] complex_matrix, array[] complex_matrix) x) { return x; } + + tuple(int, tuple(complex, complex)) rtn_nest_tuple_complex(tuple(int, tuple(complex, complex)) x) { return x; } + tuple(int, tuple(complex_vector, complex_vector)) rtn_nest_tuple_complex_vec(tuple(int, tuple(complex_vector, complex_vector)) x) { return x; } + tuple(int, tuple(complex_row_vector, complex_row_vector)) rtn_nest_tuple_complex_rowvec(tuple(int, tuple(complex_row_vector, complex_row_vector)) x) { return x; } + tuple(int, tuple(complex_matrix, complex_matrix)) rtn_nest_tuple_complex_matrix(tuple(int, tuple(complex_matrix, complex_matrix)) x) { return x; } + + tuple(int, tuple(array[] complex, array[] complex)) rtn_nest_tuple_complex_array(tuple(int, tuple(array[] complex, array[] complex)) x) { return x; } + tuple(int, tuple(array[] complex_vector, array[] complex_vector)) rtn_nest_tuple_complex_vec_array(tuple(int, tuple(array[] complex_vector, array[] complex_vector)) x) { return x; } + tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) rtn_nest_tuple_complex_rowvec_array(tuple(int, tuple(array[] complex_row_vector, array[] complex_row_vector)) x) { return x; } + tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) rtn_nest_tuple_complex_matrix_array(tuple(int, tuple(array[] complex_matrix, array[] complex_matrix)) x) { return x; } +}" +stan_prog <- paste(function_decl, + paste(readLines(testing_stan_file("bernoulli")), + collapse = "\n"), + collapse = "\n") +model <- write_stan_file(stan_prog) +data_list <- testing_data("bernoulli") +mod <- cmdstan_model(model, force_recompile = TRUE) +utils::capture.output( + fit <- mod$sample(data = data_list) +) + + +test_that("Functions can be exposed in model object", { + expect_no_error(mod$expose_functions()) +}) + + +test_that("Functions handle types correctly", { + ### Scalar + + expect_equal(mod$functions$rtn_int(10), 10) + expect_equal(mod$functions$rtn_real(1.67), 1.67) + + ### Container + + vec <- c(1.2,234,0.3,-0.4) + rowvec <- t(vec) + matrix <- matrix(c(2.11, -6.35, 4.87, -0.9871), nrow = 2, ncol = 2) + + expect_equal(mod$functions$rtn_vec(vec), vec) + expect_equal(mod$functions$rtn_rowvec(vec), t(vec)) + expect_equal(mod$functions$rtn_matrix(matrix), matrix) + expect_equal(mod$functions$rtn_int_array(1:5), 1:5) + expect_equal(mod$functions$rtn_real_array(vec), vec) + + ### Array of Container + + vec_array <- list(vec, vec * 2, vec + 0.1) + rowvec_array <- list(rowvec, rowvec * 2, rowvec + 0.1) + matrix_array <- list(matrix, matrix * 2, matrix + 0.1) + + expect_equal(mod$functions$rtn_vec_array(vec_array), vec_array) + expect_equal(mod$functions$rtn_rowvec_array(rowvec_array), rowvec_array) + expect_equal(mod$functions$rtn_matrix_array(matrix_array), matrix_array) + + ### Tuple of Scalar + + tuple_int <- list(10, 35) + tuple_dbl <- list(31.87, -19.09) + expect_equal(mod$functions$rtn_tuple_int(tuple_int), tuple_int) + expect_equal(mod$functions$rtn_tuple_real(tuple_dbl), tuple_dbl) + + ### Tuple of Container + + tuple_vec <- list(vec, vec * 12) + tuple_rowvec <- list(rowvec, rowvec * 0.5) + tuple_matrix <- list(matrix, matrix * 0.23) + tuple_int_array <- list(1:10, -3:2) + + expect_equal(mod$functions$rtn_tuple_vec(tuple_vec), tuple_vec) + expect_equal(mod$functions$rtn_tuple_rowvec(tuple_rowvec), tuple_rowvec) + expect_equal(mod$functions$rtn_tuple_matrix(tuple_matrix), tuple_matrix) + expect_equal(mod$functions$rtn_tuple_int_array(tuple_int_array), tuple_int_array) + expect_equal(mod$functions$rtn_tuple_real_array(tuple_vec), tuple_vec) + + ### Tuple of Container Arrays + + tuple_vec_array <- list(vec_array, vec_array) + tuple_rowvec_array <- list(rowvec_array, rowvec_array) + tuple_matrix_array <- list(matrix_array, matrix_array) + + expect_equal(mod$functions$rtn_tuple_vec_array(tuple_vec_array), tuple_vec_array) + expect_equal(mod$functions$rtn_tuple_rowvec_array(tuple_rowvec_array), tuple_rowvec_array) + expect_equal(mod$functions$rtn_tuple_matrix_array(tuple_matrix_array), tuple_matrix_array) + + ### Nested Tuple of Scalar + + nest_tuple_int <- list(10, tuple_int) + nest_tuple_dbl <- list(31, tuple_dbl) + expect_equal(mod$functions$rtn_nest_tuple_int(nest_tuple_int), nest_tuple_int) + expect_equal(mod$functions$rtn_nest_tuple_real(nest_tuple_dbl), nest_tuple_dbl) + + ### Nested Tuple of Container + + nest_tuple_vec <- list(12, tuple_vec) + nest_tuple_rowvec <- list(2, tuple_rowvec) + nest_tuple_matrix <- list(-23, tuple_matrix) + nest_tuple_int_array <- list(21, tuple_int_array) + + expect_equal(mod$functions$rtn_nest_tuple_vec(nest_tuple_vec), nest_tuple_vec) + expect_equal(mod$functions$rtn_nest_tuple_rowvec(nest_tuple_rowvec), nest_tuple_rowvec) + expect_equal(mod$functions$rtn_nest_tuple_matrix(nest_tuple_matrix), nest_tuple_matrix) + expect_equal(mod$functions$rtn_nest_tuple_int_array(nest_tuple_int_array), nest_tuple_int_array) + expect_equal(mod$functions$rtn_nest_tuple_real_array(nest_tuple_vec), nest_tuple_vec) + + ### Nested Tuple of Container Arrays + + nest_tuple_vec_array <- list(-21, tuple_vec_array) + nest_tuple_rowvec_array <- list(1000, tuple_rowvec_array) + nest_tuple_matrix_array <- list(0, tuple_matrix_array) + + expect_equal(mod$functions$rtn_nest_tuple_vec_array(nest_tuple_vec_array), nest_tuple_vec_array) + expect_equal(mod$functions$rtn_nest_tuple_rowvec_array(nest_tuple_rowvec_array), nest_tuple_rowvec_array) + expect_equal(mod$functions$rtn_nest_tuple_matrix_array(nest_tuple_matrix_array), nest_tuple_matrix_array) +}) + +test_that("Functions handle complex types correctly", { + ### Scalar + + complex_scalar <- complex(real = 2.1, imaginary = 21.3) + + expect_equal(mod$functions$rtn_complex(complex_scalar), complex_scalar) + + ### Container + + complex_vec <- complex(real = c(2,1.5,0.11, 1.2), imaginary = c(11.2,21.5,6.1,3.2)) + complex_rowvec <- t(complex_vec) + complex_matrix <- matrix(complex_vec, nrow=2, ncol=2) + + expect_equal(mod$functions$rtn_complex_vec(complex_vec), complex_vec) + expect_equal(mod$functions$rtn_complex_rowvec(complex_rowvec), complex_rowvec) + expect_equal(mod$functions$rtn_complex_matrix(complex_matrix), complex_matrix) + expect_equal(mod$functions$rtn_complex_array(complex_vec), complex_vec) + + ### Array of Container + + complex_vec_array <- list(complex_vec, complex_vec * 2, complex_vec + 0.1) + complex_rowvec_array <- list(complex_rowvec, complex_rowvec * 2, complex_rowvec + 0.1) + complex_matrix_array <- list(complex_matrix, complex_matrix * 2, complex_matrix + 0.1) + + expect_equal(mod$functions$rtn_complex_vec_array(complex_vec_array), complex_vec_array) + expect_equal(mod$functions$rtn_complex_rowvec_array(complex_rowvec_array), complex_rowvec_array) + expect_equal(mod$functions$rtn_complex_matrix_array(complex_matrix_array), complex_matrix_array) + + ### Tuple of Scalar + + tuple_complex <- list(complex_vec[1], complex_vec[2]) + expect_equal(mod$functions$rtn_tuple_complex(tuple_complex), tuple_complex) + + ### Tuple of Container + + tuple_complex_vec <- list(complex_vec, complex_vec * 1.2) + tuple_complex_rowvec <- list(complex_rowvec, complex_rowvec * 0.5) + tuple_complex_matrix <- list(complex_matrix, complex_matrix * 10.2) + + expect_equal(mod$functions$rtn_tuple_complex_array(tuple_complex_vec), tuple_complex_vec) + expect_equal(mod$functions$rtn_tuple_complex_vec(tuple_complex_vec), tuple_complex_vec) + expect_equal(mod$functions$rtn_tuple_complex_rowvec(tuple_complex_rowvec), tuple_complex_rowvec) + expect_equal(mod$functions$rtn_tuple_complex_matrix(tuple_complex_matrix), tuple_complex_matrix) + + ### Tuple of Container Arrays + + tuple_complex_vec_array <- list(complex_vec_array, complex_vec_array) + tuple_complex_rowvec_array <- list(complex_rowvec_array, complex_rowvec_array) + tuple_complex_matrix_array <- list(complex_matrix_array, complex_matrix_array) + + expect_equal(mod$functions$rtn_tuple_complex_vec_array(tuple_complex_vec_array), tuple_complex_vec_array) + expect_equal(mod$functions$rtn_tuple_complex_rowvec_array(tuple_complex_rowvec_array), tuple_complex_rowvec_array) + expect_equal(mod$functions$rtn_tuple_complex_matrix_array(tuple_complex_matrix_array), tuple_complex_matrix_array) + + ### Nested Tuple of Scalar + + nest_tuple_complex <- list(31, tuple_complex) + expect_equal(mod$functions$rtn_nest_tuple_complex(nest_tuple_complex), nest_tuple_complex) + + ### Nested Tuple of Container + + nest_tuple_complex_vec <- list(12, tuple_complex_vec) + nest_tuple_complex_rowvec <- list(2, tuple_complex_rowvec) + nest_tuple_complex_matrix <- list(-23, tuple_complex_matrix) + nest_tuple_complex_array <- list(21, tuple_complex_vec) + + expect_equal(mod$functions$rtn_nest_tuple_complex_array(nest_tuple_complex_vec), nest_tuple_complex_vec) + expect_equal(mod$functions$rtn_nest_tuple_complex_vec(nest_tuple_complex_vec), nest_tuple_complex_vec) + expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec(nest_tuple_complex_rowvec), nest_tuple_complex_rowvec) + expect_equal(mod$functions$rtn_nest_tuple_complex_matrix(nest_tuple_complex_matrix), nest_tuple_complex_matrix) + + ### Nested Tuple of Container Arrays + + nest_tuple_complex_vec_array <- list(-21, tuple_complex_vec_array) + nest_tuple_complex_rowvec_array <- list(1000, tuple_complex_rowvec_array) + nest_tuple_complex_matrix_array <- list(0, tuple_complex_matrix_array) + + expect_equal(mod$functions$rtn_nest_tuple_complex_vec_array(nest_tuple_complex_vec_array), nest_tuple_complex_vec_array) + expect_equal(mod$functions$rtn_nest_tuple_complex_rowvec_array(nest_tuple_complex_rowvec_array), nest_tuple_complex_rowvec_array) + expect_equal(mod$functions$rtn_nest_tuple_complex_matrix_array(nest_tuple_complex_matrix_array), nest_tuple_complex_matrix_array) +}) + +test_that("Functions can be exposed in fit object", { + fit$expose_functions() + + expect_equal( + fit$functions$rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + +test_that("Compiled functions can be copied to global environment", { + expect_message( + fit$expose_functions(global = TRUE), + "Functions already compiled, copying to global environment", + fixed = TRUE + ) + + expect_equal( + rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + + +test_that("Functions can be compiled with model", { + mod <- cmdstan_model(model, force_recompile = TRUE, compile_standalone = TRUE) + utils::capture.output( + fit <- mod$sample(data = data_list) + ) + + expect_message( + fit$expose_functions(), + "Functions already compiled, nothing to do!", + fixed = TRUE + ) + + expect_equal( + fit$functions$rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) + + expect_message( + fit$expose_functions(global = TRUE), + "Functions already compiled, copying to global environment", + fixed = TRUE + ) + + expect_equal( + rtn_vec(c(1,2,3,4)), + c(1,2,3,4) + ) +}) + +test_that("compile_standalone warns but doesn't error if no functions", { + stan_no_funs_block <- write_stan_file(" + parameters { + real x; + } + model { + x ~ std_normal(); + } + ") + expect_warning( + mod1 <- cmdstan_model(stan_no_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), + "No standalone functions found to compile and expose to R" + ) + checkmate::expect_r6(mod1, "CmdStanModel") + + stan_empty_funs_block <- write_stan_file(" + functions { + } + ") + expect_warning( + mod2 <- cmdstan_model(stan_empty_funs_block, compile = TRUE, compile_standalone = TRUE, force_recompile = TRUE), + "No standalone functions found to compile and expose to R" + ) + checkmate::expect_r6(mod2, "CmdStanModel") +}) + +test_that("rng functions can be exposed", { + function_decl <- "functions { real wrap_normal_rng(real mu, real sigma) { return normal_rng(mu, sigma); } }" + stan_prog <- paste(function_decl, + paste(readLines(testing_stan_file("bernoulli")), + collapse = "\n"), + collapse = "\n") + model <- write_stan_file(stan_prog) + data_list <- testing_data("bernoulli") + mod <- cmdstan_model(model, force_recompile = TRUE) + utils::capture.output( + fit <- mod$sample(data = data_list) + ) + + fit$expose_functions() + set.seed(10) + res1_1 <- fit$functions$wrap_normal_rng(5,10) + res2_1 <- fit$functions$wrap_normal_rng(5,10) + set.seed(10) + res1_2 <- fit$functions$wrap_normal_rng(5,10) + res2_2 <- fit$functions$wrap_normal_rng(5,10) + + expect_equal(res1_1, res1_2) + expect_equal(res2_1, res2_2) +}) + test_that("Overloaded functions give meaningful errors", { funcode <- " functions { real fun1(real x) { return x; } - vector fun1(vector x) { return x; } - real fun2(real x) { return x; } - matrix fun3(matrix x) { return x; } - real fun3(real x) { return x; } - } - " - - funmod <- cmdstan_model(write_stan_file(funcode), force_recompile = TRUE) + vector fun1(vector x) { return x; } + real fun2(real x) { return x; } + matrix fun3(matrix x) { return x; } + real fun3(real x) { return x; } + } + " + + funmod <- cmdstan_model(write_stan_file(funcode), force_recompile = TRUE) expect_error(funmod$expose_functions(), "Overloaded functions are currently not able to be exposed to R! The following overloaded functions were found: fun1, fun3") }) @@ -394,10 +394,10 @@ test_that("Reserved names in Stan code give the same error", { stan_file <- write_stan_file( " functions { - real min(real max, real class) { - return max - class; - } - } + real min(real max, real class) { + return max - class; + } + } " ) @@ -428,6 +428,23 @@ test_that("Multiple reserved C++ keywords in Stan code give the same error", { ) }) +test_that("Reserved keywords in Stan function bodies are allowed", { + stan_file <- write_stan_file( + " + functions { + real add_one(real x) { + real class = 1; + return x + class; + } + } + " + ) + + funmod <- cmdstan_model(stan_file, force_recompile = TRUE) + expect_no_error(funmod$expose_functions()) + expect_equal(funmod$functions$add_one(2), 3) +}) + test_that("Stan code with no reserved names exposes functions", { stan_file <- write_stan_file( " @@ -445,60 +462,60 @@ test_that("Stan code with no reserved names exposes functions", { test_that("Exposing external functions errors before v2.32", { fake_cmdstan_version("2.26.0") - - tmpfile <- tempfile(fileext = ".hpp") - hpp <- - " - #include - namespace standalone_external_model_namespace { - int rtn_int(int x, std::ostream *pstream__) { return x; } - }" - cat(hpp, file = tmpfile, sep = "\n") - stanfile <- file.path(tempdir(), "standalone_external.stan") - cat("functions { int rtn_int(int x); }\n", file = stanfile) - expect_error({ - cmdstan_model( - stan_file = stanfile, - user_header = tmpfile, - compile_standalone = TRUE - ) - }, - "Exporting standalone functions with external C++ is not available before CmdStan 2.32", - fixed = TRUE) - - reset_cmdstan_version() -}) - -test_that("Exposing functions with precompiled model gives meaningful error", { - stan_file <- write_stan_file(" - functions { - real a_plus_b(real a, real b) { return a + b; } - } - parameters { real x; } - model { x ~ std_normal(); } - ") - mod1 <- cmdstan_model(stan_file, compile_standalone = TRUE, - force_recompile = TRUE) - expect_equal(7.5, mod1$functions$a_plus_b(5, 2.5)) - - mod2 <- cmdstan_model(stan_file) - expect_error( - mod2$expose_functions(), - "Exporting standalone functions is not possible with a pre-compiled Stan model!", - fixed = TRUE - ) -}) - -test_that("Functions with SUNDIALS/KINSOL methods link correctly", { - modcode <- " - functions { - vector dummy_functor(vector guess, vector theta, data array[] real tails, data array[] int x_i) { - return [1, 1]'; - } - vector call_solver(vector guess, vector theta, data array[] real tails, data array[] int x_i) { - return algebra_solver_newton(dummy_functor, guess, theta, tails, x_i); - } - }" - mod <- cmdstan_model(write_stan_file(modcode), force_recompile=TRUE) - expect_no_error(mod$expose_functions()) -}) + + tmpfile <- tempfile(fileext = ".hpp") + hpp <- + " + #include + namespace standalone_external_model_namespace { + int rtn_int(int x, std::ostream *pstream__) { return x; } + }" + cat(hpp, file = tmpfile, sep = "\n") + stanfile <- file.path(tempdir(), "standalone_external.stan") + cat("functions { int rtn_int(int x); }\n", file = stanfile) + expect_error({ + cmdstan_model( + stan_file = stanfile, + user_header = tmpfile, + compile_standalone = TRUE + ) + }, + "Exporting standalone functions with external C++ is not available before CmdStan 2.32", + fixed = TRUE) + + reset_cmdstan_version() +}) + +test_that("Exposing functions with precompiled model gives meaningful error", { + stan_file <- write_stan_file(" + functions { + real a_plus_b(real a, real b) { return a + b; } + } + parameters { real x; } + model { x ~ std_normal(); } + ") + mod1 <- cmdstan_model(stan_file, compile_standalone = TRUE, + force_recompile = TRUE) + expect_equal(7.5, mod1$functions$a_plus_b(5, 2.5)) + + mod2 <- cmdstan_model(stan_file) + expect_error( + mod2$expose_functions(), + "Exporting standalone functions is not possible with a pre-compiled Stan model!", + fixed = TRUE + ) +}) + +test_that("Functions with SUNDIALS/KINSOL methods link correctly", { + modcode <- " + functions { + vector dummy_functor(vector guess, vector theta, data array[] real tails, data array[] int x_i) { + return [1, 1]'; + } + vector call_solver(vector guess, vector theta, data array[] real tails, data array[] int x_i) { + return algebra_solver_newton(dummy_functor, guess, theta, tails, x_i); + } + }" + mod <- cmdstan_model(write_stan_file(modcode), force_recompile=TRUE) + expect_no_error(mod$expose_functions()) +})