Expand date validation testing for offline case #171 #182

RevolutionAnalytics · Sep 11, 2015 · f8a0d25 · f8a0d25
1 parent 0ffdb1e
commit f8a0d25
Show file tree

Hide file tree

Showing 2 changed files with 37 additions and 21 deletions.
diff --git a/R/mranUrl.R b/R/mranUrl.R
@@ -1,5 +1,5 @@
 
-stopIfInvalidDate <- function(snapshotDate){
+stopIfInvalidDate <- function(snapshotDate, verbose = TRUE){
   if(missing(snapshotDate) || is.null(snapshotDate))
     stop("You have to specify a snapshotDate", call. = FALSE)
   if(!grepl("^\\d{4}-\\d{2}-\\d{2}$", snapshotDate))
@@ -8,13 +8,20 @@ stopIfInvalidDate <- function(snapshotDate){
     stop("Snapshots are only available after 2014-09-17", call. = FALSE)
   if(as.Date(snapshotDate) > Sys.Date())
     stop("snapshotDate can not be in the future!", call. = FALSE)
-  validSnapshots <- as.Date(getValidSnapshots())
-  if(!as.Date(snapshotDate) %in% validSnapshots) {
-    i <- findInterval(as.Date(snapshotDate), validSnapshots)
-    suggestions <- validSnapshots[c(i, i+1)]
-    stop(sprintf("Snapshot does not exist on MRAN. Try %s or %s.", validSnapshots[i], validSnapshots[i+1]))
+
+
+  validSnapshots <- tryCatch(as.Date(getValidSnapshots()), error=function(e)e)
+  if(inherits(validSnapshots, "error")){
+    mssg(verbose, "Unable to connect to MRAN. Skipping some date validations.") 
+  } else {
+    if(!as.Date(snapshotDate) %in% validSnapshots) {
+      i <- findInterval(as.Date(snapshotDate), validSnapshots)
+      suggestions <- validSnapshots[c(i, i+1)]
+      stop(sprintf("Snapshot does not exist on MRAN. Try %s or %s.", validSnapshots[i], validSnapshots[i+1]))
+    }
   }
 
+
 }
 
 # testHttps <- function(https){
@@ -40,8 +47,8 @@ mranUrlDefault <- function(){
   https = gsub("http://", replacement = "https://", http)
   if(getRversion() >= "3.2.0" && httpsSupported()) {
     https 
-#     Attempt to connect
-#     if unable to connect, stop with warning
+    #     Attempt to connect
+    #     if unable to connect, stop with warning
   } else {
     http
   }
@@ -123,9 +130,9 @@ libcurl <- function() isTRUE(unname(capabilities("libcurl")))
 url <- function(url){
   if(getRversion() >= "3.2.0"){
     method <- switch(.Platform$OS.type, 
-           "unix" = if(libcurl()) "libcurl" else "default",
-           "windows" = "wininet",
-           "default"
+                     "unix" = if(libcurl()) "libcurl" else "default",
+                     "windows" = "wininet",
+                     "default"
     )
     base::url(url, method = method)
   } else {
@@ -142,8 +149,8 @@ httpsSupported <- function(mran = "https://mran.revolutionanalytics.com/snapshot
         "/src/contrib/checkTimings.html"
     )
     tryCatch(download.file(url = testfile, destfile = tf, 
-                         cacheOK = FALSE, quiet = TRUE, 
-                         mode = "w"), error = function(e)e)
+                           cacheOK = FALSE, quiet = TRUE, 
+                           mode = "w"), error = function(e)e)
   })
   if(inherits(pdb, "error")) return(FALSE)
   con <- suppressWarnings({
@@ -172,7 +179,7 @@ is.404 <- function(mran){
   on.exit(close(con))
   x <- suppressWarnings(
     tryCatch(readLines(con, warn = FALSE), 
-                error = function(e)e)
+             error = function(e)e)
   )
   if(inherits(x, "error")) return(TRUE)
   ptn <- "404.*Not Found"

diff --git a/tests/testthat/test-2-snapshot-dates.R b/tests/testthat/test-2-snapshot-dates.R
@@ -1,4 +1,4 @@
-library("testthat")
+if(interactive()) library("testthat")
 context("valid snapshot dates")
 
 describe("getValidSnapshots finds valid dates", {
@@ -8,22 +8,31 @@ describe("getValidSnapshots finds valid dates", {
     expect_is(d, "character")
     expect_is(as.Date(d), "Date")
   })
-
+  
 
   it("suggests a reasonable alternative", {
     # On MRAN, 2015-06-04 to 2015-06-08 are missing
     expect_error(
       stopIfInvalidDate("2015-06-05"),
       "Snapshot does not exist on MRAN. Try 2015-06-03 or 2015-06-09."
-      )
+    )
 
     expect_error(
       checkpoint("2015-06-05"),
       "Snapshot does not exist on MRAN. Try 2015-06-03 or 2015-06-09."
     )
-
   })
-
-
-
+
+  it("works with no network connection", {
+    with_mock(`getValidSnapshots` = function(...){x <- character(0); class(x) = "error"; x}, {
+      expect_message(stopIfInvalidDate("2015-06-05"),
+                     "Unable to connect to MRAN. Skipping some date validations."
+      )
+      with_mock(`getValidSnapshots` = function(...){x <- character(0); class(x) = "error"; x}, {
+        expect_message(stopIfInvalidDate("2015-06-05"),
+                       "Unable to connect to MRAN. Skipping some date validations."
+        )
+      })
+    })
+  })
 })