[med-svn] [r-cran-assertthat] 05/11: New upstream version 0.2.0

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 9e3f996b2a22e1673ae97f9e0cdb480cb23c8dd7
Author: Andreas Tille <tille at debian.org>
Date:   Thu Sep 28 19:23:14 2017 +0200

    New upstream version 0.2.0
---
 DESCRIPTION                                |  18 +++--
 MD5                                        |  45 ++++++-----
 NAMESPACE                                  |   3 +-
 R/assert-that.r                            |  20 +++--
 R/assertions-file.r                        |   5 +-
 R/assertions-scalar.R                      |   6 +-
 R/assertions.r                             |   4 +-
 R/validate-that.R                          |   4 +-
 README.md                                  |  14 +++-
 man/are_equal.Rd                           |  15 ++--
 man/assert-is.Rd                           |  13 ++--
 man/assert_that.Rd                         |  45 ++++++-----
 man/assertions-file.Rd                     |  12 +--
 man/has_args.Rd                            |  15 ++--
 man/has_attr.Rd                            |  11 +--
 man/noNA.Rd                                |  12 ++-
 man/not_empty.Rd                           |  12 ++-
 man/on_failure.Rd                          |  12 +--
 man/scalar.Rd                              |  27 ++++---
 man/validate_that.Rd                       |  19 +++--
 tests/{test-that.R => testthat.R}          |   2 +-
 tests/testthat/test-assertions.R           | 118 +++++++++++++++++++++++++++++
 {inst/tests => tests/testthat}/test-base.R |   6 +-
 tests/testthat/test-file.R                 |  41 ++++++++++
 tests/testthat/test-scalar.R               |  55 ++++++++++++++
 25 files changed, 390 insertions(+), 144 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 8bd2435..5c6068d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,21 +1,23 @@
 Package: assertthat
