Merge pull request #555 from OuhscBbmc/dev

don't expect error
OuhscBbmc · Nov 21, 2024 · a9ecb61 · a9ecb61
2 parents 0172ce0 + c12f65c
commit a9ecb61
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 13 deletions.
diff --git a/R/helpers-testing.R b/R/helpers-testing.R
@@ -64,11 +64,12 @@ retrieve_plugins <- function(plugin_name) {
   checkmate::assert_character(plugin_name     , any.missing = FALSE, min.chars = 2, max.chars = 50)
 
   server_instance <-
-    # if(Sys.getenv("redcapr_test_server") != "") {
+    if(Sys.getenv("redcapr_test_server") != "") {
       Sys.getenv("redcapr_test_server")
-    # } else {
-    #   "dev-2"
-    # }
+    } else {
+      message("The test server was not explicitly set for plugins, so defaulting to 'dev-2'.")
+      "dev-2"
+    }
   checkmate::assert_character(server_instance , any.missing = FALSE, min.chars = 2, max.chars = 50)
 
   # This line avoids a warning from the package check.

diff --git a/tests/testthat/test-event-instruments.R b/tests/testthat/test-event-instruments.R
@@ -123,20 +123,24 @@ test_that("2-arms-retrieve-only-arm-2", {
 test_that("Bad URI", {
   testthat::skip_on_cran()
   bad_uri <- "https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com"
-  expected_data_frame <- structure(list(), .Names = character(0), row.names = integer(0), class = "data.frame")
+  # expected_data_frame <- structure(list(), .Names = character(0), row.names = integer(0), class = "data.frame")
 
   # Windows gives a different message than Travis/Linux
-  expected_outcome_message <- "(https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com|Couldn't resolve host 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com')"
+  # expected_outcome_message <- "(https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com|Couldn't resolve host 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com')"
   # "The REDCapR variable retrieval was not successful\\..+?Error 405 \\(Method Not Allowed\\).+"
   # expected_outcome_message <- "(?s)The REDCapR variable retrieval was not successful\\..+?.+"
 
-  expect_error(
+  # expect_error(
     returned_object <- redcap_event_instruments(
       redcap_uri  = bad_uri,
       token       = credential_longitudinal$token,
       verbose     = FALSE
     )
-  )
+  # )
+
+  expect_false(returned_object$success)
+  expect_equal(returned_object$status_code, 403L)
+  expect_match(returned_object$outcome_message, "The REDCapR instrument retrieval was not successful.+")
 })
 test_that("no-arms", {
   testthat::skip_on_cran()

diff --git a/tests/testthat/test-instruments-metadata.R b/tests/testthat/test-instruments-metadata.R
@@ -40,21 +40,24 @@ test_that("default", {
 test_that("Bad URI", {
   testthat::skip_on_cran()
   bad_uri <- "https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com"
-  expected_data_frame <- structure(list(), .Names = character(0), row.names = integer(0), class = "data.frame")
+  # expected_data_frame <- structure(list(), .Names = character(0), row.names = integer(0), class = "data.frame")
 
   # Windows gives a different message than Travis/Linux
-  expected_outcome_message <- "(https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com|Couldn't resolve host 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com')"
+  # expected_outcome_message <- "(https://aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com|Couldn't resolve host 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.com')"
   # "The REDCapR variable retrieval was not successful\\..+?Error 405 \\(Method Not Allowed\\).+"
   # expected_outcome_message <- "(?s)The REDCapR variable retrieval was not successful\\..+?.+"
 
-  expect_error(
+  # expect_error(
     returned_object <-
       redcap_instruments(
         redcap_uri  = bad_uri,
         token       = credential$token,
         verbose     = FALSE
       )
-  )
+  # )
+  expect_false(returned_object$success)
+  expect_equal(returned_object$status_code, 403L)
+  expect_match(returned_object$outcome_message, "The REDCapR instrument retrieval was not successful.+")
 })
 
 test_that("bad token -Error", {

diff --git a/utility/refresh.R b/utility/refresh.R
@@ -42,7 +42,7 @@ devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
 # devtools::run_examples(, "redcap_read.Rd")
 # pkgload::load_all()
 test_results_checked <- devtools::test()
-test_results_checked <- devtools::test(filter = "^retrieve-credential")
+test_results_checked <- devtools::test(filter = "^sanitize")
 # withr::local_envvar(ONLYREADTESTS = "true")
 # test_results_checked <- devtools::test(filter = "write-batch")