diff --git a/DESCRIPTION b/DESCRIPTION index ce9d9f1..0bf95be 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,7 @@ Imports: Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 +Config/testthat/parallel: true Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 diff --git a/R/aaa-shared-args.R b/R/aaa-shared-args.R index ca2e5a0..a20e77d 100644 --- a/R/aaa-shared-args.R +++ b/R/aaa-shared-args.R @@ -6,6 +6,7 @@ #' @param ... These dots are for future extensions and should be empty. #' @param allow_na Logical. Are NA values ok? #' @param allow_null Logical. Is NULL an acceptable value? +#' @param allow_zero_length Logical. Are zero-length vectors acceptable? #' @param min_size Integer. The minimum size of the object. Object size will be #' tested using [vctrs::vec_size()]. #' @param max_size Integer. The maximum size of the object. Object size will be diff --git a/R/check.R b/R/check.R index b996a0c..9bbf6c1 100644 --- a/R/check.R +++ b/R/check.R @@ -3,17 +3,21 @@ x_arg = rlang::caller_arg(x), call = rlang::caller_env()) { allow_na <- to_lgl_scalar(allow_na, allow_null = FALSE, call = call) - failures <- is.na(x) - if (allow_na || !any(failures)) { + if (allow_na) { return(invisible(NULL)) } - locations <- which(failures) - .stop_must( - msg = "must not contain NA values.", - x_arg = x_arg, - additional_msg = c("*" = "NA locations: {locations}"), - call = call - ) + + failures <- is.na(x) + if (any(failures)) { + locations <- which(failures) + .stop_must( + msg = "must not contain NA values.", + x_arg = x_arg, + additional_msg = c("*" = "NA locations: {locations}"), + call = call + ) + } + return(invisible(NULL)) } .check_size <- function(x, @@ -21,6 +25,10 @@ max_size, x_arg = rlang::caller_arg(x), call = rlang::caller_env()) { + if (is.null(min_size) && is.null(max_size)) { + return(invisible(NULL)) + } + min_size <- to_int_scalar(min_size, call = call) max_size <- to_int_scalar(max_size, call = call) .check_x_no_more_than_y(min_size, max_size, call = call) @@ -53,12 +61,28 @@ .check_scalar <- function(x, allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { - if (.is_allowed_null(x, allow_null = allow_null, call = call)) { - return(invisible(NULL)) + # TODO: Some of this is redundant. + if (!length(x)) { + if (is.null(x)) { + if (.is_allowed_null(x, allow_null = allow_null, call = call)) { + return(invisible(NULL)) + } + } else { + allow_zero_length <- to_lgl_scalar( + allow_zero_length, + allow_null = FALSE, + call = call + ) + if (allow_zero_length) { + return(invisible(NULL)) + } + } } + if (rlang::is_scalar_vector(x)) { return(invisible(NULL)) } diff --git a/R/cls_unexported.R b/R/cls_unexported.R index c159ad8..e31f12d 100644 --- a/R/cls_unexported.R +++ b/R/cls_unexported.R @@ -3,13 +3,16 @@ to_cls_fn, to_cls_args = list(), allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { if (is_rlang_cls_scalar(x)) { return(x) } + force(x_arg) + force(call) x <- rlang::inject( to_cls_fn( x, @@ -23,6 +26,7 @@ .check_scalar( x, allow_null = allow_null, + allow_zero_length = allow_zero_length, x_arg = x_arg, call = call, x_class = x_class @@ -43,8 +47,8 @@ x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { - x_arg <- force(x_arg) - + force(x_arg) + force(call) x <- rlang::inject( to_cls_fn( x, @@ -84,17 +88,20 @@ check_cls_value_fn = NULL, check_cls_value_fn_args = list(), allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { rlang::check_dots_empty0(..., call = call) - x_arg <- force(x_arg) + force(x_arg) + force(call) x <- rlang::inject( to_cls_scalar_fn( x, allow_null = allow_null, + allow_zero_length = allow_zero_length, !!!to_cls_scalar_args, x_arg = x_arg, call = call, diff --git a/R/is.R b/R/is.R index 278845a..d97259f 100644 --- a/R/is.R +++ b/R/is.R @@ -2,13 +2,5 @@ allow_null = TRUE, call = rlang::caller_env()) { allow_null <- to_lgl_scalar(allow_null, allow_null = FALSE, call = call) - # if (vctrs::vec_size(allow_null) > 1) { - # .stop_must( - # msg = "must have a single {.cls logical} value.", - # x_arg = "allow_null", - # call = call - # ) - # } - return(is.null(x) && allow_null) } diff --git a/R/stabilize_arg_scalar.R b/R/stabilize_arg_scalar.R index 833029b..84b2777 100644 --- a/R/stabilize_arg_scalar.R +++ b/R/stabilize_arg_scalar.R @@ -4,6 +4,7 @@ #' check for length-1 vectors. #' #' @inheritParams stabilize_arg +#' @inheritParams .coerce-params #' #' @return `x`, unless one of the checks fails. #' @export @@ -15,6 +16,7 @@ stabilize_arg_scalar <- function(x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), @@ -23,6 +25,7 @@ stabilize_arg_scalar <- function(x, .check_scalar( x, allow_null = allow_null, + allow_zero_length = allow_zero_length, x_arg = x_arg, call = call, x_class = x_class diff --git a/R/stabilize_chr_scalar.R b/R/stabilize_chr_scalar.R index 4b9514c..381954e 100644 --- a/R/stabilize_chr_scalar.R +++ b/R/stabilize_chr_scalar.R @@ -4,6 +4,7 @@ #' check for length-1 character vectors. #' #' @inheritParams stabilize_chr +#' @inheritParams .coerce-params #' #' @return `x`, unless one of the checks fails. #' @export @@ -17,6 +18,7 @@ stabilize_chr_scalar <- function(x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, regex = NULL, x_arg = rlang::caller_arg(x), @@ -28,6 +30,7 @@ stabilize_chr_scalar <- function(x, check_cls_value_fn = .check_value_chr, check_cls_value_fn_args = list(regex = regex), allow_null = allow_null, + allow_zero_length = allow_zero_length, allow_na = allow_na, x_arg = x_arg, call = call, diff --git a/R/stabilize_int_scalar.R b/R/stabilize_int_scalar.R index 8da036c..e7ef9cc 100644 --- a/R/stabilize_int_scalar.R +++ b/R/stabilize_int_scalar.R @@ -4,6 +4,7 @@ #' check for length-1 integers. #' #' @inheritParams stabilize_int +#' @inheritParams .coerce-params #' #' @return `x`, unless one of the checks fails. #' @export @@ -17,6 +18,7 @@ stabilize_int_scalar <- function(x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, coerce_character = TRUE, coerce_factor = TRUE, @@ -37,6 +39,7 @@ stabilize_int_scalar <- function(x, min_value = min_value, max_value = max_value ), allow_null = allow_null, + allow_zero_length = allow_zero_length, allow_na = allow_na, x_arg = x_arg, call = call, diff --git a/R/stabilize_lgl_scalar.R b/R/stabilize_lgl_scalar.R index 35025d8..3175287 100644 --- a/R/stabilize_lgl_scalar.R +++ b/R/stabilize_lgl_scalar.R @@ -4,6 +4,7 @@ #' check for length-1 logical vectors. #' #' @inheritParams stabilize_lgl +#' @inheritParams .coerce-params #' #' @return `x`, unless one of the checks fails. #' @export @@ -17,6 +18,7 @@ stabilize_lgl_scalar <- function(x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), @@ -25,6 +27,7 @@ stabilize_lgl_scalar <- function(x, x, to_cls_scalar_fn = to_lgl_scalar, allow_null = allow_null, + allow_zero_length = allow_zero_length, allow_na = allow_na, x_arg = x_arg, call = call, diff --git a/R/ykwim-package.R b/R/stbl-package.R similarity index 100% rename from R/ykwim-package.R rename to R/stbl-package.R diff --git a/R/to_chr.R b/R/to_chr.R index 355019d..11c0a28 100644 --- a/R/to_chr.R +++ b/R/to_chr.R @@ -1,9 +1,3 @@ -# TODO: Document to_chr. -# TODO: stabilize_chr -# TODO: to_chr_scalar -# TODO: stabilize_chr_scalar -# TODO: See if there's anything to abstract for to_*(). - #' Coerce an argument to character #' #' If a value can be coerced to a character without losing information, do so diff --git a/R/to_chr_scalar.R b/R/to_chr_scalar.R index 8a9096a..a9e6ba5 100644 --- a/R/to_chr_scalar.R +++ b/R/to_chr_scalar.R @@ -4,6 +4,7 @@ #' input contains a single value. #' #' @inheritParams to_chr +#' @inheritParams .coerce-params #' #' @return A character vector equivalent to `x`. #' @export @@ -13,6 +14,7 @@ #' try(to_chr_scalar(letters)) to_chr_scalar <- function(x, allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { @@ -21,6 +23,7 @@ to_chr_scalar <- function(x, is_rlang_cls_scalar = rlang::is_scalar_character, to_cls_fn = to_chr, allow_null = allow_null, + allow_zero_length = allow_zero_length, x_arg = x_arg, call = call, x_class = x_class diff --git a/R/to_int_scalar.R b/R/to_int_scalar.R index 02603c1..f68e8d7 100644 --- a/R/to_int_scalar.R +++ b/R/to_int_scalar.R @@ -4,6 +4,7 @@ #' input contains a single value. #' #' @inheritParams to_int +#' @inheritParams .coerce-params #' #' @return An integer equivalent to `x`. #' @export @@ -13,6 +14,7 @@ #' try(to_int_scalar(1:10)) to_int_scalar <- function(x, allow_null = TRUE, + allow_zero_length = TRUE, coerce_character = TRUE, coerce_factor = TRUE, x_arg = rlang::caller_arg(x), @@ -27,27 +29,9 @@ to_int_scalar <- function(x, coerce_factor = coerce_factor ), allow_null = allow_null, + allow_zero_length = allow_zero_length, x_arg = x_arg, call = call, x_class = x_class ) - x_arg <- force(x_arg) - x <- to_int( - x, - allow_null = allow_null, - coerce_character = coerce_character, - coerce_factor = coerce_factor, - x_arg = x_arg, - call = call, - x_class = x_class - ) - - .check_scalar( - x, - allow_null = allow_null, - x_arg = x_arg, - call = call, - x_class = x_class - ) - return(x) } diff --git a/R/to_lgl_scalar.R b/R/to_lgl_scalar.R index 9782311..6c76354 100644 --- a/R/to_lgl_scalar.R +++ b/R/to_lgl_scalar.R @@ -4,6 +4,7 @@ #' input contains a single value. #' #' @inheritParams to_lgl +#' @inheritParams .coerce-params #' #' @return A logical vector equivalent to `x`. #' @export @@ -13,6 +14,7 @@ #' try(to_lgl_scalar(c(TRUE, FALSE))) to_lgl_scalar <- function(x, allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x)) { @@ -21,6 +23,7 @@ to_lgl_scalar <- function(x, is_rlang_cls_scalar = rlang::is_scalar_logical, to_cls_fn = to_lgl, allow_null = allow_null, + allow_zero_length = allow_zero_length, x_arg = x_arg, call = call, x_class = x_class diff --git a/R/to_null.R b/R/to_null.R index 0f4f6bb..7dda532 100644 --- a/R/to_null.R +++ b/R/to_null.R @@ -2,6 +2,9 @@ to_null <- function(x, allow_null = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env()) { + if (missing(x)) { + .stop_must("must not be missing.", x_arg = "unknown arg", call = call) + } allow_null <- to_lgl_scalar(allow_null, allow_null = FALSE, call = call) if (allow_null) { return(NULL) diff --git a/man/dot-coerce-params.Rd b/man/dot-coerce-params.Rd index 6aa14d0..8543d8f 100644 --- a/man/dot-coerce-params.Rd +++ b/man/dot-coerce-params.Rd @@ -10,6 +10,8 @@ \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{min_size}{Integer. The minimum size of the object. Object size will be tested using \code{\link[vctrs:vec_size]{vctrs::vec_size()}}.} diff --git a/man/stabilize_arg_scalar.Rd b/man/stabilize_arg_scalar.Rd index 159b8f6..a89c6a8 100644 --- a/man/stabilize_arg_scalar.Rd +++ b/man/stabilize_arg_scalar.Rd @@ -8,6 +8,7 @@ stabilize_arg_scalar( x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), @@ -21,6 +22,8 @@ stabilize_arg_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{allow_na}{Logical. Are NA values ok?} \item{x_arg}{Character. An argument name for x. The automatic value will work diff --git a/man/stabilize_chr_scalar.Rd b/man/stabilize_chr_scalar.Rd index dd9675b..710ebff 100644 --- a/man/stabilize_chr_scalar.Rd +++ b/man/stabilize_chr_scalar.Rd @@ -8,6 +8,7 @@ stabilize_chr_scalar( x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, regex = NULL, x_arg = rlang::caller_arg(x), @@ -22,6 +23,8 @@ stabilize_chr_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{allow_na}{Logical. Are NA values ok?} \item{regex}{Character scalar. An optional regex pattern to compare the diff --git a/man/stabilize_int_scalar.Rd b/man/stabilize_int_scalar.Rd index 147dabf..efc7c80 100644 --- a/man/stabilize_int_scalar.Rd +++ b/man/stabilize_int_scalar.Rd @@ -8,6 +8,7 @@ stabilize_int_scalar( x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, coerce_character = TRUE, coerce_factor = TRUE, @@ -25,6 +26,8 @@ stabilize_int_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{allow_na}{Logical. Are NA values ok?} \item{coerce_character}{Logical. Should character vectors such as "1" and diff --git a/man/stabilize_lgl_scalar.Rd b/man/stabilize_lgl_scalar.Rd index cfd1d05..0f93b7b 100644 --- a/man/stabilize_lgl_scalar.Rd +++ b/man/stabilize_lgl_scalar.Rd @@ -8,6 +8,7 @@ stabilize_lgl_scalar( x, ..., allow_null = TRUE, + allow_zero_length = TRUE, allow_na = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), @@ -21,6 +22,8 @@ stabilize_lgl_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{allow_na}{Logical. Are NA values ok?} \item{x_arg}{Character. An argument name for x. The automatic value will work diff --git a/man/stbl-package.Rd b/man/stbl-package.Rd index 7225c12..665ce01 100644 --- a/man/stbl-package.Rd +++ b/man/stbl-package.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ykwim-package.R +% Please edit documentation in R/stbl-package.R \docType{package} \name{stbl-package} \alias{stbl} diff --git a/man/to_chr_scalar.Rd b/man/to_chr_scalar.Rd index 3c00c17..e188026 100644 --- a/man/to_chr_scalar.Rd +++ b/man/to_chr_scalar.Rd @@ -7,6 +7,7 @@ to_chr_scalar( x, allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x) @@ -17,6 +18,8 @@ to_chr_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{x_arg}{Character. An argument name for x. The automatic value will work in most cases, or pass it through from higher-level functions to make error messages clearer in unexported functions.} diff --git a/man/to_int_scalar.Rd b/man/to_int_scalar.Rd index ac38549..044f109 100644 --- a/man/to_int_scalar.Rd +++ b/man/to_int_scalar.Rd @@ -7,6 +7,7 @@ to_int_scalar( x, allow_null = TRUE, + allow_zero_length = TRUE, coerce_character = TRUE, coerce_factor = TRUE, x_arg = rlang::caller_arg(x), @@ -19,6 +20,8 @@ to_int_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{coerce_character}{Logical. Should character vectors such as "1" and "2.0" be coerced to integer?} diff --git a/man/to_lgl_scalar.Rd b/man/to_lgl_scalar.Rd index f86e99c..e3e6d6e 100644 --- a/man/to_lgl_scalar.Rd +++ b/man/to_lgl_scalar.Rd @@ -7,6 +7,7 @@ to_lgl_scalar( x, allow_null = TRUE, + allow_zero_length = TRUE, x_arg = rlang::caller_arg(x), call = rlang::caller_env(), x_class = object_type(x) @@ -17,6 +18,8 @@ to_lgl_scalar( \item{allow_null}{Logical. Is NULL an acceptable value?} +\item{allow_zero_length}{Logical. Are zero-length vectors acceptable?} + \item{x_arg}{Character. An argument name for x. The automatic value will work in most cases, or pass it through from higher-level functions to make error messages clearer in unexported functions.} diff --git a/tests/testthat/_snaps/to_chr_scalar.md b/tests/testthat/_snaps/to_chr_scalar.md index d47eff6..755d1a4 100644 --- a/tests/testthat/_snaps/to_chr_scalar.md +++ b/tests/testthat/_snaps/to_chr_scalar.md @@ -48,3 +48,12 @@ Error in `wrapper()`: ! `wrapper_val` must not be . +# to_chr_scalar rejects length-0 chrs when told to do so + + Code + to_chr_scalar(given, allow_zero_length = FALSE) + Condition + Error: + ! `given` must be a single . + x `given` has no values. + diff --git a/tests/testthat/_snaps/to_lgl.md b/tests/testthat/_snaps/to_lgl.md index b501fa8..5a3a366 100644 --- a/tests/testthat/_snaps/to_lgl.md +++ b/tests/testthat/_snaps/to_lgl.md @@ -1,3 +1,11 @@ +# to_lgl() fails with missing value + + Code + to_lgl() + Condition + Error: + ! `unknown arg` must not be missing. + # to_lgl() works for NULL Code diff --git a/tests/testthat/test-to_chr_scalar.R b/tests/testthat/test-to_chr_scalar.R index 9334c63..666118a 100644 --- a/tests/testthat/test-to_chr_scalar.R +++ b/tests/testthat/test-to_chr_scalar.R @@ -1,14 +1,3 @@ -test_that("to_chr_scalar() allows length-1 chrs through", { - expect_identical( - to_chr_scalar("a"), - "a" - ) - expect_identical( - to_chr_scalar("b"), - "b" - ) -}) - test_that("to_chr_scalar() provides informative error messages", { given <- letters expect_snapshot( @@ -44,3 +33,29 @@ test_that("to_chr_scalar() provides informative error messages", { error = TRUE ) }) + +test_that("to_chr_scalar rejects length-0 chrs when told to do so", { + given <- character() + expect_snapshot( + to_chr_scalar(given, allow_zero_length = FALSE), + error = TRUE + ) +}) + +test_that("to_chr_scalar() allows length-1 chrs through", { + expect_identical( + to_chr_scalar("a"), + "a" + ) + expect_identical( + to_chr_scalar("b"), + "b" + ) +}) + +test_that("to_chr_scalar() allows NULL through", { + expect_identical( + to_chr_scalar(NULL), + NULL + ) +}) diff --git a/tests/testthat/test-to_lgl.R b/tests/testthat/test-to_lgl.R index 448fc6b..5bcc492 100644 --- a/tests/testthat/test-to_lgl.R +++ b/tests/testthat/test-to_lgl.R @@ -1,3 +1,10 @@ +test_that("to_lgl() fails with missing value", { + expect_snapshot( + to_lgl(), + error = TRUE + ) +}) + test_that("to_lgl() works for lgls", { expect_true(to_lgl(TRUE)) expect_false(to_lgl(FALSE))