R/makeTest.R

#' @title Turn a Check into a Test
#'
#' @description
#' \code{makeTest} is the internal function used to evaluate the result of a
#' check and throw an exception if necessary.
#' This function is currently only a stub and just calls \code{\link[base]{isTRUE}}.
#' \code{makeTestFunction} can be used to automatically create an assertion
#' function based on a check function (see example).
#'
#' @param res [\code{TRUE} | \code{character(1)}]\cr
#'  The result of a check function: \code{TRUE} for successful checks,
#'  and an error message as string otherwise.
#' @return \code{makeTest} returns \code{TRUE} if the check is successful and \code{FALSE} otherwise.
#'  \code{makeTestFunction} returns a \code{function}.
#' @export
#' @family CustomConstructors
#' @include helper.R
#' @examples
#' # Simple custom check function
#' checkFalse = function(x) if (!identical(x, FALSE)) "Must be FALSE" else TRUE
#'
#' # Create the respective test function
#' testFalse = function(x) {
#'   res = checkFalse(x)
#'   makeTest(res)
#' }
#'
#' # Alternative: Automatically create such a function
#' testFalse = makeTestFunction(checkFalse)
#' print(testFalse)
makeTest = function(res) {
  isTRUE(res)
}

#' @rdname makeTest
#' @template makeFunction
#' @export
makeTestFunction = function(check.fun, c.fun = NULL, env = parent.frame()) {
  fun.name = if (is.character(check.fun)) check.fun else deparse(substitute(check.fun))
  check.fun = match.fun(check.fun)
  fun.args = formals(args(check.fun))

  new.fun = function() TRUE
  formals(new.fun) = fun.args
  if (is.null(c.fun)) {
    body = paste0("isTRUE(", fun.name, "(", paste0(names(fun.args), collapse = ", "), "))")
  } else {
    body = paste0("isTRUE(.Call(", paste0(c(c.fun, names(fun.args)), collapse = ", "), "))")
  }

  body(new.fun) = parse(text = paste("{", body, "}"))
  environment(new.fun) = env
  return(new.fun)
}

Try the checkmate package in your browser

Any scripts or data that you put into this service are public.

checkmate documentation built on July 4, 2019, 5:12 p.m.