-Title: Easy pre and post assertions.
-Version: 0.1
-Authors at R: 'Hadley Wickham <h.wickham at gmail.com> [aut,cre]'
+Title: Easy Pre and Post Assertions
+Version: 0.2.0
+Authors at R: 
+  person("Hadley", "Wickham", , "hadley at rstudio.com", c("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
+Imports: tools
 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>
+RoxygenNote: 6.0.1
 NeedsCompilation: no
+Packaged: 2017-04-10 19:00:43 UTC; hadley
+Author: Hadley Wickham [aut, cre]
+Maintainer: Hadley Wickham <hadley at rstudio.com>
 Repository: CRAN
-Date/Publication: 2013-12-06 00:51:10
+Date/Publication: 2017-04-11 21:28:45 UTC
diff --git a/MD5 b/MD5
index 7313dc6..faa7280 100644
--- a/MD5
+++ b/MD5
@@ -1,9 +1,9 @@
-9d6f40f50ee12be47c061798a93f54a5 *DESCRIPTION
-da16c2e00f9ad6320ca55102ff2bf900 *NAMESPACE
-6700dc426204d6942aa9493d0f401117 *R/assert-that.r
-b8a27b28dc330772b389b29bd6156223 *R/assertions-file.r
-8c016508a2d5a00f76f4ed1d223dfdce *R/assertions-scalar.R
-bccfd0f930aaade21d8d00131d2b2ae0 *R/assertions.r
+07a698042f2f9f5ab2218528d2ccb37d *DESCRIPTION
+bb79293f1ab9e2d571ff3428f2783ac4 *NAMESPACE
+f4b21e96be18c208d939c7f7e40239b9 *R/assert-that.r
+c8af5f3dfed9fc81afb7ebd8a4dc8a57 *R/assertions-file.r
+154eb9399c030c8713d1550f65ed0ab9 *R/assertions-scalar.R
+ad16ac5a3ebd217c6d3271d2bcd16207 *R/assertions.r
 bf48a75f9c36892a64e81da55ede64ed *R/base-comparison.r
 6e2ffc34b89617577cd86d68edffa8b7 *R/base-is.r
 487ba0225528ba58e80015de661dc6ba *R/base-logical.r
@@ -11,18 +11,21 @@ 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
+e706aa5d6a5cd888705e86ff303ea78b *R/validate-that.R
+d96d8c06fce52277edb9a14501cd4c0a *README.md
+f5a71fac111703163ed68d02f1e0979f *man/are_equal.Rd
+5117a630d5932adf4c66c16e987cd0f2 *man/assert-is.Rd
+5d8fa47b8988ebdac0c7fb594d2092ff *man/assert_that.Rd
+b92b5415b5961f66f95f4ace3b25f073 *man/assertions-file.Rd
+dc5a3728c016bc6f13b5771ff799c457 *man/has_args.Rd
+bc27b0b826ab37c6bc46d12266b815ef *man/has_attr.Rd
+fb36eafcdd7f0484a9eb8fc881b3d8cf *man/noNA.Rd
+dec5540a428715f1e256b791b144dd84 *man/not_empty.Rd
+36fc2fa519ef6b2af0b2a29ba8f0ed76 *man/on_failure.Rd
+52e664c380303f85d11cb1e65534e694 *man/scalar.Rd
+ac5a46b2fbda515a96e1e5455120a5f5 *man/validate_that.Rd
+ba66accab371620d17856bf99192b710 *tests/testthat.R
+c88f0213440ffde9b972ce2efebbc743 *tests/testthat/test-assertions.R
+94f403145c6ca9bc307d38b154b0c14d *tests/testthat/test-base.R
+5bda953b24f68051e5788d8592eae233 *tests/testthat/test-file.R
+4217b26332614578760405ab126b09a7 *tests/testthat/test-scalar.R
diff --git a/NAMESPACE b/NAMESPACE
index 1c09035..8b89e6e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,3 +1,5 @@
+# Generated by roxygen2: do not edit by hand
+
 export("%has_args%")
 export("%has_attr%")
 export("%has_name%")
@@ -24,4 +26,3 @@ 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
index acc7ebe..eacc0b3 100644
--- a/R/assert-that.r
+++ b/R/assert-that.r
@@ -12,13 +12,16 @@
 #' base R functions.
 #'
 #' To make your own assertions that work with \code{assert_that},
-#' see the help for \code{\link{on_failure}}.
+#' see the help for \code{\link{on_failure}}.  Alternatively, a custom message
+#' can be specified for each call.
 #'
 #' @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.
+#' @param msg a custom error message to be printed if one of the conditions is
+#'   false.
 #' @seealso \code{\link{validate_that}}, which returns a message (not an error)
 #'   if the condition is false.
 #' @export
@@ -33,6 +36,7 @@
 #' y <- tempfile()
 #' writeLines("", y)
 #' assert_that(is.dir(y))
+#' assert_that(FALSE, msg = "Custom error message")
 #' }
 #'
 #' # But see_if just returns the values, so you'll see that a lot
@@ -41,8 +45,9 @@
 #' 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)
+#' see_if(5 < 3, msg = "Five is not smaller than three")
+assert_that <- function(..., env = parent.frame(), msg = NULL) {
+  res <- see_if(..., env = env, msg = msg)
   if (res) return(TRUE)
 
   stop(assertError(attr(res, "msg")))
@@ -55,7 +60,7 @@ assertError <- function (message, call = NULL) {
 
 #' @rdname assert_that
 #' @export
-see_if <- function(..., env = parent.frame()) {
+see_if <- function(..., env = parent.frame(), msg = NULL) {
   asserts <- eval(substitute(alist(...)))
 
   for (assertion in asserts) {
@@ -68,7 +73,8 @@ see_if <- function(..., env = parent.frame()) {
 
     # Failed, so figure out message to produce
     if (!res) {
-      msg <- get_message(res, assertion, env)
+      if (is.null(msg))
+        msg <- get_message(res, assertion, env)
       return(structure(FALSE, msg = msg))
     }
   }
@@ -81,8 +87,8 @@ check_result <- function(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)
+  if (length(x) != 1) {
+    stop("assert_that: length of assertion is not 1", call. = FALSE)
   }
 
   TRUE
diff --git a/R/assertions-file.r b/R/assertions-file.r
index ab44572..9a8264b 100644
--- a/R/assertions-file.r
+++ b/R/assertions-file.r
@@ -53,14 +53,13 @@ is.readable <- function(path) {
 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
+  tools::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)
+  paste0("File '", basename(path), "' does not have extension ", ext)
 }
diff --git a/R/assertions-scalar.R b/R/assertions-scalar.R
index 920a716..776eff6 100644
--- a/R/assertions-scalar.R
+++ b/R/assertions-scalar.R
@@ -3,7 +3,7 @@ NULL
 
 #' Assert input is a scalar.
 #' 
-#' \code{is.scala} provides a generic method for checking input is a scalar.
+#' \code{is.scalar} 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.
 #' 
@@ -58,7 +58,7 @@ on_failure(is.number) <- function(call, env) {
 #' @rdname scalar
 #' @export
 #' @examples
-#' # flag = scalar numeric/integer vector
+#' # flag = scalar logical vector
 #' see_if(is.flag(1:3))
 #' see_if(is.flag("a"))
 #' see_if(is.flag(c(FALSE, FALSE, TRUE)))
@@ -73,7 +73,7 @@ on_failure(is.flag) <- function(call, env) {
 #' @rdname scalar
 #' @export
 #' @examples
-#' # flag = scalar positive integer
+#' # count = scalar positive integer
 #' see_if(is.count("a"))
 #' see_if(is.count(-1))
 #' see_if(is.count(1:5))
diff --git a/R/assertions.r b/R/assertions.r
index 69dc9ee..7175f58 100644
--- a/R/assertions.r
+++ b/R/assertions.r
@@ -12,7 +12,7 @@ is.integerish <- function(x) {
 
 is.named <- function(x) {
   nm <- names(x)
-  !is.null(nm) && all(nm != "")
+  !is.null(nm) && all(!is.na(nm) & nm != "")
 }
 on_failure(is.named) <- function(call, env) {
   paste0("Not all elements of ", deparse(call$x), " have names.")
@@ -136,7 +136,7 @@ on_failure(is.date) <- function(call, env) {
 #' 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 {
diff --git a/R/validate-that.R b/R/validate-that.R
index 16feefb..101ed9a 100644
--- a/R/validate-that.R
+++ b/R/validate-that.R
@@ -18,8 +18,8 @@
 #' 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)
+validate_that <- function(..., env = parent.frame(), msg = NULL) {
+  res <- see_if(..., env = env, msg = msg)
   if (res) return(TRUE)
   return(attr(res, "msg"))
 }
diff --git a/README.md b/README.md
index b2a4061..7bf0d0e 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,7 @@
 # assertthat
 
+[![Travis-CI Build Status](https://travis-ci.org/hadley/assertthat.svg?branch=master)](https://travis-ci.org/hadley/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
@@ -17,9 +19,15 @@ 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.
+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 allows you to test for general conditions (like `length(x) == length(y)`) that are difficult to express in a type system.
+
+`assertthat` can be installed either from CRAN: 
+
+```R
+install.packages('assertthat')
+```
 
-`assertthat` is not yet available on CRAN, but you can install it with devtools:
+or with devtools:
 
 ```R
 devtools::install_github("hadley/assertthat")
@@ -43,7 +51,7 @@ As well as all the functions provided by R, assertthat provides a few more that
 
 ## `assert_that`, `see_if` and `validate_that`
 
-There are two main functions in assertthat: 
+There are three main functions in assertthat: 
 
 * `assert_that()` signal an error
 
diff --git a/man/are_equal.Rd b/man/are_equal.Rd
index c5f45df..546a120 100644
--- a/man/are_equal.Rd
+++ b/man/are_equal.Rd
@@ -1,3 +1,5 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{are_equal}
 \alias{are_equal}
 \title{Are two objects equal?}
@@ -5,10 +7,9 @@
 are_equal(x, y, ...)
 }
 \arguments{
-  \item{x,y}{objects to compare}
+\item{x, y}{objects to compare}
 
-  \item{...}{additional arguments passed to
-  \code{\link{all.equal}}}
+\item{...}{additional arguments passed to \code{\link{all.equal}}}
 }
 \description{
 Are two objects equal?
@@ -20,11 +21,7 @@ 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}};
+Other assertions: \code{\link{is.error}},
+  \code{\link{is.scalar}}, \code{\link{noNA}},
   \code{\link{not_empty}}
 }
-
diff --git a/man/assert-is.Rd b/man/assert-is.Rd
index 60a17e2..62cc5c6 100644
--- a/man/assert-is.Rd
+++ b/man/assert-is.Rd
@@ -1,7 +1,9 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{assert-is}
-\alias{is.date}
 \alias{is.error}
 \alias{is.time}
+\alias{is.date}
 \title{Missing is functions.}
 \usage{
 is.error(x)
@@ -11,7 +13,7 @@ is.time(x)
 is.date(x)
 }
 \arguments{
-  \item{x}{object to test}
+\item{x}{object to test}
 }
 \description{
 Missing is functions.
@@ -25,10 +27,7 @@ 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}};
+Other assertions: \code{\link{are_equal}},
+  \code{\link{is.scalar}}, \code{\link{noNA}},
   \code{\link{not_empty}}
 }
-
diff --git a/man/assert_that.Rd b/man/assert_that.Rd
index 9c6c326..7f7df1b 100644
--- a/man/assert_that.Rd
+++ b/man/assert_that.Rd
@@ -1,37 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assert-that.r
 \name{assert_that}
 \alias{assert_that}
 \alias{see_if}
 \title{Assert that certain conditions are true.}
 \usage{
-assert_that(..., env = parent.frame())
+assert_that(..., env = parent.frame(), msg = NULL)
 
-see_if(..., env = parent.frame())
+see_if(..., env = parent.frame(), msg = NULL)
 }
 \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{...}{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.}
+\item{env}{(advanced use only) the environment in which to evaluate the
+assertions.}
+
+\item{msg}{a custom error message to be printed if one of the conditions is
+false.}
 }
 \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}}.
+
+
+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}}.  Alternatively, a custom message
+can be specified for each call.
 }
+
 \examples{
 x <- 1
 # assert_that() generates errors, so can't be usefully run in
@@ -43,6 +49,7 @@ assert_that(is.dir("asdf"))
 y <- tempfile()
 writeLines("", y)
 assert_that(is.dir(y))
+assert_that(FALSE, msg = "Custom error message")
 }
 
 # But see_if just returns the values, so you'll see that a lot
@@ -51,9 +58,9 @@ see_if(is.character(x))
 see_if(length(x) == 3)
 see_if(is.dir(17))
 see_if(is.dir("asdf"))
+see_if(5 < 3, msg = "Five is not smaller than three")
 }
 \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
index 17928ac..c93da57 100644
--- a/man/assertions-file.Rd
+++ b/man/assertions-file.Rd
@@ -1,9 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions-file.r
 \name{assertions-file}
 \alias{assertions-file}
-\alias{has_extension}
 \alias{is.dir}
-\alias{is.readable}
 \alias{is.writeable}
+\alias{is.readable}
+\alias{has_extension}
 \title{Useful test related to files}
 \usage{
 is.dir(path)
@@ -15,10 +17,9 @@ is.readable(path)
 has_extension(path, ext)
 }
 \arguments{
-  \item{path}{a file path to examine}
+\item{path}{a file path to examine}
 
-  \item{ext}{extension to test for (\code{has_extension}
-  only)}
+\item{ext}{extension to test for (\code{has_extension} only)}
 }
 \description{
 Useful test related to files
@@ -39,4 +40,3 @@ unlink(tmp)
 
 see_if(is.readable(tmp))
 }
-
diff --git a/man/has_args.Rd b/man/has_args.Rd
index 9f5d408..556726a 100644
--- a/man/has_args.Rd
+++ b/man/has_args.Rd
@@ -1,6 +1,8 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{has_args}
-\alias{\%has_args\%}
 \alias{has_args}
+\alias{\%has_args\%}
 \title{Check a function has specified arguments}
 \usage{
 has_args(f, args, exact = FALSE)
@@ -8,13 +10,13 @@ has_args(f, args, exact = FALSE)
 f \%has_args\% args
 }
 \arguments{
-  \item{f}{a function}
+\item{f}{a function}
 
-  \item{args}{a character vector of argument names}
+\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}
+\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
@@ -26,4 +28,3 @@ 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
index 31f4b6f..f431d2a 100644
--- a/man/has_attr.Rd
+++ b/man/has_attr.Rd
@@ -1,8 +1,10 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{has_attr}
-\alias{\%has_attr\%}
-\alias{\%has_name\%}
 \alias{has_attr}
+\alias{\%has_attr\%}
 \alias{has_name}
+\alias{\%has_name\%}
 \title{Has attribute or name?}
 \usage{
 has_attr(x, which)
@@ -14,9 +16,9 @@ has_name(x, which)
 x \%has_name\% which
 }
 \arguments{
-  \item{x}{object to test}
+\item{x}{object to test}
 
-  \item{which}{name or attribute}
+\item{which}{name or attribute}
 }
 \description{
 Has attribute or name?
@@ -29,4 +31,3 @@ 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
index cec67f9..9b39a80 100644
--- a/man/noNA.Rd
+++ b/man/noNA.Rd
@@ -1,3 +1,5 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{noNA}
 \alias{noNA}
 \title{Does object contain any missing values?}
@@ -5,7 +7,7 @@
 noNA(x)
 }
 \arguments{
-  \item{x}{object to test}
+\item{x}{object to test}
 }
 \description{
 Does object contain any missing values?
@@ -17,11 +19,7 @@ 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}};
+Other assertions: \code{\link{are_equal}},
+  \code{\link{is.error}}, \code{\link{is.scalar}},
   \code{\link{not_empty}}
 }
-
diff --git a/man/not_empty.Rd b/man/not_empty.Rd
index f2cc986..07e84db 100644
--- a/man/not_empty.Rd
+++ b/man/not_empty.Rd
@@ -1,3 +1,5 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions.r
 \name{not_empty}
 \alias{not_empty}
 \title{Check an object doesn't have any empty dimensions}
@@ -5,7 +7,7 @@
 not_empty(x)
 }
 \arguments{
-  \item{x}{object to test}
+\item{x}{object to test}
 }
 \description{
 Check an object doesn't have any empty dimensions
@@ -16,11 +18,7 @@ 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}};
+Other assertions: \code{\link{are_equal}},
+  \code{\link{is.error}}, \code{\link{is.scalar}},
   \code{\link{noNA}}
 }
-
diff --git a/man/on_failure.Rd b/man/on_failure.Rd
index 752035c..bff1e0b 100644
--- a/man/on_failure.Rd
+++ b/man/on_failure.Rd
@@ -1,3 +1,5 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/on-failure.r
 \name{on_failure}
 \alias{on_failure}
 \alias{on_failure<-}
@@ -8,12 +10,11 @@ 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{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.}
+\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.
@@ -30,4 +31,3 @@ on_failure(is_odd) <- function(call, env) {
 }
 see_if(is_odd(2))
 }
-
diff --git a/man/scalar.Rd b/man/scalar.Rd
index 7e1c432..0ca4d43 100644
--- a/man/scalar.Rd
+++ b/man/scalar.Rd
@@ -1,9 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/assertions-scalar.R
 \name{scalar}
-\alias{is.count}
-\alias{is.flag}
-\alias{is.number}
 \alias{is.scalar}
 \alias{is.string}
+\alias{is.number}
+\alias{is.flag}
+\alias{is.count}
 \title{Assert input is a scalar.}
 \usage{
 is.scalar(x)
@@ -17,10 +19,10 @@ is.flag(x)
 is.count(x)
 }
 \arguments{
-  \item{x}{object to test}
+\item{x}{object to test}
 }
 \description{
-\code{is.scala} provides a generic method for checking input is a scalar.
+\code{is.scalar} 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.
 }
@@ -28,29 +30,32 @@ provide tests for specific types.
 # 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
+
+# flag = scalar logical 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
+
+# count = 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}};
+Other assertions: \code{\link{are_equal}},
+  \code{\link{is.error}}, \code{\link{noNA}},
   \code{\link{not_empty}}
 }
-
diff --git a/man/validate_that.Rd b/man/validate_that.Rd
index e1a55be..25b4089 100644
--- a/man/validate_that.Rd
+++ b/man/validate_that.Rd
@@ -1,17 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/validate-that.R
 \name{validate_that}
 \alias{validate_that}
 \title{Validate that certain conditions are true.}
 \usage{
-validate_that(..., env = parent.frame())
+validate_that(..., env = parent.frame(), msg = NULL)
 }
 \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{...}{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.}
+\item{env}{(advanced use only) the environment in which to evaluate the
+assertions.}
+
+\item{msg}{a custom error message to be printed if one of the conditions is
+false.}
 }
 \value{
 A \code{character} vector if the assertion is false, or \code{TRUE}
@@ -35,4 +39,3 @@ validate_that(is.dir("asdf"))
 \code{\link{assert_that}}, which returns an error if the condition
 is false.
 }
-
diff --git a/tests/test-that.R b/tests/testthat.R
similarity index 59%
rename from tests/test-that.R
rename to tests/testthat.R
index 9be2b16..2d69002 100644
--- a/tests/test-that.R
+++ b/tests/testthat.R
@@ -1,4 +1,4 @@
 library(testthat)
 library(assertthat)
 
-test_package("assertthat")
+test_check("assertthat")
diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R
new file mode 100644
index 0000000..14fd3d1
--- /dev/null
+++ b/tests/testthat/test-assertions.R
@@ -0,0 +1,118 @@
+context("Assertion assertions")
+
+test_that("is.integerish works correctly", {
+  expect_true(is.integerish(1L))
+  expect_true(is.integerish(c(1L, 2L, 3L)))
+  expect_true(is.integerish(c(1L, NA, 3L)))
+  expect_false(is.integerish(c(1L, 2.1, 3L)))
+  
+  # base::.Machine holds info on machine numerical precision
+  expect_false(is.integerish(1L + .Machine$double.eps))
+  expect_false(is.integerish(1L - .Machine$double.neg.eps))
+  
+  expect_false(is.integerish(NA))
+  expect_false(is.integerish(NULL))
+})
+
+test_that("is.named works correctly", {
+  expect_false(is.named(1))
+  x <- 1:3
+  expect_false(is.named(x))
+  names(x) <- letters[1:3]
+  expect_true(is.named(x))
+  
+  # Malformed or weird names
+  names(x)[2] <- ""
+  expect_false(is.named(x))
+  names(x)[2] <- NA
+  expect_false(is.named(x))
+  names(x) <- NULL
+  expect_false(is.named(x))
+  
+  expect_false(is.named(NA))
+  expect_false(is.named(NULL))
+})
+
+test_that("has_attr works correctly", {
+  x <- 1:3
+  expect_false(has_attr(x, "names"))
+  names(x) <- letters[1:3]
+  expect_true(has_attr(x, "names"))
+  expect_false(has_attr(x, "something else"))
+  # not sure what else to test here
+})
+
+test_that("has_name works correctly", {
+  x <- 1:3
+  expect_false(has_name(x, "a"))
+  names(x) <- letters[1:3]
+  expect_true(has_name(x, letters[2]))
+  expect_false(has_name(x, "something else"))
+  expect_false(has_name(x, NA))
+})
+
+test_that("noNA works correctly", {
+  expect_true(noNA("a"))
+  expect_false(noNA(c(TRUE, NA)))
+  x <- sample(c(1:10, NA), 100, rep = TRUE)
+  expect_false(noNA(x))
+  expect_true(noNA(1:1000))
+})
+
+test_that("are_equal works correctly", {
+  x <- 2
+  expect_false(are_equal(x, 1.9))
+  expect_true(are_equal(x, 1.999, tol = 0.01))
+  expect_true(are_equal(x, 2))
+  expect_true(are_equal('a', 'a'))
+  expect_false(are_equal('a', 'b'))
+  
+  expect_true(are_equal(NA, NA))
+  expect_true(are_equal(NULL, NULL))
+})
+
+test_that("is.error works correctly", {
+  x <- try(stop("!!"), silent=TRUE)
+  expect_true(is.error(x))
+  expect_false(is.error(1))
+  
+  expect_false(is.error(NA))  
+  expect_false(is.error(NULL))
+})
+
+test_that("is.time works correctly", {
+  expect_true(is.time(Sys.time()))
+  expect_false(is.time(Sys.Date()))
+  expect_false(is.time(1))
+  
+  expect_false(is.time(NA))  
+  expect_false(is.time(NULL))
+})
+
+test_that("is.date works correctly", {
+  expect_false(is.date(Sys.time()))
+  expect_true(is.date(Sys.Date()))
+  expect_false(is.date(1))
+  
+  expect_false(is.date(NA))  
+  expect_false(is.date(NULL))
+})
+
+test_that("has_args works correctly", {
+  expect_error(1 %has_args% "x")
+  expect_true(mean %has_args% "x")
+  expect_false(mean %has_args% "y")
+  
+  expect_error(NA %has_args% "x")
+  expect_error(NULL %has_args% "x")  
+})
+
+test_that("not_empty works correctly", {
+  expect_true(not_empty(1))
+  expect_false(not_empty(numeric()))
+  expect_false(not_empty(mtcars[0, ]))
+  expect_false(not_empty(mtcars[, 0]))
+
+  expect_true(not_empty(NA))
+  expect_false(not_empty(NULL))
+})
diff --git a/inst/tests/test-base.R b/tests/testthat/test-base.R
similarity index 75%
rename from inst/tests/test-base.R
rename to tests/testthat/test-base.R
index 88fb0a6..7088543 100644
--- a/inst/tests/test-base.R
+++ b/tests/testthat/test-base.R
@@ -12,4 +12,8 @@ test_that("all message is useful", {
   
   x <- c(FALSE, TRUE)
   expect_match(validate_that(all(x)), "Elements .* of x are not true")
-})
\ No newline at end of file
+})
+
+test_that("custom message is printed", {
+  expect_equal(validate_that(FALSE, msg = "Custom message"), "Custom message")
+})
diff --git a/tests/testthat/test-file.R b/tests/testthat/test-file.R
new file mode 100644
index 0000000..e2f80cc
--- /dev/null
+++ b/tests/testthat/test-file.R
@@ -0,0 +1,41 @@
+context("File assertions")
+
+test_that("is.dir identifies dirs correctly", {
+  expect_true(is.dir(tempdir()))
+  expect_error(is.dir(tempfile()))
+})
+
+test_that("is.writeable works correctly", {
+  expect_true(is.writeable(tempdir()))
+  tf <- tempfile()
+  expect_error(is.writeable(tf)) # file doesn't exist yet
+  cat("foo", file=tf)
+  expect_true(is.writeable(tf)) # ...but now it does
+})
+
+test_that("is.readable works correctly", {
+  expect_true(is.readable(tempdir()))
+  tf <- tempfile()
+  expect_error(is.readable(tf)) # file doesn't exist yet
+  cat("foo", file=tf)
+  expect_true(is.readable(tf)) # ...but now it does
+})
+
+test_that("has_extension works correctly", {
+  # no extension
+  tf <- tempfile()
+  expect_true(has_extension(tf, ""))
+  expect_false(has_extension(tf, "x"))
+         
+  # normal extension
+  ext <- "test"
+  tf <- tempfile(fileext=paste0(".", ext))
+  expect_true(has_extension(tf, ext))
+  expect_false(has_extension(tf, paste0(ext, "x")))
+  
+  # empty extension
+  ext <- ""
+  tf <- tempfile(fileext=paste0(".", ext))
+  expect_true(has_extension(tf, ext))
+  expect_false(has_extension(tf, paste0(ext, "x")))
+})
diff --git a/tests/testthat/test-scalar.R b/tests/testthat/test-scalar.R
new file mode 100644
index 0000000..a0d9826
--- /dev/null
+++ b/tests/testthat/test-scalar.R
@@ -0,0 +1,55 @@
+context("Scalar assertions")
+
+test_that("is.scalar works correctly", {
+  expect_true(is.scalar(1))
+  expect_true(is.scalar(-1))
+  expect_true(is.scalar(1.5))
+  expect_false(is.scalar(1:5))
+  expect_true(is.scalar('a'))
+  expect_false(is.scalar(c('a', 'b')))
+  expect_true(is.scalar(TRUE))
+  expect_false(is.scalar(c(TRUE, FALSE)))
+  expect_false(is.scalar(NULL))
+  expect_true(is.scalar(NA))
+})
+
+test_that("is.string works correctly", {
+  expect_false(is.string(1))
+  expect_true(is.string('a'))
+  expect_false(is.string(c('a', 'b')))
+  expect_false(is.string(TRUE))
+  expect_false(is.string(NULL))
+  expect_false(is.string(NA))
+})
+
+test_that("is.number works correctly", {
+  expect_true(is.number(1))
+  expect_true(is.number(-1))
+  expect_true(is.number(1.5))
+  expect_false(is.number(1:5))
+  expect_false(is.number('a'))
+  expect_false(is.number(TRUE))
+  expect_false(is.number(NULL))
+  expect_false(is.number(NA))
+})
+
+test_that("is.flag works correctly", {
+  expect_false(is.flag(1))
+  expect_false(is.flag('a'))
+  expect_true(is.flag(TRUE))
+  expect_true(is.flag(FALSE))
+  expect_false(is.flag(c(TRUE, FALSE)))
+  expect_false(is.flag(NULL))
+  expect_equal(is.flag(NA), is.logical(NA)) # not obvious
+})
+
+test_that("is.count works correctly", {
+  expect_true(is.count(1))
+  expect_false(is.count(-1))
+  expect_false(is.count(1.5))
+  expect_false(is.count(1:5))
+  expect_false(is.count('a'))
+  expect_false(is.count(TRUE))
+  expect_false(is.count(NULL))
+  expect_false(is.count(NA))
+})

-- 
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