diff --git a/R/qassertm.R b/R/qassertm.R new file mode 100644 index 00000000..ddc98b63 --- /dev/null +++ b/R/qassertm.R @@ -0,0 +1,54 @@ +mkqassert <- function(varname, rule, frame) + eval(substitute(qassert(x, spec), list(x=as.name(varname), spec=rule)), + envir=frame) + +#' @title Quick checks for multiple variable=rule enumerated as arguments +#' +#' @description +#' Ergonomic wraper for \code{\link{qassert}} to check multiple variable=rule pairs +#' +#' @param ... [\code{var.name}=[\code{character}]]\cr +#' Any number of named arguments like var.name=rule\cr +#' See details of \code{\link{qtest}} for rule explanation. +#' @template var.name +#' @return See \code{\link{qassert}}. +#' @seealso \code{\link{qtest}}, \code{\link{qassert}} +#' @export +#' @examples +#' x=1:10; y=TRUE +#' qassertm(x="i+", y="b") +#' +#' with(data.frame(a=1:26,b=letters), qassertm(a="i+", b="s")) +qassertm <- function(...) { + in_args <- list(...) + for (v in names(in_args)) mkqassert(v, in_args[[v]], parent.frame()) +} + +#' @title Check single rule against all or enumerated variables +#' +#' @description +#' Ergonomic wraper for \code{\link{qassert}} to check multiple variables against a single rule +#' +#' @param rule [[\code{character}]]\cr +#' Any number of named arguments like var.name=rule\cr +#' See details of \code{\link{qtest}} for rule explanation. +#' @param ... [[\code{var.name}]]\cr +#' list of unquoted variables that should match \code{rule} +#' if none provided, uses all variables in local scope +#' @return See \code{\link{qassert}}. +#' @seealso \code{\link{qassertm}} +#' @export +#' @examples +#' x <- TRUE; y <- FALSE +#' # check all variables, scoped inside function +#' foofunc <- function(x, y) { qassert_all('n'); print(x); } +#' foofunc(1, 2) +#' # only enumerated variables +#' qassert_all('l', x, y) +#' +qassert_all <- function(rule, ...) { + qassert(rule,'s') + varlist <- lapply(match.call(expand.dots = FALSE)$..., as.character) + if(length(varlist)==0L) varlist <- ls(envir=parent.frame()) + for (v in varlist) mkqassert(v, rule, parent.frame()) +} diff --git a/tests/testthat/test_qassertm.R b/tests/testthat/test_qassertm.R new file mode 100644 index 00000000..b188c33e --- /dev/null +++ b/tests/testthat/test_qassertm.R @@ -0,0 +1,42 @@ +context("qassertm") + +xb = logical(10) +xb2 = logical(10) +xi = integer(10) +xr = double(10) + +test_that("qassertm: fail on any, report first", { + # none + expect_error(qassertm(), NA) + # one + expect_error(qassertm(xb="b"), NA) + # many + expect_error(qassertm(xb="l"), + regexp = "'xb' .*'list', not 'logical'") + + expect_error(qassertm(xb="b", xi="i", xr="r"), NA) + expect_error(qassertm(xb="b", xi="l", xr="r"), + regexp = "'xi' .*'list', not 'integer'") + expect_error(qassertm(xb="b", xi="i", xr="b"), + regexp = "'xr' .*logical', not 'double'") + + # two wrong. only reports first + expect_error(qassertm(xb="b", xi="l", xr="b"), + regexp = "'xi' .*'list', not 'integer'") +}) + +test_that("qassert_all", { + # global + expect_error(qassert_all('b',xb,xb2), NA) + expect_error(qassert_all('n',xb,xb2), + regexp="'xb' .*numeric', not 'logical'") + expect_error(qassert_all('r',xr,xb), + regexp="'xb' .*double', not 'logical'") + + # within function. reusing gobal names to test scope + expect_error((function(xb,xb2) qassert_all("n"))(1,2), NA) + expect_error((function(xb,xb2) qassert_all("n"))(1,TRUE), + regexp="'xb2' .*numeric', not 'logical'") + expect_error((function(xb,xb2) qassert_all("n"))(1), + regexp='"xb2" is missing') +})