From 2ce9c49c15f171aa829f718bad255d665175d332 Mon Sep 17 00:00:00 2001 From: Maximilian Girlich Date: Thu, 31 Aug 2023 13:09:39 +0000 Subject: [PATCH 1/4] Add argument `args` to `check_function()` --- R/standalone-types-check.R | 54 +++++++++++++++ .../testthat/_snaps/standalone-types-check.md | 66 +++++++++++++++++++ tests/testthat/test-standalone-types-check.R | 28 ++++++++ 3 files changed, 148 insertions(+) diff --git a/R/standalone-types-check.R b/R/standalone-types-check.R index 90a889f1b..357fa7f3a 100644 --- a/R/standalone-types-check.R +++ b/R/standalone-types-check.R @@ -9,6 +9,10 @@ # # ## 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,48 @@ 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() + if (identical(actual_args, expected_args)) { + return(invisible(NULL)) + } + + n_expected_args <- length(expected_args) + n_actual_args <- length(actual_args) + + if (n_expected_args == 0) { + message <- sprintf( + "%s must have no arguments, not %i %s.", + format_arg(arg), + length(actual_args), + pluralise(n_actual_args, "argument", "arguments") + ) + abort(message, call = call, arg = arg) + } + + if (n_actual_args == 0) { + arg_info <- "instead of no arguments" + } else { + arg_info <- paste0("not ", format_arg(actual_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..de33d983a 100644 --- a/tests/testthat/_snaps/standalone-types-check.md +++ b/tests/testthat/_snaps/standalone-types-check.md @@ -391,6 +391,72 @@ 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) x, args = character(), check_function)) + Output + + Error in `checker()`: + ! `foo` must have no arguments, not 1 argument. + Code + err(checker(function(x, y) x, args = character(), check_function)) + Output + + Error in `checker()`: + ! `foo` must have no arguments, not 2 arguments. + Code + err(checker(function() x, args = "x", check_function)) + Output + + Error in `checker()`: + ! `foo` must have the argument `x`, instead of no arguments. + Code + err(checker(function(y) x, args = "x", check_function)) + Output + + Error in `checker()`: + ! `foo` must have the argument `x`, not `y`. + Code + err(checker(function(y, x) x, args = c("x", "y"), check_function)) + Output + + Error in `checker()`: + ! `foo` must have the arguments `x` and `y`, not `y` and `x`. + # `check_environment()` checks Code diff --git a/tests/testthat/test-standalone-types-check.R b/tests/testthat/test-standalone-types-check.R index ce0a3dc0a..a17c32232 100644 --- a/tests/testthat/test-standalone-types-check.R +++ b/tests/testthat/test-standalone-types-check.R @@ -138,6 +138,34 @@ 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)) + }) + + expect_null(check_function(function() x, args = character())) + expect_null(check_function(function(x) x, args = "x")) + expect_null(check_function(function(x, y) x, args = c("x", "y"))) + + expect_snapshot({ + # should have no arguments + err(checker(function(x) x, args = character(), check_function)) + err(checker(function(x, y) x, args = character(), check_function)) + + # should have arguments + err(checker(function() x, args = "x", check_function)) + err(checker(function(y) x, args = "x", check_function)) + err(checker(function(y, x) x, args = c("x", "y"), check_function)) + }) +}) + test_that("`check_environment()` checks", { expect_null(check_environment(env())) expect_null(check_environment(NULL, allow_null = TRUE)) From 6a20d6cb1cfd9f040d60e4d79bbab140c6c5c2b9 Mon Sep 17 00:00:00 2001 From: Maximilian Girlich Date: Thu, 31 Aug 2023 13:17:35 +0000 Subject: [PATCH 2/4] Support numeric `args` --- R/standalone-types-check.R | 23 +++++++++++++--- .../testthat/_snaps/standalone-types-check.md | 27 +++++++++++++++++++ tests/testthat/test-standalone-types-check.R | 13 +++++++++ 3 files changed, 60 insertions(+), 3 deletions(-) diff --git a/R/standalone-types-check.R b/R/standalone-types-check.R index 357fa7f3a..a183bf235 100644 --- a/R/standalone-types-check.R +++ b/R/standalone-types-check.R @@ -425,18 +425,35 @@ check_function <- function(x, } actual_args <- fn_fmls_names(f) %||% character() + n_actual_args <- length(actual_args) + + if (is.numeric(expected_args)) { + n_expected_args <- expected_args + if (identical(n_expected_args, n_actual_args)) { + return(invisible(NULL)) + } + + message <- sprintf( + "%s must have %i %s, not %i %s.", + format_arg(arg), + n_expected_args, + pluralise(n_actual_args, "argument", "arguments"), + n_actual_args, + pluralise(n_actual_args, "argument", "arguments") + ) + abort(message, call = call, arg = arg) + } + if (identical(actual_args, expected_args)) { return(invisible(NULL)) } n_expected_args <- length(expected_args) - n_actual_args <- length(actual_args) - if (n_expected_args == 0) { message <- sprintf( "%s must have no arguments, not %i %s.", format_arg(arg), - length(actual_args), + n_actual_args, pluralise(n_actual_args, "argument", "arguments") ) abort(message, call = call, arg = arg) diff --git a/tests/testthat/_snaps/standalone-types-check.md b/tests/testthat/_snaps/standalone-types-check.md index de33d983a..6b5e410dc 100644 --- a/tests/testthat/_snaps/standalone-types-check.md +++ b/tests/testthat/_snaps/standalone-types-check.md @@ -424,6 +424,33 @@ Error in `checker()`: ! `foo` must be a function, not a symbol. +--- + + Code + err(checker(function(x) x, args = 0L, check_function)) + Output + + Error in `checker()`: + ! `foo` must have 0 argument, not 1 argument. + Code + err(checker(function(x, y) x, args = 0L, check_function)) + Output + + Error in `checker()`: + ! `foo` must have 0 arguments, not 2 arguments. + Code + err(checker(function() x, args = 2, check_function)) + Output + + Error in `checker()`: + ! `foo` must have 2 arguments, not 0 arguments. + Code + err(checker(function(x, y, z) x, args = 2, check_function)) + Output + + Error in `checker()`: + ! `foo` must have 2 arguments, not 3 arguments. + --- Code diff --git a/tests/testthat/test-standalone-types-check.R b/tests/testthat/test-standalone-types-check.R index a17c32232..97f756e84 100644 --- a/tests/testthat/test-standalone-types-check.R +++ b/tests/testthat/test-standalone-types-check.R @@ -150,6 +150,19 @@ test_that("`check_function()` checks", { err(checker(quote(foo), check_function)) }) + expect_null(check_function(function() x, args = 0L)) + expect_null(check_function(function(x, y) x, args = 2L)) + + expect_snapshot({ + # should have no arguments + err(checker(function(x) x, args = 0L, check_function)) + err(checker(function(x, y) x, args = 0L, check_function)) + + # should have arguments + err(checker(function() x, args = 2, check_function)) + err(checker(function(x, y, z) x, args = 2, check_function)) + }) + expect_null(check_function(function() x, args = character())) expect_null(check_function(function(x) x, args = "x")) expect_null(check_function(function(x, y) x, args = c("x", "y"))) From b8ae23e7b0c08bb21dde11b5d8d0445916db3c97 Mon Sep 17 00:00:00 2001 From: Maximilian Girlich Date: Thu, 31 Aug 2023 14:15:09 +0000 Subject: [PATCH 3/4] Add dependency on `standalone-cli.R` --- R/standalone-types-check.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/standalone-types-check.R b/R/standalone-types-check.R index a183bf235..8219a74c6 100644 --- a/R/standalone-types-check.R +++ b/R/standalone-types-check.R @@ -3,7 +3,7 @@ # 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) # --- # From 7f7e2ca5093190c1c6b60c61f0b2eb591920b968 Mon Sep 17 00:00:00 2001 From: Maximilian Girlich Date: Wed, 6 Sep 2023 07:32:09 +0000 Subject: [PATCH 4/4] Allow extra arguments --- R/standalone-types-check.R | 25 ++++-------- .../testthat/_snaps/standalone-types-check.md | 40 +++---------------- tests/testthat/test-standalone-types-check.R | 25 +++++------- 3 files changed, 23 insertions(+), 67 deletions(-) diff --git a/R/standalone-types-check.R b/R/standalone-types-check.R index 8219a74c6..e1e44ecc1 100644 --- a/R/standalone-types-check.R +++ b/R/standalone-types-check.R @@ -429,42 +429,33 @@ check_function <- function(x, if (is.numeric(expected_args)) { n_expected_args <- expected_args - if (identical(n_expected_args, n_actual_args)) { + if (n_actual_args >= n_expected_args) { return(invisible(NULL)) } message <- sprintf( - "%s must have %i %s, not %i %s.", + "%s must have at least %i %s, not %i %s.", format_arg(arg), n_expected_args, - pluralise(n_actual_args, "argument", "arguments"), + pluralise(n_expected_args, "argument", "arguments"), n_actual_args, pluralise(n_actual_args, "argument", "arguments") ) abort(message, call = call, arg = arg) } - if (identical(actual_args, expected_args)) { + missing_args <- setdiff(expected_args, actual_args) + if (is_empty(missing_args)) { return(invisible(NULL)) } - n_expected_args <- length(expected_args) - if (n_expected_args == 0) { - message <- sprintf( - "%s must have no arguments, not %i %s.", - format_arg(arg), - n_actual_args, - pluralise(n_actual_args, "argument", "arguments") - ) - abort(message, call = call, arg = arg) - } - if (n_actual_args == 0) { - arg_info <- "instead of no arguments" + arg_info <- "instead it has no arguments" } else { - arg_info <- paste0("not ", format_arg(actual_args)) + 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), diff --git a/tests/testthat/_snaps/standalone-types-check.md b/tests/testthat/_snaps/standalone-types-check.md index 6b5e410dc..047127f7d 100644 --- a/tests/testthat/_snaps/standalone-types-check.md +++ b/tests/testthat/_snaps/standalone-types-check.md @@ -426,63 +426,33 @@ --- - Code - err(checker(function(x) x, args = 0L, check_function)) - Output - - Error in `checker()`: - ! `foo` must have 0 argument, not 1 argument. - Code - err(checker(function(x, y) x, args = 0L, check_function)) - Output - - Error in `checker()`: - ! `foo` must have 0 arguments, not 2 arguments. Code err(checker(function() x, args = 2, check_function)) Output Error in `checker()`: - ! `foo` must have 2 arguments, not 0 arguments. - Code - err(checker(function(x, y, z) x, args = 2, check_function)) - Output - - Error in `checker()`: - ! `foo` must have 2 arguments, not 3 arguments. + ! `foo` must have at least 2 arguments, not 0 arguments. --- - Code - err(checker(function(x) x, args = character(), check_function)) - Output - - Error in `checker()`: - ! `foo` must have no arguments, not 1 argument. - Code - err(checker(function(x, y) x, args = character(), check_function)) - Output - - Error in `checker()`: - ! `foo` must have no arguments, not 2 arguments. Code err(checker(function() x, args = "x", check_function)) Output Error in `checker()`: - ! `foo` must have the argument `x`, instead of no arguments. + ! `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`, not `y`. + ! `foo` must have the argument `x`, instead it has `y`. Code - err(checker(function(y, x) x, args = c("x", "y"), check_function)) + err(checker(function(y, z) x, args = "x", check_function)) Output Error in `checker()`: - ! `foo` must have the arguments `x` and `y`, not `y` and `x`. + ! `foo` must have the argument `x`, instead it has `y` and `z`. # `check_environment()` checks diff --git a/tests/testthat/test-standalone-types-check.R b/tests/testthat/test-standalone-types-check.R index 97f756e84..d41da1774 100644 --- a/tests/testthat/test-standalone-types-check.R +++ b/tests/testthat/test-standalone-types-check.R @@ -150,32 +150,27 @@ test_that("`check_function()` checks", { err(checker(quote(foo), check_function)) }) - expect_null(check_function(function() x, args = 0L)) - expect_null(check_function(function(x, y) x, args = 2L)) + # 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({ - # should have no arguments - err(checker(function(x) x, args = 0L, check_function)) - err(checker(function(x, y) x, args = 0L, check_function)) - - # should have arguments err(checker(function() x, args = 2, check_function)) - err(checker(function(x, y, z) 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) x, args = c("x", "y"))) + expect_null(check_function(function(x, y, z) x, args = c("x", "y"))) + # arguments missing expect_snapshot({ - # should have no arguments - err(checker(function(x) x, args = character(), check_function)) - err(checker(function(x, y) x, args = character(), check_function)) - - # should have arguments err(checker(function() x, args = "x", check_function)) err(checker(function(y) x, args = "x", check_function)) - err(checker(function(y, x) x, args = c("x", "y"), check_function)) + err(checker(function(y, z) x, args = "x", check_function)) }) })