test functions

This commit is contained in:
Tom Elliott 2025-01-09 12:58:49 +13:00
parent 16ed412cd7
commit 1a3d6de032
2 changed files with 20 additions and 9 deletions

View File

@ -8,7 +8,14 @@ parse_args <- function(x, mc) {
)
}
args <- lapply(names(fmls), function(n) {
fmls[[n]]$check(eval(mc[[n]]))
tryCatch(
{
fmls[[n]]$check(eval(mc[[n]]))
},
error = function(e) {
stop("Invalid argument '", n, "': ", e$message, call. = FALSE)
}
)
})
names(args) <- names(fmls)
args
@ -48,6 +55,10 @@ ts_function <- function(f, ..., result = NULL) {
stop("Invalid return type")
}
if (length(args) == 0) {
args <- lapply(formals(f), eval)
}
fn <- function(...) {
mc <- match.call(f)
x <- parse_args(args, mc)

View File

@ -1,12 +1,12 @@
# # optional, check arguments - useful for debugging/development
# check_args(match.call(), formals())
# test_that("function definitions", {
# add <- ts_fun(
# function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
# result = ts_numeric(1)
# )
test_that("function definitions", {
add <- ts_function(
function(a = ts_numeric(1), b = ts_numeric(1)) a + b,
result = ts_numeric(1)
)
# expect_equal(add(1, 2), 3)
# expect_error(add("a", 2))
# })
expect_equal(add(1, 2), 3)
expect_error(add("a", 2))
})