added expect_inherits

pkg/DESCRIPTION

@@ -19,7 +19,7 @@ Description: Provides a lightweight (zero-dependency) and easy to use
     configurable output printing. Compare computed output with output stored 
     with the package. Run tests in parallel. Extensible by other packages.
     Report side effects.
-Version: 1.2.3.7
+Version: 1.2.3.8
 URL: https://github.com/markvanderloo/tinytest
 BugReports: https://github.com/markvanderloo/tinytest/issues
 Imports: parallel, utils

pkg/NAMESPACE

@@ -20,6 +20,7 @@ export(expect_equivalent_to_reference)
 export(expect_error)
 export(expect_false)
 export(expect_identical)
+export(expect_inherits)
 export(expect_message)
 export(expect_null)
 export(expect_silent)

pkg/NEWS

@@ -1,5 +1,8 @@
 version 1.2.4
-- Duration per file is now reported, total duration is stored.
+- New function 'expect_inherits' to check the class of an object (thanks
+  to Sebastian Meyer for suggesting).
+- Duration per file is now reported, total duration is stored (thanks
+  to Dirk Eddelbuettel for suggesting)
 - Small improvements in difference reporting.
 - Fix: avoid truncated printing in case of long diff reporting (thanks to
   Sbastian Meyer for the PR)

pkg/R/expectations.R

@@ -401,6 +401,32 @@ expect_null <- function(current, info=NA_character_){
   }
 }
 
+class_string <- function(x){
+  paste0("<", paste(class(x), collapse=", "),">")
+}
+
+#' @rdname expect_equal
+#' 
+#' @param class \code{[character]} A class string.
+#' @details 
+#'  \code{expect_inherits} fails when \code{\link{inherits}(current,class)} returns \code{FALSE} 
+#' @export
+expect_inherits <- function(current, class, info=NA_character_){
+  call <- sys.call(sys.parent(1))
+  res  <- inherits(current, class)
+  if (isTRUE(res)){
+    tinytest(TRUE, call=call, info=info)
+  } else {
+    tinytest(FALSE, call=call, short="attr"
+      , diff = sprintf("Expected object of class %s, got %s"
+          , paste0("<", paste(class,collapse=", "),">")
+          , paste0("<", paste(class(current), collapse=", "),">")
+      , info=info))
+  }
+
+}
+
+
 
 #' @rdname expect_equal
 #' @param pattern \code{[character]} A regular expression to match the message.

pkg/R/tinytest.R

@@ -261,6 +261,7 @@ add_locally_masked_functions <- function(envir, output){
   envir$expect_equivalent   <- capture(expect_equivalent, output)
   envir$expect_true         <- capture(expect_true, output)
   envir$expect_false        <- capture(expect_false, output)
+  envir$expect_inherits     <- capture(expect_inherits, output)
   envir$expect_null         <- capture(expect_null, output)
   envir$expect_message      <- capture(expect_message, output)
   envir$expect_warning      <- capture(expect_warning, output)

pkg/README.md

@@ -57,6 +57,7 @@ the second argument represents the _desired_ value.
 | `expect_equal`                   | Data and attributes of arguments must be equal       |
 | `expect_equivalent`              | Data of arguments must be equal                      |
 | `expect_identical`               | Target and current must be `identical`               |
+| `expect_inherits`                | Current object must inherit from the desired class   |
 | `expect_null`                    | Expression must evaluate to `NULL`                   |
 | `expect_equal_to_reference`      | Object must be equal to an object stored on file     |
 | `expect_equivalent_to_reference` | Object must be equivalent to an object stored on file|

pkg/inst/tinytest/test_file.R

@@ -50,10 +50,10 @@ expect_false(exists("Rplots.pdf"))
 
 
 # test that files are run with environment variables set
-out <- run_test_file("runs/test_set_env.R", set_env=list("wa_babalooba"="ba_la_bamboo"))
+out <- run_test_file("runs/test_set_env.R", set_env=list("wa_babalooba"="ba_la_bamboo"), verbose=0)
 expect_true(all_pass(out))
 
-expect_message(run_test_file("runs/test_double_colon.R"))
+expect_message(run_test_file("runs/test_double_colon.R", verbose=0))
 expect_message(tinytest:::check_double_colon("runs/test_double_colon.R"))
 
 # uncomment to see the warning with 'make test'

pkg/inst/tinytest/test_tiny.R

@@ -29,6 +29,10 @@ expect_equivalent(2,c(x=2))
 expect_true(ignore(expect_equivalent)(2,c(x=2)))
 expect_false(ignore(expect_equivalent)(2,c(x=3)))
 
+expect_true(ignore(expect_inherits)(1, "numeric"))
+expect_false(ignore(expect_inherits)(1, c("matrix", "array")))
+
+
 # check NULL
 expect_true(ignore(expect_null)(NULL))
 expect_false(ignore(expect_null)(1))

pkg/vignettes/using_tinytest.Rnw

@@ -139,6 +139,7 @@ Currently, the following expectations are implemented.
 \code{expect\_identical(current, target)}  & equality, (using, \code{identical})\\
 \code{expect\_true(current)}               & \code{current} evaluates to \code{TRUE}\\
 \code{expect\_false(current)}              & \code{current} evaluates to \code{FALSE}\\
+\code{expect\_inherits(current, class)}    & \code{current} inherits from \code{class}\\
 \code{expect\_null(current)}               & \code{current} evaluates to \code{NULL}\\
 \code{expect\_error(current, pattern)}     & error message matching \code{pattern}\\
 \code{expect\_warning(current, pattern)}   & warning message matching \code{pattern}\\