diff --git a/R/standalone-types-check.R b/R/standalone-types-check.R index 90a889f1b..e1e44ecc1 100644 --- a/R/standalone-types-check.R +++ b/R/standalone-types-check.R @@ -3,12 +3,16 @@ # file: standalone-types-check.R # last-updated: 2023-03-13 # license: https://unlicense.org -# dependencies: standalone-obj-type.R +# dependencies: [standalone-obj-type.R, standalone-cli.R] # imports: rlang (>= 1.1.0) # --- # # ## Changelog # +# 2023-08-31: +# - `check_functions()` gains the argument `args` to specify which arguments the +# function should have (@mgirlich). +# # 2023-03-13: # - Improved error messages of number checkers (@teunbrand) # - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). @@ -381,11 +385,19 @@ check_environment <- function(x, check_function <- function(x, ..., + args = NULL, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { if (!missing(x)) { if (is_function(x)) { + .check_function_args( + f = x, + expected_args = args, + arg = arg, + call = call + ) + return(invisible(NULL)) } if (allow_null && is_null(x)) { @@ -404,6 +416,56 @@ check_function <- function(x, ) } +.check_function_args <- function(f, + expected_args, + arg, + call) { + if (is_null(expected_args)) { + return(invisible(NULL)) + } + + actual_args <- fn_fmls_names(f) %||% character() + n_actual_args <- length(actual_args) + + if (is.numeric(expected_args)) { + n_expected_args <- expected_args + if (n_actual_args >= n_expected_args) { + return(invisible(NULL)) + } + + message <- sprintf( + "%s must have at least %i %s, not %i %s.", + format_arg(arg), + n_expected_args, + pluralise(n_expected_args, "argument", "arguments"), + n_actual_args, + pluralise(n_actual_args, "argument", "arguments") + ) + abort(message, call = call, arg = arg) + } + + missing_args <- setdiff(expected_args, actual_args) + if (is_empty(missing_args)) { + return(invisible(NULL)) + } + + if (n_actual_args == 0) { + arg_info <- "instead it has no arguments" + } else { + arg_info <- paste0("instead it has ", format_arg(actual_args)) + } + + n_expected_args <- length(expected_args) + message <- sprintf( + "%s must have the %s %s, %s.", + format_arg(arg), + pluralise(n_expected_args, "argument", "arguments"), + format_arg(expected_args), + arg_info + ) + abort(message, call = call, arg = arg) +} + check_closure <- function(x, ..., allow_null = FALSE, diff --git a/tests/testthat/_snaps/standalone-types-check.md b/tests/testthat/_snaps/standalone-types-check.md index 16af3ed25..047127f7d 100644 --- a/tests/testthat/_snaps/standalone-types-check.md +++ b/tests/testthat/_snaps/standalone-types-check.md @@ -391,6 +391,69 @@ Error in `checker()`: ! `foo` must be a defused call, not a symbol. +# `check_function()` checks + + Code + err(checker(, check_function)) + Output + + Error in `checker()`: + ! `foo` must be a function, not absent. + Code + err(checker(NULL, check_function)) + Output + + Error in `checker()`: + ! `foo` must be a function, not `NULL`. + Code + err(checker(TRUE, check_function)) + Output + + Error in `checker()`: + ! `foo` must be a function, not `TRUE`. + Code + err(checker(alist(foo(), bar()), check_function, allow_null = TRUE)) + Output + + Error in `checker()`: + ! `foo` must be a function or `NULL`, not a list. + Code + err(checker(quote(foo), check_function)) + Output + + Error in `checker()`: + ! `foo` must be a function, not a symbol. + +--- + + Code + err(checker(function() x, args = 2, check_function)) + Output + + Error in `checker()`: + ! `foo` must have at least 2 arguments, not 0 arguments. + +--- + + Code + err(checker(function() x, args = "x", check_function)) + Output + + Error in `checker()`: + ! `foo` must have the argument `x`, instead it has no arguments. + Code + err(checker(function(y) x, args = "x", check_function)) + Output + + Error in `checker()`: + ! `foo` must have the argument `x`, instead it has `y`. + Code + err(checker(function(y, z) x, args = "x", check_function)) + Output + + Error in `checker()`: + ! `foo` must have the argument `x`, instead it has `y` and `z`. + # `check_environment()` checks Code diff --git a/tests/testthat/test-standalone-types-check.R b/tests/testthat/test-standalone-types-check.R index ce0a3dc0a..d41da1774 100644 --- a/tests/testthat/test-standalone-types-check.R +++ b/tests/testthat/test-standalone-types-check.R @@ -138,6 +138,42 @@ test_that("`check_call()` checks", { }) }) +test_that("`check_function()` checks", { + expect_null(check_function(function(x) x)) + expect_null(check_function(NULL, allow_null = TRUE)) + + expect_snapshot({ + err(checker(, check_function)) + err(checker(NULL, check_function)) + err(checker(TRUE, check_function)) + err(checker(alist(foo(), bar()), check_function, allow_null = TRUE)) + err(checker(quote(foo), check_function)) + }) + + # numeric `args` + expect_null(check_function(function() x, args = 0)) + expect_null(check_function(function(x) x, args = 0)) + # can also have more arguments + expect_null(check_function(function(x, y, z) x, args = 2)) + + # must not have too few arguments + expect_snapshot({ + err(checker(function() x, args = 2, check_function)) + }) + + # character `args` + expect_null(check_function(function() x, args = character())) + expect_null(check_function(function(x) x, args = "x")) + expect_null(check_function(function(x, y, z) x, args = c("x", "y"))) + + # arguments missing + expect_snapshot({ + err(checker(function() x, args = "x", check_function)) + err(checker(function(y) x, args = "x", check_function)) + err(checker(function(y, z) x, args = "x", check_function)) + }) +}) + test_that("`check_environment()` checks", { expect_null(check_environment(env())) expect_null(check_environment(NULL, allow_null = TRUE))