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) { 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) names(args) <- names(fmls)
args args
@ -48,6 +55,10 @@ ts_function <- function(f, ..., result = NULL) {
stop("Invalid return type") stop("Invalid return type")
} }
if (length(args) == 0) {
args <- lapply(formals(f), eval)
}
fn <- function(...) { fn <- function(...) {
mc <- match.call(f) mc <- match.call(f)
x <- parse_args(args, mc) x <- parse_args(args, mc)

View File

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