[med-svn] [r-cran-assertthat] 03/11: New upstream version 0.1
Andreas Tille
tille at debian.org
Thu Sep 28 15:30:59 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-assertthat.
commit 8c905d616f5b6c79a06e5b67d2ea80b30a1cb651
Author: Andreas Tille <tille at debian.org>
Date: Thu Sep 28 19:21:21 2017 +0200
New upstream version 0.1
---
DESCRIPTION | 21 ++++++
MD5 | 28 ++++++++
NAMESPACE | 27 ++++++++
R/assert-that.r | 115 ++++++++++++++++++++++++++++++
R/assertions-file.r | 66 ++++++++++++++++++
R/assertions-scalar.R | 92 ++++++++++++++++++++++++
R/assertions.r | 169 +++++++++++++++++++++++++++++++++++++++++++++
R/base-comparison.r | 17 +++++
R/base-is.r | 49 +++++++++++++
R/base-logical.r | 34 +++++++++
R/base-misc.r | 15 ++++
R/base.r | 1 +
R/on-failure.r | 29 ++++++++
R/utils.r | 1 +
R/validate-that.R | 25 +++++++
README.md | 85 +++++++++++++++++++++++
debian/README.test | 9 ---
debian/changelog | 5 --
debian/compat | 1 -
debian/control | 22 ------
debian/copyright | 27 --------
debian/docs | 3 -
debian/rules | 3 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 12 ----
debian/watch | 3 -
inst/tests/test-base.R | 15 ++++
man/are_equal.Rd | 30 ++++++++
man/assert-is.Rd | 34 +++++++++
man/assert_that.Rd | 59 ++++++++++++++++
man/assertions-file.Rd | 42 +++++++++++
man/has_args.Rd | 29 ++++++++
man/has_attr.Rd | 32 +++++++++
man/noNA.Rd | 27 ++++++++
man/not_empty.Rd | 26 +++++++
man/on_failure.Rd | 33 +++++++++
man/scalar.Rd | 56 +++++++++++++++
man/validate_that.Rd | 38 ++++++++++
tests/test-that.R | 4 ++
40 files changed, 1199 insertions(+), 89 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..8bd2435
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,21 @@
+Package: assertthat
+Title: Easy pre and post assertions.
+Version: 0.1
+Authors at R: 'Hadley Wickham <h.wickham at gmail.com> [aut,cre]'
+Description: assertthat is an extension to stopifnot() that makes it
+ easy to declare the pre and post conditions that you code should
+ satisfy, while also producing friendly error messages so that your
+ users know what they've done wrong.
+License: GPL-3
+Suggests: testthat
+Collate: 'assert-that.r' 'on-failure.r' 'assertions-file.r'
+ 'assertions-scalar.R' 'assertions.r' 'base.r'
+ 'base-comparison.r' 'base-is.r' 'base-logical.r' 'base-misc.r'
+ 'utils.r' 'validate-that.R'
+Roxygen: list(wrap = FALSE)
+Packaged: 2013-12-05 18:46:37 UTC; hadley
+Author: 'Hadley Wickham' [aut, cre]
+Maintainer: 'Hadley Wickham' <h.wickham at gmail.com>
+NeedsCompilation: no
+Repository: CRAN
+Date/Publication: 2013-12-06 00:51:10
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..7313dc6
--- /dev/null
+++ b/MD5
@@ -0,0 +1,28 @@
+9d6f40f50ee12be47c061798a93f54a5 *DESCRIPTION
+da16c2e00f9ad6320ca55102ff2bf900 *NAMESPACE
+6700dc426204d6942aa9493d0f401117 *R/assert-that.r
+b8a27b28dc330772b389b29bd6156223 *R/assertions-file.r
+8c016508a2d5a00f76f4ed1d223dfdce *R/assertions-scalar.R
+bccfd0f930aaade21d8d00131d2b2ae0 *R/assertions.r
+bf48a75f9c36892a64e81da55ede64ed *R/base-comparison.r
+6e2ffc34b89617577cd86d68edffa8b7 *R/base-is.r
+487ba0225528ba58e80015de661dc6ba *R/base-logical.r
+f1bfb65dbae725fa7b8047395077266a *R/base-misc.r
+b7a004bd983209b5a9d2aed114689a1b *R/base.r
+9cc3dc154a2ab45e4559600aba559ecc *R/on-failure.r
+508577888dc400bb76df829612db84a0 *R/utils.r
+62a6c70097ecd53a7310d075f5e75af9 *R/validate-that.R
+329bb56c75acb8f016930e2336561ef4 *README.md
+244be8591c9bcb1db2b93fe31765cfa7 *inst/tests/test-base.R
+e1e12ba1c980e7a84fdad54afc887fd4 *man/are_equal.Rd
+01cabba4b12491e922e28d58010f243e *man/assert-is.Rd
+0b47ef2a6e237434dbc088882509ac4c *man/assert_that.Rd
+49ca9ea5566be9987e984ae6314a6ded *man/assertions-file.Rd
+afc97d9fcf61f05dbed9e913cb1e8e40 *man/has_args.Rd
+f461c5adf9380d3030c9e7eb501bff7a *man/has_attr.Rd
+d4d7bc3089e43441b77818008030a86b *man/noNA.Rd
+8265167687eda318bb5c6d373468b489 *man/not_empty.Rd
+1fdd3413c40ab336f4cd542cb6b847e6 *man/on_failure.Rd
+54f2544b2af67f8f28395acd0af92389 *man/scalar.Rd
+efd55dea4588c4cb5d4da880bad7ca5f *man/validate_that.Rd
+cfa4c85c1d568b55795575389e2f0ef4 *tests/test-that.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..1c09035
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,27 @@
+export("%has_args%")
+export("%has_attr%")
+export("%has_name%")
+export("on_failure<-")
+export(are_equal)
+export(assert_that)
+export(has_args)
+export(has_attr)
+export(has_extension)
+export(has_name)
+export(is.count)
+export(is.date)
+export(is.dir)
+export(is.error)
+export(is.flag)
+export(is.number)
+export(is.readable)
+export(is.scalar)
+export(is.string)
+export(is.time)
+export(is.writeable)
+export(noNA)
+export(not_empty)
+export(on_failure)
+export(see_if)
+export(validate_that)
+importFrom(tools,file_ext)
diff --git a/R/assert-that.r b/R/assert-that.r
new file mode 100644
index 0000000..acc7ebe
--- /dev/null
+++ b/R/assert-that.r
@@ -0,0 +1,115 @@
+#' Assert that certain conditions are true.
+#'
+#' \code{assert_that} is a drop-in replacement for \code{\link{stopifnot}} but
+#' is designed to give informative error messages.
+#'
+#' @section Assertions:
+#'
+#' Assertion functions should return a single \code{TRUE} or \code{FALSE}:
+#' any other result is an error, and \code{assert_that} will complain about
+#' it. This will always be the case for the assertions provided by
+#' \code{assertthat}, but you may need be a more careful for
+#' base R functions.
+#'
+#' To make your own assertions that work with \code{assert_that},
+#' see the help for \code{\link{on_failure}}.
+#'
+#' @param ... unnamed expressions that describe the conditions to be tested.
+#' Rather than combining expressions with \code{&&}, separate them by commas
+#' so that better error messages can be generated.
+#' @param env (advanced use only) the environment in which to evaluate the
+#' assertions.
+#' @seealso \code{\link{validate_that}}, which returns a message (not an error)
+#' if the condition is false.
+#' @export
+#' @examples
+#' x <- 1
+#' # assert_that() generates errors, so can't be usefully run in
+#' # examples
+#' \dontrun{
+#' assert_that(is.character(x))
+#' assert_that(length(x) == 3)
+#' assert_that(is.dir("asdf"))
+#' y <- tempfile()
+#' writeLines("", y)
+#' assert_that(is.dir(y))
+#' }
+#'
+#' # But see_if just returns the values, so you'll see that a lot
+#' # in the examples: but remember to use assert_that in your code.
+#' see_if(is.character(x))
+#' see_if(length(x) == 3)
+#' see_if(is.dir(17))
+#' see_if(is.dir("asdf"))
+assert_that <- function(..., env = parent.frame()) {
+ res <- see_if(..., env = env)
+ if (res) return(TRUE)
+
+ stop(assertError(attr(res, "msg")))
+}
+
+assertError <- function (message, call = NULL) {
+ class <- c("assertError", "simpleError", "error", "condition")
+ structure(list(message = message, call = call), class = class)
+}
+
+#' @rdname assert_that
+#' @export
+see_if <- function(..., env = parent.frame()) {
+ asserts <- eval(substitute(alist(...)))
+
+ for (assertion in asserts) {
+ res <- tryCatch({
+ eval(assertion, env)
+ }, assertError = function(e) {
+ structure(FALSE, msg = e$message)
+ })
+ check_result(res)
+
+ # Failed, so figure out message to produce
+ if (!res) {
+ msg <- get_message(res, assertion, env)
+ return(structure(FALSE, msg = msg))
+ }
+ }
+
+ res
+}
+
+check_result <- function(x) {
+ if (!is.logical(x))
+ stop("assert_that: assertion must return a logical value", call. = FALSE)
+ if (any(is.na(x)))
+ stop("assert_that: missing values present in assertion", call. = FALSE)
+ if (length(x) > 1) {
+ stop("assert_that: assertion has length greater than 1", call. = FALSE)
+ }
+
+ TRUE
+}
+
+get_message <- function(res, call, env = parent.frame()) {
+ stopifnot(is.call(call), length(call) >= 1)
+
+ if (has_attr(res, "msg")) {
+ return(attr(res, "msg"))
+ }
+
+ f <- eval(call[[1]], env)
+ if (!is.primitive(f)) call <- match.call(f, call)
+ fname <- deparse(call[[1]])
+
+ fail <- on_failure(f) %||% base_fs[[fname]] %||% fail_default
+ fail(call, env)
+}
+
+# The default failure message works in the same way as stopifnot, so you can
+# continue to use any function that returns a logical value: you just won't
+# get a friendly error message
+fail_default <- function(call, env) {
+ call_string <- deparse(call, width.cutoff = 60L)
+ if (length(call_string) > 1L) ch <- paste0(call_string[1L], "...")
+
+ paste0(call_string, " is not TRUE")
+}
+
diff --git a/R/assertions-file.r b/R/assertions-file.r
new file mode 100644
index 0000000..ab44572
--- /dev/null
+++ b/R/assertions-file.r
@@ -0,0 +1,66 @@
+#' @include on-failure.r
+NULL
+
+path_is_not <- function(thing, var = "x") {
+ function(call, env) {
+ paste0("Path '", eval(call[[var]], env), "' is not ", thing)
+ }
+}
+
+#' Useful test related to files
+#'
+#' @param path a file path to examine
+#' @name assertions-file
+#' @examples
+#' see_if(is.dir(1))
+#'
+#' tmp <- tempfile()
+#' see_if(file.exists(tmp))
+#' see_if(is.dir(tmp))
+#'
+#' writeLines("x", tmp)
+#' see_if(file.exists(tmp))
+#' see_if(is.dir(tmp))
+#' see_if(is.writeable(tmp))
+#' see_if(is.readable(tmp))
+#' unlink(tmp)
+#'
+#' see_if(is.readable(tmp))
+NULL
+
+#' @export
+#' @rdname assertions-file
+is.dir <- function(path) {
+ assert_that(is.string(path), file.exists(path))
+ file.info(path)$isdir
+}
+on_failure(is.dir) <- path_is_not("a directory", "path")
+
+#' @export
+#' @rdname assertions-file
+is.writeable <- function(path) {
+ assert_that(is.string(path), file.exists(path))
+ file.access(path, mode = 2)[[1]] == 0
+}
+on_failure(is.writeable) <- path_is_not("writeable", "path")
+
+#' @export
+#' @rdname assertions-file
+is.readable <- function(path) {
+ assert_that(is.string(path), file.exists(path))
+ file.access(path, mode = 4)[[1]] == 0
+}
+on_failure(is.readable) <- path_is_not("readable", "path")
+
+#' @param ext extension to test for (\code{has_extension} only)
+#' @importFrom tools file_ext
+#' @export
+#' @rdname assertions-file
+has_extension <- function(path, ext) {
+ file_ext(path) == ext
+}
+on_failure(has_extension) <- function(call, env) {
+ path <- eval(call$path, env)
+ ext <- eval(call$ext, env)
+ paste0("File '", basename(path), "' does not have extension", ext)
+}
diff --git a/R/assertions-scalar.R b/R/assertions-scalar.R
new file mode 100644
index 0000000..920a716
--- /dev/null
+++ b/R/assertions-scalar.R
@@ -0,0 +1,92 @@
+#' @include on-failure.r
+NULL
+
+#' Assert input is a scalar.
+#'
+#' \code{is.scala} provides a generic method for checking input is a scalar.
+#' \code{is.string}, \code{is.flag}, \code{is.number} and \code{is.count}
+#' provide tests for specific types.
+#'
+#' @family assertions
+#' @param x object to test
+#' @name scalar
+#' @aliases NULL
+NULL
+
+#' @rdname scalar
+#' @export
+#' @examples
+#' # Generic check for scalars
+#' see_if(is.scalar("a"))
+#' see_if(is.scalar(1:10))
+#'
+is.scalar <- function(x) {
+ length(x) == 1L
+}
+on_failure(is.scalar) <- function(call, env) {
+ type <- eval(call$type, env)
+ paste0(deparse(call$x), " is not a scalar.")
+}
+
+
+#' @rdname scalar
+#' @export
+#' @examples
+#' # string = scalar character vector
+#' see_if(is.string(1:3))
+#' see_if(is.string(c("a", "b")))
+#' see_if(is.string("x"))
+#'
+is.string <- function(x) is.character(x) && length(x) == 1
+on_failure(is.string) <- function(call, env) {
+ paste0(deparse(call$x), " is not a string (a length one character vector).")
+}
+
+
+#' @rdname scalar
+#' @export
+#' @examples
+#' # number = scalar numeric/integer vector
+#' see_if(is.number(1:3))
+#' see_if(is.number(1.5))
+#'
+is.number <- function(x) is.numeric(x) && length(x) == 1
+on_failure(is.number) <- function(call, env) {
+ paste0(deparse(call$x), " is not a number (a length one numeric vector).")
+}
+
+#' @rdname scalar
+#' @export
+#' @examples
+#' # flag = scalar numeric/integer vector
+#' see_if(is.flag(1:3))
+#' see_if(is.flag("a"))
+#' see_if(is.flag(c(FALSE, FALSE, TRUE)))
+#' see_if(is.flag(FALSE))
+#'
+is.flag <- function(x) is.logical(x) && length(x) == 1
+on_failure(is.flag) <- function(call, env) {
+ paste0(deparse(call$x), " is not a flag (a length one logical vector).")
+}
+
+
+#' @rdname scalar
+#' @export
+#' @examples
+#' # flag = scalar positive integer
+#' see_if(is.count("a"))
+#' see_if(is.count(-1))
+#' see_if(is.count(1:5))
+#' see_if(is.count(1.5))
+#' see_if(is.count(1))
+#'
+is.count <- function(x) {
+ if (length(x) != 1) return(FALSE)
+ if (!is.integerish(x)) return(FALSE)
+
+ x > 0
+}
+on_failure(is.count) <- function(call, env) {
+ paste0(deparse(call$x), " is not a count (a single positive integer)")
+}
+
diff --git a/R/assertions.r b/R/assertions.r
new file mode 100644
index 0000000..69dc9ee
--- /dev/null
+++ b/R/assertions.r
@@ -0,0 +1,169 @@
+#' @include on-failure.r
+NULL
+
+is.integerish <- function(x) {
+ is.integer(x) || (is.numeric(x) && all(x == as.integer(x)))
+}
+
+# is.positive.integer
+# is.negative.integer
+# is.positive.double
+# is.negative.double
+
+is.named <- function(x) {
+ nm <- names(x)
+ !is.null(nm) && all(nm != "")
+}
+on_failure(is.named) <- function(call, env) {
+ paste0("Not all elements of ", deparse(call$x), " have names.")
+}
+
+#' Has attribute or name?
+#'
+#' @param x object to test
+#' @param which name or attribute
+#' @export
+#' @examples
+#' has_attr(has_attr, "fail")
+#' x <- 10
+#' x %has_attr% "a"
+#'
+#' y <- list(a = 1, b = 2)
+#' see_if(y %has_name% "c")
+has_attr <- function(x, which) !is.null(attr(x, which, exact = TRUE))
+on_failure(has_attr) <- function(call, env) {
+ paste0(deparse(call$x), " does not have attribute ", eval(call$which, env))
+}
+#' @export
+#' @rdname has_attr
+"%has_attr%" <- has_attr
+
+#' @export
+#' @rdname has_attr
+has_name <- function(x, which) which %in% names(x)
+on_failure(has_name) <- function(call, env) {
+ paste0(deparse(call$x), " does not have name ", eval(call$which, env))
+}
+#' @export
+#' @rdname has_attr
+"%has_name%" <- has_name
+
+#' Does object contain any missing values?
+#'
+#' @family assertions
+#' @param x object to test
+#' @export
+#' @examples
+#' see_if(noNA("a"))
+#' see_if(noNA(c(TRUE, NA)))
+#' x <- sample(c(1:10, NA), 100, rep = TRUE)
+#' see_if(noNA(x))
+noNA <- function(x) {
+ !(any(is.na(x)))
+}
+on_failure(noNA) <- function(call, env) {
+ n <- sum(is.na(eval(call$x, env)))
+ paste0(deparse(call$x), " contains ", n, " missing values")
+}
+
+#' Are two objects equal?
+#'
+#' @param x,y objects to compare
+#' @param ... additional arguments passed to \code{\link{all.equal}}
+#' @family assertions
+#' @export
+#' @examples
+#' x <- 2
+#' see_if(are_equal(x, 1.9))
+#' see_if(are_equal(x, 1.999, tol = 0.01))
+#' see_if(are_equal(x, 2))
+are_equal <- function(x, y, ...) {
+ isTRUE(all.equal(x, y, ...))
+}
+on_failure(are_equal) <- function(call, env) {
+ paste0(deparse(call$x), " not equal to ", deparse(call$y))
+}
+
+#' Missing is functions.
+#'
+#' @param x object to test
+#' @family assertions
+#' @name assert-is
+#' @aliases NULL
+#' @examples
+#' a <- Sys.time()
+#' is.time(a)
+#' b <- Sys.Date()
+#' is.date(b)
+#' c <- try(stop("!!"))
+#' is.error(c)
+NULL
+
+#' @export
+#' @rdname assert-is
+is.error <- function(x) inherits(x, "try-error")
+on_failure(is.error) <- function(call, env) {
+ paste0(deparse(call$x), " is not a try-error")
+}
+
+#' @export
+#' @rdname assert-is
+is.time <- function(x) inherits(x, "POSIXt")
+on_failure(is.time) <- function(call, env) {
+ paste0(deparse(call$x), " is not a POSIXt date-time object")
+}
+
+#' @export
+#' @rdname assert-is
+is.date <- function(x) inherits(x, "Date")
+on_failure(is.date) <- function(call, env) {
+ paste0(deparse(call$x), " is not a Date object")
+}
+
+#' Check a function has specified arguments
+#'
+#' @param f a function
+#' @param args a character vector of argument names
+#' @param exact if \code{TRUE}, argument names must match \code{args}
+#' exactly (order and value); otherwise \code{f} just must have at least
+#' \code{args} in any order
+#' @export
+#' @examples
+#' has_args(mean, "x")
+#' has_args(mean, "x", exact = TRUE)
+#'
+#' see_if(mean %has_args% "x")
+#' see_if(mean %has_args% "y")
+has_args <- function(f, args, exact = FALSE) {
+ assert_that(is.function(f))
+
+ if (exact) {
+ identical(args, names(formals(f)))
+ } else {
+ all(args %in% names(formals(f)))
+ }
+}
+on_failure(has_args) <- function(call, env) {
+ args <- paste(eval(call$args, env), collapse = ", ")
+ paste0("Function " , deparse(call$f), " does not have arguments ", args)
+}
+
+#' @export
+#' @rdname has_args
+"%has_args%" <- function(f, args) has_args(f, args)
+
+#' Check an object doesn't have any empty dimensions
+#'
+#' @param x object to test
+#' @family assertions
+#' @export
+#' @examples
+#' not_empty(numeric())
+#' not_empty(mtcars[0, ])
+#' not_empty(mtcars[, 0])
+not_empty <- function(x) {
+ all((dim(x) %||% length(x)) != 0)
+}
+on_failure(not_empty) <- function(call, env) {
+ paste0(deparse(call$x), " has an empty dimension")
+}
diff --git a/R/base-comparison.r b/R/base-comparison.r
new file mode 100644
index 0000000..19ed30f
--- /dev/null
+++ b/R/base-comparison.r
@@ -0,0 +1,17 @@
+#' @include base.r
+NULL
+
+logical_is_not <- function(failed) {
+ function(call, env) {
+ lhs <- paste(deparse(call[[2]]), collapse = "")
+ rhs <- paste(deparse(call[[3]]), collapse = "")
+ paste0(lhs, " not ", failed, " ", rhs)
+ }
+}
+
+base_fs$"==" <- logical_is_not("equal to")
+base_fs$"<" <- logical_is_not("less than")
+base_fs$">" <- logical_is_not("greater than")
+base_fs$">=" <- logical_is_not("greater than or equal to")
+base_fs$"<=" <- logical_is_not("less than or equal to")
+base_fs$"!=" <- logical_is_not("not equal to")
diff --git a/R/base-is.r b/R/base-is.r
new file mode 100644
index 0000000..3806dbc
--- /dev/null
+++ b/R/base-is.r
@@ -0,0 +1,49 @@
+#' @include base.r
+NULL
+
+is_not <- function(thing) {
+ function(call, env) {
+ paste0(deparse(call[[2]]), " is not ", thing)
+ }
+}
+
+# Vectors
+base_fs$is.atomic <- is_not("an atomic vector")
+base_fs$is.character <- is_not("a character vector")
+base_fs$is.complex <- is_not("a complex vector")
+base_fs$is.double <- is_not("a numeric vector")
+base_fs$is.integer <- is_not("an integer vector")
+base_fs$is.numeric <- is_not("a numeric or integer vector")
+base_fs$is.raw <- is_not("a raw vector")
+base_fs$is.vector <- is_not("an atomic vector without attributes")
+
+# Factors
+base_fs$is.factor <- is_not("a factor")
+base_fs$is.ordered <- is_not("an ordered factor")
+
+# More complicated data structures
+base_fs$is.array <- is_not("an array")
+base_fs$is.data.frame <- is_not("a data frame")
+base_fs$is.list <- is_not("a list")
+base_fs$is.matrix <- is_not("a matrix")
+base_fs$is.null <- is_not("NULL")
+
+# Functions and environments
+base_fs$is.environment <- is_not("an environment")
+base_fs$is.function <- is_not("a function")
+base_fs$is.primitive <- is_not("a primitive function")
+
+# Computing on the language
+base_fs$is.call <- is_not("a quoted call")
+base_fs$is.expression <- is_not("an expression object")
+base_fs$is.name <- is_not("a name")
+base_fs$is.pairlist <- is_not("a pairlist")
+base_fs$is.recursive <- is_not("a recursive object")
+base_fs$is.symbol <- is_not("a name")
+
+
+# Catch all
+base_fs$inherits <- function(call, env) {
+ class <- eval(call$what, env)
+ paste0(deparse(call$x), " does not inherit from class ", class)
+}
diff --git a/R/base-logical.r b/R/base-logical.r
new file mode 100644
index 0000000..c783395
--- /dev/null
+++ b/R/base-logical.r
@@ -0,0 +1,34 @@
+#' @include base.r
+NULL
+
+base_fs$"&&" <- function(call, env) {
+ lhs <- eval(call[[2]], env)
+ if (!lhs) {
+ get_message(lhs, call[[2]], env)
+ } else {
+ rhs <- eval(call[[3]], env)
+ get_message(rhs, call[[3]], env)
+ }
+}
+
+base_fs$"||" <- function(call, env) {
+ lhs <- eval(call[[2]], env)
+ l_msg <- get_message(lhs, call[[2]], env)
+
+ rhs <- eval(call[[3]], env)
+ r_msg <- get_message(rhs, call[[3]], env)
+
+ paste0(l_msg, " or ", r_msg)
+}
+
+base_fs$any <- function(call, env) {
+ paste0("No elements of ", deparse(call[[2]]), " are true")
+}
+base_fs$all <- function(call, env) {
+ res <- eval(call[[2]], env)
+ i <- which(!res)
+ if (length(i) > 10) i <- c(i[1:5], "...")
+
+ paste0("Elements ", paste(i, collapse = ", "), " of ",
+ deparse(call[[2]]), " are not true")
+}
diff --git a/R/base-misc.r b/R/base-misc.r
new file mode 100644
index 0000000..8e532b2
--- /dev/null
+++ b/R/base-misc.r
@@ -0,0 +1,15 @@
+#' @include base.r
+NULL
+
+base_fs$file.exists <- function(call, env) {
+ path <- eval(call[[2]], env)
+ paste0("Path '", path, "' does not exist")
+}
+
+base_fs$anyDuplicated <- function(call, env) {
+ paste0(call$x, " is not unique")
+}
+
+base_fs$identical <- function(call, env) {
+ paste0(deparse(call$x), " not identical to ", deparse(call$y))
+}
diff --git a/R/base.r b/R/base.r
new file mode 100644
index 0000000..1bce4fc
--- /dev/null
+++ b/R/base.r
@@ -0,0 +1 @@
+base_fs <- new.env(parent = emptyenv())
diff --git a/R/on-failure.r b/R/on-failure.r
new file mode 100644
index 0000000..7abfe8d
--- /dev/null
+++ b/R/on-failure.r
@@ -0,0 +1,29 @@
+#' Custom failure messages for assertions.
+#'
+#' @param x a assertion function that returns \code{TRUE} if the assertion
+#' is met, \code{FALSE} otherwise.
+#' @param value a function with parameters \code{call} and \code{env}
+#' that returns a custom error message as a string.
+#' @export
+#' @examples
+#' is_odd <- function(x) {
+#' assert_that(is.numeric(x), length(x) == 1)
+#' x %% 2 == 1
+#' }
+#' see_if(is_odd(2))
+#'
+#' on_failure(is_odd) <- function(call, env) {
+#' paste0(deparse(call$x), " is even")
+#' }
+#' see_if(is_odd(2))
+on_failure <- function(x) attr(x, "fail")
+
+
+#' @export
+#' @rdname on_failure
+#' @usage on_failure(x) <- value
+"on_failure<-" <- function(x, value) {
+ stopifnot(is.function(x), identical(names(formals(value)), c("call", "env")))
+ attr(x, "fail") <- value
+ x
+}
diff --git a/R/utils.r b/R/utils.r
new file mode 100644
index 0000000..6c1d87e
--- /dev/null
+++ b/R/utils.r
@@ -0,0 +1 @@
+"%||%" <- function(a, b) if (is.null(a)) b else a
diff --git a/R/validate-that.R b/R/validate-that.R
new file mode 100644
index 0000000..16feefb
--- /dev/null
+++ b/R/validate-that.R
@@ -0,0 +1,25 @@
+#' Validate that certain conditions are true.
+#'
+#' \code{validate_that} is an alternative to the function
+#' \code{\link{assert_that}}, that returns a \code{character} vector. This
+#' makes them easier to use within S4 \code{"validate"} methods.
+#'
+#' @inheritParams assert_that
+#' @return A \code{character} vector if the assertion is false, or \code{TRUE}
+#' if the assertion is true.
+#' @export
+#' @seealso \code{\link{assert_that}}, which returns an error if the condition
+#' is false.
+#' @examples
+#' x <- 1
+#' # assert_that() generates errors, so can't be usefully run in
+#' # examples
+#' validate_that(is.numeric(x))
+#' validate_that(is.character(x))
+#' validate_that(length(x) == 3)
+#' validate_that(is.dir("asdf"))
+validate_that <- function(..., env = parent.frame()) {
+ res <- see_if(..., env = env)
+ if (res) return(TRUE)
+ return(attr(res, "msg"))
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..b2a4061
--- /dev/null
+++ b/README.md
@@ -0,0 +1,85 @@
+# assertthat
+
+assertthat provides a drop in replacement for `stopifnot()` that makes it easy to check the pre- and post-conditions of a function, while producing useful error messages.
+
+```R
+x <- 1:10
+stopifnot(is.character(x))
+# Error: is.character(x) is not TRUE
+
+assert_that(is.character(x))
+# Error: x is not a character vector
+
+assert_that(length(x) == 5)
+# Error: length(x) not equal to 5
+
+assert_that(is.numeric(x))
+# [1] TRUE
+```
+
+This is a good defensive programming technique, and is useful as source-code documentation: you can see exactly what your function expects when you come back to it in the future. It is partly a response to the lack of static typing in R, but it allow you to test for general conditions (like `length(x) == length(y)`) that are difficult to express in a type system.
+
+`assertthat` is not yet available on CRAN, but you can install it with devtools:
+
+```R
+devtools::install_github("hadley/assertthat")
+```
+
+## New assertions
+
+As well as all the functions provided by R, assertthat provides a few more that I use a lot:
+
+* `is.flag(x)`: is x `TRUE` or `FALSE`? (a boolean flag)
+* `is.string(x)`: is x a length 1 character vector?
+* `has_name(x, nm)`, `x %has_name% nm`: does `x` have component `nm`?
+* `has_attr(x, attr)`, `x %has_attr% attr`: does `x` have attribute `attr`?
+* `is.count(x)`: is x a single positive integer?
+* `are_equal(x, y)`: are `x` and `y` equal?
+* `not_empty(x)`: are all dimensions of `x` greater than 0?
+* `noNA(x)`: is `x` free from missing values?
+* `is.dir(path)`: is `path` a directory?
+* `is.writeable(path)`/`is.readable(path)`: is `path` writeable/readable?
+* `has_extension(path, extension)`: does `file` have given `extension`?
+
+## `assert_that`, `see_if` and `validate_that`
+
+There are two main functions in assertthat:
+
+* `assert_that()` signal an error
+
+* `see_if()` returns a logical value, with the error message as an attribute.
+
+* `validate_that()` returns `TRUE` on success, otherwise returns the error as
+ a string.
+
+You'll use `assert_that()` in your own code, but you'll mostly see `see_if()` in the examples (because `R CMD check` requires that examples run without errors). Use `validate_that()` for S4 validate methods.
+
+## Writing your own assertions
+
+If you're writing your own assertions, you can provide custom error messages using the `on_failure()` helper:
+
+```R
+is_odd <- function(x) {
+ assert_that(is.numeric(x), length(x) == 1)
+ x %% 2 == 1
+}
+assert_that(is_odd(2))
+# Error: is_odd(x = 2) is not TRUE
+
+on_failure(is_odd) <- function(call, env) {
+ paste0(deparse(call$x), " is even")
+}
+assert_that(is_odd(2))
+# Error: 2 is even
+```
+
+The `on_failure` callback is called with two arguments, the unevaluated function `call` (which has already been standardised with `match.call()`), and `env`, and the environment in which the assertion was executed. This allows you to choose between displaying values or names in your error messages. Read the [advanced R book](http://adv-r.had.co.nz/Expressions.html) to learn more about working with calls.
+
+Also note the use of `assert_that()` in our new function: assertions flow through function calls ensuring that you get a useful error message at the top level:
+
+```R
+assert_that(is_odd("b"))
+# Error: x is not a numeric or integer vector
+assert_that(is_odd(1:2))
+# Error: length(x) not equal to 1
+```
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 2bfedc8..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,9 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
-cd tests
-LC_ALL=C R --no-save < test-that.R
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index d7f40a1..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,5 +0,0 @@
-r-cran-assertthat (0.1-1) unstable; urgency=low
-
- * Initial release (Closes: #818985)
-
- -- Andreas Tille <tille at debian.org> Tue, 22 Mar 2016 16:24:55 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index 41a873f..0000000
--- a/debian/control
+++ /dev/null
@@ -1,22 +0,0 @@
-Source: r-cran-assertthat
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9),
- cdbs,
- r-base-dev
-Standards-Version: 3.9.7
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-assertthat/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-assertthat/trunk/
-Homepage: https://cran.r-project.org/web/packages/assertthat/
-
-Package: r-cran-assertthat
-Architecture: all
-Depends: ${misc:Depends},
- ${R:Depends}
-Description: GNU R easy pre and post assertions
- Assertthat is an extension to stopifnot() that makes it easy to declare
- the pre and post conditions that you code should satisfy, while also
- producing friendly error messages so that your users know what they've
- done wrong.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index ce9b697..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,27 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Hadley Wickham <h.wickham at gmail.com>
-Source: https://cran.r-project.org/web/packages/assertthat/
-
-Files: *
-Copyright: 2013-2015 Hadley Wickham <h.wickham at gmail.com>
-License: GPL-3
-
-Files: debian/*
-Copyright: 2016 Andreas Tille <tille at debian.org>
-License: GPL-3
-
-License: GPL-3
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, version 3 of the License.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
- .
- On a Debian system, the GNU GPL license is distributed in the file
- ‘/usr/share/common-licenses/GPL-3'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 2fbba2d..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/make -f
-
-include /usr/share/R/debian/r-cran.mk
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index d9b7789..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/sh -e
-
-oname=assertthat
-pkg=r-cran-`echo $oname | tr [A-Z] [a-z]`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-LC_ALL=C R --no-save < test-that.R
-rm -fr $ADTTMP/*
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index b96e809..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/assertthat_([-0-9\.]*).tar.gz
-
diff --git a/inst/tests/test-base.R b/inst/tests/test-base.R
new file mode 100644
index 0000000..88fb0a6
--- /dev/null
+++ b/inst/tests/test-base.R
@@ -0,0 +1,15 @@
+context("Base assertions")
+
+test_that("any message is useful", {
+ expect_equal(validate_that(any(TRUE, FALSE)), TRUE)
+
+ x <- c(FALSE, FALSE)
+ expect_equal(validate_that(any(x)), "No elements of x are true")
+})
+
+test_that("all message is useful", {
+ expect_equal(validate_that(all(TRUE, TRUE)), TRUE)
+
+ x <- c(FALSE, TRUE)
+ expect_match(validate_that(all(x)), "Elements .* of x are not true")
+})
\ No newline at end of file
diff --git a/man/are_equal.Rd b/man/are_equal.Rd
new file mode 100644
index 0000000..c5f45df
--- /dev/null
+++ b/man/are_equal.Rd
@@ -0,0 +1,30 @@
+\name{are_equal}
+\alias{are_equal}
+\title{Are two objects equal?}
+\usage{
+are_equal(x, y, ...)
+}
+\arguments{
+ \item{x,y}{objects to compare}
+
+ \item{...}{additional arguments passed to
+ \code{\link{all.equal}}}
+}
+\description{
+Are two objects equal?
+}
+\examples{
+x <- 2
+see_if(are_equal(x, 1.9))
+see_if(are_equal(x, 1.999, tol = 0.01))
+see_if(are_equal(x, 2))
+}
+\seealso{
+Other assertions: \code{\link{is.count}},
+ \code{\link{is.flag}}, \code{\link{is.number}},
+ \code{\link{is.scalar}}, \code{\link{is.string}};
+ \code{\link{is.date}}, \code{\link{is.error}},
+ \code{\link{is.time}}; \code{\link{noNA}};
+ \code{\link{not_empty}}
+}
+
diff --git a/man/assert-is.Rd b/man/assert-is.Rd
new file mode 100644
index 0000000..60a17e2
--- /dev/null
+++ b/man/assert-is.Rd
@@ -0,0 +1,34 @@
+\name{assert-is}
+\alias{is.date}
+\alias{is.error}
+\alias{is.time}
+\title{Missing is functions.}
+\usage{
+is.error(x)
+
+is.time(x)
+
+is.date(x)
+}
+\arguments{
+ \item{x}{object to test}
+}
+\description{
+Missing is functions.
+}
+\examples{
+a <- Sys.time()
+is.time(a)
+b <- Sys.Date()
+is.date(b)
+c <- try(stop("!!"))
+is.error(c)
+}
+\seealso{
+Other assertions: \code{\link{are_equal}};
+ \code{\link{is.count}}, \code{\link{is.flag}},
+ \code{\link{is.number}}, \code{\link{is.scalar}},
+ \code{\link{is.string}}; \code{\link{noNA}};
+ \code{\link{not_empty}}
+}
+
diff --git a/man/assert_that.Rd b/man/assert_that.Rd
new file mode 100644
index 0000000..9c6c326
--- /dev/null
+++ b/man/assert_that.Rd
@@ -0,0 +1,59 @@
+\name{assert_that}
+\alias{assert_that}
+\alias{see_if}
+\title{Assert that certain conditions are true.}
+\usage{
+assert_that(..., env = parent.frame())
+
+see_if(..., env = parent.frame())
+}
+\arguments{
+ \item{...}{unnamed expressions that describe the
+ conditions to be tested. Rather than combining
+ expressions with \code{&&}, separate them by commas so
+ that better error messages can be generated.}
+
+ \item{env}{(advanced use only) the environment in which
+ to evaluate the assertions.}
+}
+\description{
+\code{assert_that} is a drop-in replacement for \code{\link{stopifnot}} but
+is designed to give informative error messages.
+}
+\section{Assertions}{
+ Assertion functions should return a single \code{TRUE} or
+ \code{FALSE}: any other result is an error, and
+ \code{assert_that} will complain about it. This will
+ always be the case for the assertions provided by
+ \code{assertthat}, but you may need be a more careful for
+ base R functions.
+
+ To make your own assertions that work with
+ \code{assert_that}, see the help for
+ \code{\link{on_failure}}.
+}
+\examples{
+x <- 1
+# assert_that() generates errors, so can't be usefully run in
+# examples
+\dontrun{
+assert_that(is.character(x))
+assert_that(length(x) == 3)
+assert_that(is.dir("asdf"))
+y <- tempfile()
+writeLines("", y)
+assert_that(is.dir(y))
+}
+
+# But see_if just returns the values, so you'll see that a lot
+# in the examples: but remember to use assert_that in your code.
+see_if(is.character(x))
+see_if(length(x) == 3)
+see_if(is.dir(17))
+see_if(is.dir("asdf"))
+}
+\seealso{
+\code{\link{validate_that}}, which returns a message (not an error)
+ if the condition is false.
+}
+
diff --git a/man/assertions-file.Rd b/man/assertions-file.Rd
new file mode 100644
index 0000000..17928ac
--- /dev/null
+++ b/man/assertions-file.Rd
@@ -0,0 +1,42 @@
+\name{assertions-file}
+\alias{assertions-file}
+\alias{has_extension}
+\alias{is.dir}
+\alias{is.readable}
+\alias{is.writeable}
+\title{Useful test related to files}
+\usage{
+is.dir(path)
+
+is.writeable(path)
+
+is.readable(path)
+
+has_extension(path, ext)
+}
+\arguments{
+ \item{path}{a file path to examine}
+
+ \item{ext}{extension to test for (\code{has_extension}
+ only)}
+}
+\description{
+Useful test related to files
+}
+\examples{
+see_if(is.dir(1))
+
+tmp <- tempfile()
+see_if(file.exists(tmp))
+see_if(is.dir(tmp))
+
+writeLines("x", tmp)
+see_if(file.exists(tmp))
+see_if(is.dir(tmp))
+see_if(is.writeable(tmp))
+see_if(is.readable(tmp))
+unlink(tmp)
+
+see_if(is.readable(tmp))
+}
+
diff --git a/man/has_args.Rd b/man/has_args.Rd
new file mode 100644
index 0000000..9f5d408
--- /dev/null
+++ b/man/has_args.Rd
@@ -0,0 +1,29 @@
+\name{has_args}
+\alias{\%has_args\%}
+\alias{has_args}
+\title{Check a function has specified arguments}
+\usage{
+has_args(f, args, exact = FALSE)
+
+f \%has_args\% args
+}
+\arguments{
+ \item{f}{a function}
+
+ \item{args}{a character vector of argument names}
+
+ \item{exact}{if \code{TRUE}, argument names must match
+ \code{args} exactly (order and value); otherwise \code{f}
+ just must have at least \code{args} in any order}
+}
+\description{
+Check a function has specified arguments
+}
+\examples{
+has_args(mean, "x")
+has_args(mean, "x", exact = TRUE)
+
+see_if(mean \%has_args\% "x")
+see_if(mean \%has_args\% "y")
+}
+
diff --git a/man/has_attr.Rd b/man/has_attr.Rd
new file mode 100644
index 0000000..31f4b6f
--- /dev/null
+++ b/man/has_attr.Rd
@@ -0,0 +1,32 @@
+\name{has_attr}
+\alias{\%has_attr\%}
+\alias{\%has_name\%}
+\alias{has_attr}
+\alias{has_name}
+\title{Has attribute or name?}
+\usage{
+has_attr(x, which)
+
+x \%has_attr\% which
+
+has_name(x, which)
+
+x \%has_name\% which
+}
+\arguments{
+ \item{x}{object to test}
+
+ \item{which}{name or attribute}
+}
+\description{
+Has attribute or name?
+}
+\examples{
+has_attr(has_attr, "fail")
+x <- 10
+x \%has_attr\% "a"
+
+y <- list(a = 1, b = 2)
+see_if(y \%has_name\% "c")
+}
+
diff --git a/man/noNA.Rd b/man/noNA.Rd
new file mode 100644
index 0000000..cec67f9
--- /dev/null
+++ b/man/noNA.Rd
@@ -0,0 +1,27 @@
+\name{noNA}
+\alias{noNA}
+\title{Does object contain any missing values?}
+\usage{
+noNA(x)
+}
+\arguments{
+ \item{x}{object to test}
+}
+\description{
+Does object contain any missing values?
+}
+\examples{
+see_if(noNA("a"))
+see_if(noNA(c(TRUE, NA)))
+x <- sample(c(1:10, NA), 100, rep = TRUE)
+see_if(noNA(x))
+}
+\seealso{
+Other assertions: \code{\link{are_equal}};
+ \code{\link{is.count}}, \code{\link{is.flag}},
+ \code{\link{is.number}}, \code{\link{is.scalar}},
+ \code{\link{is.string}}; \code{\link{is.date}},
+ \code{\link{is.error}}, \code{\link{is.time}};
+ \code{\link{not_empty}}
+}
+
diff --git a/man/not_empty.Rd b/man/not_empty.Rd
new file mode 100644
index 0000000..f2cc986
--- /dev/null
+++ b/man/not_empty.Rd
@@ -0,0 +1,26 @@
+\name{not_empty}
+\alias{not_empty}
+\title{Check an object doesn't have any empty dimensions}
+\usage{
+not_empty(x)
+}
+\arguments{
+ \item{x}{object to test}
+}
+\description{
+Check an object doesn't have any empty dimensions
+}
+\examples{
+not_empty(numeric())
+not_empty(mtcars[0, ])
+not_empty(mtcars[, 0])
+}
+\seealso{
+Other assertions: \code{\link{are_equal}};
+ \code{\link{is.count}}, \code{\link{is.flag}},
+ \code{\link{is.number}}, \code{\link{is.scalar}},
+ \code{\link{is.string}}; \code{\link{is.date}},
+ \code{\link{is.error}}, \code{\link{is.time}};
+ \code{\link{noNA}}
+}
+
diff --git a/man/on_failure.Rd b/man/on_failure.Rd
new file mode 100644
index 0000000..752035c
--- /dev/null
+++ b/man/on_failure.Rd
@@ -0,0 +1,33 @@
+\name{on_failure}
+\alias{on_failure}
+\alias{on_failure<-}
+\title{Custom failure messages for assertions.}
+\usage{
+on_failure(x)
+
+on_failure(x) <- value
+}
+\arguments{
+ \item{x}{a assertion function that returns \code{TRUE} if
+ the assertion is met, \code{FALSE} otherwise.}
+
+ \item{value}{a function with parameters \code{call} and
+ \code{env} that returns a custom error message as a
+ string.}
+}
+\description{
+Custom failure messages for assertions.
+}
+\examples{
+is_odd <- function(x) {
+ assert_that(is.numeric(x), length(x) == 1)
+ x \%\% 2 == 1
+}
+see_if(is_odd(2))
+
+on_failure(is_odd) <- function(call, env) {
+ paste0(deparse(call$x), " is even")
+}
+see_if(is_odd(2))
+}
+
diff --git a/man/scalar.Rd b/man/scalar.Rd
new file mode 100644
index 0000000..7e1c432
--- /dev/null
+++ b/man/scalar.Rd
@@ -0,0 +1,56 @@
+\name{scalar}
+\alias{is.count}
+\alias{is.flag}
+\alias{is.number}
+\alias{is.scalar}
+\alias{is.string}
+\title{Assert input is a scalar.}
+\usage{
+is.scalar(x)
+
+is.string(x)
+
+is.number(x)
+
+is.flag(x)
+
+is.count(x)
+}
+\arguments{
+ \item{x}{object to test}
+}
+\description{
+\code{is.scala} provides a generic method for checking input is a scalar.
+\code{is.string}, \code{is.flag}, \code{is.number} and \code{is.count}
+provide tests for specific types.
+}
+\examples{
+# Generic check for scalars
+see_if(is.scalar("a"))
+see_if(is.scalar(1:10))
+# string = scalar character vector
+see_if(is.string(1:3))
+see_if(is.string(c("a", "b")))
+see_if(is.string("x"))
+# number = scalar numeric/integer vector
+see_if(is.number(1:3))
+see_if(is.number(1.5))
+# flag = scalar numeric/integer vector
+see_if(is.flag(1:3))
+see_if(is.flag("a"))
+see_if(is.flag(c(FALSE, FALSE, TRUE)))
+see_if(is.flag(FALSE))
+# flag = scalar positive integer
+see_if(is.count("a"))
+see_if(is.count(-1))
+see_if(is.count(1:5))
+see_if(is.count(1.5))
+see_if(is.count(1))
+}
+\seealso{
+Other assertions: \code{\link{are_equal}};
+ \code{\link{is.date}}, \code{\link{is.error}},
+ \code{\link{is.time}}; \code{\link{noNA}};
+ \code{\link{not_empty}}
+}
+
diff --git a/man/validate_that.Rd b/man/validate_that.Rd
new file mode 100644
index 0000000..e1a55be
--- /dev/null
+++ b/man/validate_that.Rd
@@ -0,0 +1,38 @@
+\name{validate_that}
+\alias{validate_that}
+\title{Validate that certain conditions are true.}
+\usage{
+validate_that(..., env = parent.frame())
+}
+\arguments{
+ \item{...}{unnamed expressions that describe the
+ conditions to be tested. Rather than combining
+ expressions with \code{&&}, separate them by commas so
+ that better error messages can be generated.}
+
+ \item{env}{(advanced use only) the environment in which
+ to evaluate the assertions.}
+}
+\value{
+A \code{character} vector if the assertion is false, or \code{TRUE}
+if the assertion is true.
+}
+\description{
+\code{validate_that} is an alternative to the function
+\code{\link{assert_that}}, that returns a \code{character} vector. This
+makes them easier to use within S4 \code{"validate"} methods.
+}
+\examples{
+x <- 1
+# assert_that() generates errors, so can't be usefully run in
+# examples
+validate_that(is.numeric(x))
+validate_that(is.character(x))
+validate_that(length(x) == 3)
+validate_that(is.dir("asdf"))
+}
+\seealso{
+\code{\link{assert_that}}, which returns an error if the condition
+is false.
+}
+
diff --git a/tests/test-that.R b/tests/test-that.R
new file mode 100644
index 0000000..9be2b16
--- /dev/null
+++ b/tests/test-that.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(assertthat)
+
+test_package("assertthat")
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-assertthat.git
More information about the debian-med-commit
mailing list