Expect_called fn addition

.gitignore

@@ -1,3 +1,6 @@
 ..Rcheck
 *.Rcheck
 *.tar.gz
+.DS_Store
+src/*.o
+src/*.so

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: testthatsomemore
 Title: A mocking, stubbing, and file testing framework extending testthat
-Version: 0.2.6
+Version: 0.2.7
 Maintainer: Robert Krzyzanowski <technoguyrob@gmail.com>
 Authors@R: c(person("Robert", "Krzyzanowski",
     email = "technoguyrob@gmail.com", role = c("aut", "cre")))
@@ -24,4 +24,4 @@ License: MIT + file LICENSE
 LazyData: true
 URL: http://github.com/robertzk/testthatsomemore
 BugReports: https://github.com/robertzk/testthatsomemore/issues
-RoxygenNote: 5.0.1
+RoxygenNote: 5.0.0

NAMESPACE

@@ -3,6 +3,7 @@
 export("stub<-")
 export(assert)
 export(create_file_structure)
+export(duplicate)
 export(expect_is_directory)
 export(expect_is_file)
 export(is.directory)
@@ -14,3 +15,4 @@ export(touch)
 export(within_file_structure)
 import(testthat)
 importFrom(crayon,yellow)
+useDynLib(testthatsomemore,duplicate_testthatsomemore_)

NEWS.md

@@ -1,3 +1,7 @@
+# Version 0.2.7
+
+  * Added expect_called helper function.
+
 # Version 0.2.6
 
   * Added mock_httr_response for mocking httr response objects.

R/duplicate.R

@@ -0,0 +1,17 @@
+#' Duplicate a function. Returns a carbon copy of the original, so that original
+#' can be modified safely.
+#'
+#' @param x function.
+#' @examples
+#' \dontrun{
+#'    fn <- function(x) cat(x, "\n")
+#'    fn2 <- duplicate(fn)
+#'    fn <- function(x) cat(x, "woof","\n")
+#'    fn("hello") # hellowoof
+#'    fn2("hello") # hello
+#' }
+#' @export
+#' @useDynLib testthatsomemore duplicate_testthatsomemore_
+duplicate <- function(x) {
+  .Call(duplicate_testthatsomemore_, x)
+}

R/expect_called.R

@@ -0,0 +1,42 @@
+#' Expect that a function was called while executing an expression.
+#'
+#' @param fn function. The function that was expected to get called. If not
+#'   specified with \code{::}, package_name param must be specified.
+#' @param expr expression. The expression to execute.
+#' @param package_name string. The package where fn lives. If not specified, fn must
+#'   be package_name::fn.
+#' @param was_called logical. If \code{FALSE}, negate the meaning: \code{fn}
+#'   should \emph{not} have been called. By default \code{TRUE}.
+#' @return invisible \code{TRUE}.
+#' @examples \dontrun{
+#'   expect_called(base::print, print("Hello")) # Will pass
+#'   expect_called(print, print("Hello"), "base") # Will pass
+#'   expect_called(base::print, cat("Hello")) # Will fail
+#'   expect_called(base::print, cat("Hello"), was_called = FALSE) # Will pass
+#' }
+expect_called <- function(fn, expr, package_name, was_called = TRUE) {
+  fn <- substitute(fn)
+  if (is.call(fn) && identical(as.character(fn[[1]]), "not")) {
+    fn       <- fn[[2]]
+    was_called <- FALSE
+  }
+  # Turn foo into package_name::foo
+  if (is.name(substitute(fn))) fn <- bquote(getFromNamespace(.(deparse(fn)), .(package_name)))
+  else fn <- as.call(list(quote(getFromNamespace), as.character(fn[[3]]), as.character(fn[[2]])))
+
+  grab <- function(i) as.character(as.list(fn)[[i]])
+
+  copy_of_fn <- duplicate(eval(fn))
+  env <- list2env(list(called = 0), parent = emptyenv())
+
+  mocked_fn <- function(...) {
+    env$called <- env$called + 1
+    copy_of_fn(...)
+  }
+
+  result <- testthatsomemore::package_stub(grab(3), grab(2), mocked_fn, force(expr))
+  expect_identical(was_called, as.logical(env$called))
+
+  invisible(TRUE)
+}
+

src/duplicate.c

@@ -0,0 +1,9 @@
+//shamelessly ripped off from @jimhester
+#define USE_RINTERNALS
+#include <R.h>
+#include <Rdefines.h>
+#include <R_ext/Error.h>
+
+SEXP duplicate_testthatsomemore_(SEXP x) {
+  return duplicate(x);
+}

tests/testthat/test-duplicate.R

@@ -0,0 +1,7 @@
+context("duplicate")
+
+test_that('it duplicates a function', {
+	fn <- function(x) cat(x, "\n")
+	fn_copy <- duplicate(fn)
+	expect_equal(fn, fn_copy)
+})

tests/testthat/test-expect_called.R

@@ -0,0 +1,31 @@
+context('expect_called')
+
+
+test_that('it finds called function', {
+	f <- function() sum(2, 2)
+	expect_true(expect_called(base::sum, f())) 
+})
+
+test_that('it detects function was not called', {
+	f <- function() 10
+    expect_true(expect_called(base::sum, f(), was_called = FALSE )) 
+})
+
+test_that('Package setting works', {
+	f <- function() sum(1, 2)
+    expect_true(expect_called(sum, f(), "base"))
+})
+
+# neither test_that nor describe wrappers work here?
+# test_that('it detects errors when function is expected but actually not called', {
+# 	f <- function() 10
+# 	expect_error(
+# 	expect_called(base::sum, f() ),
+# 	"is not identical" 
+# 	)
+# })
+
+
+
+
+

tests/testthat/test-pretend_now_is.R

@@ -40,7 +40,9 @@ describe("pretend_now_is", {
   test_that("it can pretend it's 5 seconds ago", {
     now        <- Sys.time()
     five_s_ago <- now - as.difftime(5, units = "secs")
-    pretend_now_is("5 seconds ago", expect_equal(Sys.time(), five_s_ago))
+    pretend_now_is("5 seconds ago", {
+      expect_equal(as.Date(Sys.time()), as.Date(five_s_ago))
+      })
   })
 
   test_that("it can pretend Sys.Date is different", {