Shim code and revise tests because upcoming release of testthat won't…

… allow mocking functions from base packages

NEWS.md

@@ -1,6 +1,7 @@
 ### crunch 1.18.3 (under development)
 * Now Crunch authentication email and password can be stored in and read from the environmental variables `R_CRUNCH_EMAIL` and `R_CRUNCH_PW` respectively.
 * Fix `bases()` when called on a univariate statistic (#124)
+* Update some tests and code to anticipate changes in an upcoming release of `testthat`
 
 ### crunch 1.18.2
 * `makeWeight` allows you to generate new weighting variables based on categorical variables (#80).

R/auth.R

@@ -36,7 +36,7 @@ deleteSessionInfo <- function () {
 #' perhaps less so than in every .R script you write), and we
 #' cannot officially recommend that you do so.
 #'
-#' Additionally, your email and password can be stored in and read from the 
+#' Additionally, your email and password can be stored in and read from the
 #' environmental variables `R_CRUNCH_EMAIL` and `R_CRUNCH_PW` respectively.
 #'
 #' If a password is not supplied (or, if no arguments are supplied and only
@@ -89,7 +89,7 @@ crunchAuth <- function (email, password=NULL, ...) {
                 password <- rstudioapi::askForPassword(prompt)
             } else {
                 cat(prompt)
-                without_echo(password <- readline())
+                without_echo(password <- read_input())
             }
         } else {
             halt("Must supply a password")
@@ -117,6 +117,10 @@ without_echo <- function (expr) {
     eval.parent(expr)
 }
 
+
+## Pass through for test mocking
+read_input <- function (...) readline(...)
+
 #' Add an auth token as a cookie manually
 #'
 #' Set the auth token rather than from a Set-Cookie response header. Also modify

R/consent.R

@@ -37,7 +37,7 @@ askForPermission <- function (prompt="") {
     prompt <- paste(prompt, "(y/n) ")
     proceed <- ""
     while (!(proceed %in% c("y", "n"))) {
-        proceed <- tolower(readline(prompt))
+        proceed <- tolower(read_input(prompt))
     }
     return(proceed == "y")
 }

R/dataset.R

@@ -357,10 +357,13 @@ webApp <- function (dataset) {
     if (.Platform$OS.type == "unix") {
         cmd <- ifelse(grepl("apple", R.version$platform), "open", "xdg-open")
         url <- APIToWebURL(dataset)
-        system2(cmd, url)
+        system_call(cmd, url)
     }
 }
 
+## Pass through for test mocking
+system_call <- function (...) system2(...)
+
 #' as.environment method for CrunchDataset
 #'
 #' This method allows you to `eval` within a Dataset.

R/progress.R

@@ -1,5 +1,4 @@
 #' @importFrom httpcache uncached
-#' @importFrom utils txtProgressBar setTxtProgressBar
 pollProgress <- function (progress_url, wait=.5) {
     ## Configure polling interval. Will increase by rate (>1) until reaches max
     max.wait <- 30
@@ -11,20 +10,20 @@ pollProgress <- function (progress_url, wait=.5) {
         difftime(Sys.time(), since, units=units)
     }
     ## Set up the progress bar
-    pb <- txtProgressBar(0, 100, style=3)
+    pb <- setup_progress_bar(0, 100, style=3)
 
     prog <- uncached(crGET(progress_url))
     status <- prog$progress
-    setTxtProgressBar(pb, status)
+    update_progress_bar(pb, status)
     while (status >= 0 && status < 100 && timer(starttime) < timeout) {
         Sys.sleep(wait)
         prog <- uncached(crGET(progress_url))
         status <- prog$progress
-        setTxtProgressBar(pb, status)
+        update_progress_bar(pb, status)
         wait <- min(max.wait, wait * increase.by)
     }
     close(pb)
-    
+
     if (status < 0) {
         msg <- prog$message %||% "There was an error on the server. Please contact support@crunch.io"
         halt(msg)
@@ -36,6 +35,14 @@ pollProgress <- function (progress_url, wait=.5) {
     return(status)
 }
 
+## Make these pass through so they can be mocked (silenced) in tests
+
+#' @importFrom utils txtProgressBar
+setup_progress_bar <- function (...) txtProgressBar(...)
+
+#' @importFrom utils setTxtProgressBar
+update_progress_bar <- function (...) setTxtProgressBar(...)
+
 crunchTimeout <- function () {
     opt <- getOption("crunch.timeout")
     if (!is.numeric(opt)) opt <- 900

inst/crunch-test.R

@@ -59,8 +59,8 @@ with_DELETE <- function (resp, expr) {
 
 with_silent_progress <- function (expr) {
     with_mock(
-        `utils::txtProgressBar`=function (...) pipe(""),
-        `utils::setTxtProgressBar`=function (...) invisible(NULL),
+        `crunch:::setup_progress_bar`=function (...) pipe(""),
+        `crunch:::update_progress_bar`=function (...) invisible(NULL),
         eval.parent(expr)
     )
 }

tests/testthat/helper-contexts.R

@@ -1,7 +1,7 @@
 with_fake_input <- function (input, expr) {
     with_mock(
         `crunch:::is.interactive`=function () return(TRUE),
-        `base::readline`=function (...) input,
+        `crunch:::read_input`=function (...) input,
         eval.parent(expr)
     )
 }

tests/testthat/test-dataset-entity.R

@@ -114,10 +114,10 @@ with_mock_crunch({
 
     if (.Platform$OS.type == "unix") {
         with_mock(
-            `base::system2`=function (command, args, ...) args,
+            `crunch:::system_call`=function (command, args, ...) paste("SYSTEM CALL", args),
             test_that("Opening a dataset on the web", {
                 expect_identical(webApp(ds),
-                    "https://app.crunch.io/dataset/511a7c49778030653aab5963")
+                    "SYSTEM CALL https://app.crunch.io/dataset/511a7c49778030653aab5963")
             })
         )
     }

tests/testthat/test-misc.R

@@ -126,3 +126,13 @@ test_that("setCrunchAPI", {
         expect_equal(getOption("crunch.api"), "http://barfoo.crunch.io:8888/api/")
     })
 })
+
+with(temp.option(foo.bar="no", foo.other="other"), {
+    withr::with_envvar(list(R_FOO_BAR="yes"), {
+        test_that("envOrOption gets the right thing", {
+            expect_identical(envOrOption("foo.bar"), "yes") ## Env var trumps option
+            expect_identical(envOrOption("foo.other"), "other") ## Option if there is no env var
+            expect_null(envOrOption("somethingelse")) ## Null if neither
+        })
+    })
+})

tests/testthat/test-new-dataset.R

@@ -59,14 +59,11 @@ with_mock_crunch({
     })
     test_that("uploadData writes out a gzipped file", {
         ds <- loadDataset("test ds")
-        f <- tempfile()
-        with_mock(tempfile=function (...) f, {
-            expect_false(file.exists(f))
-            with_DELETE(NULL, {
-                ## with_DELETE to handle the cleanup so we can see the real error
-                expect_POST(uploadData(ds, data.frame(a=1)))
-            })
-            expect_true(file.exists(f))
+        with_DELETE(NULL, {
+            ## with_DELETE to handle the cleanup so we can see the real error
+            expect_POST(uploadData(ds, data.frame(a=1)),
+                "https://app.crunch.io/api/sources/",
+                "list(uploaded_file")
         })
     })
 

tests/testthat/test-progress.R

@@ -61,6 +61,15 @@ with_mock_crunch({
             expect_identical(logs$url,
                 c("app.crunch.io/api/progress/1.json", "app.crunch.io/api/progress/2.json"))
         }),
+        test_that("Progress silencing in tests", {
+            counter <<- 1
+            expect_silent(
+                with_silent_progress(
+                    expect_identical(handleAPIresponse(fakeProg("https://app.crunch.io/api/progress/")),
+                        "https://app.crunch.io/api/datasets/")
+                )
+            )
+        }),
         test_that("Auto-polling when progress reports failure", {
             counter <<- 1
             logfile <- tempfile()