test: improve read-limting during testing

ssi-dk · Dec 15, 2023 · 81ccca9 · 81ccca9
1 parent b1dabe0
commit 81ccca9
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -37,7 +37,6 @@ Imports:
     R6,
     SCDB,
     stringr,
-    testthat (>= 3.0.0),
     tidyr,
     tidyselect,
     zoo
@@ -48,6 +47,7 @@ Suggests:
     rmarkdown,
     RSQLite,
     RPostgres,
+    testthat (>= 3.0.0),
     tibble,
     spelling,
     withr

diff --git a/R/DiseasystoreGoogleCovid19.R b/R/DiseasystoreGoogleCovid19.R
@@ -22,7 +22,8 @@ google_covid_19_metric <- function(google_pattern, out_name) {
 
       # Load and parse
       data <- source_conn_path(source_conn, "by-age.csv") |>
-        readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE) |>
+        readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                        show_col_types = FALSE) |>
         dplyr::mutate("date" = as.Date(.data$date)) |>
         dplyr::filter(.data$date >= as.Date("2020-01-01"),
                       {{ start_date }} <= .data$date, .data$date <= {{ end_date }}) |>
@@ -90,7 +91,8 @@ DiseasystoreGoogleCovid19 <- R6::R6Class(
 
         # Load and parse
         out <- source_conn_path(source_conn, "demographics.csv") |>
-          readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE) |>
+          readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                          show_col_types = FALSE) |>
           dplyr::select("location_key", tidyselect::starts_with("population_age_")) |>
           tidyr::pivot_longer(!"location_key",
                               names_to = c("tmp", "age_group"),
@@ -118,7 +120,8 @@ DiseasystoreGoogleCovid19 <- R6::R6Class(
 
         # Load and parse
         out <- source_conn_path(source_conn, "index.csv") |>
-          readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE) |>
+          readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                          show_col_types = FALSE) |>
           dplyr::transmute("key_location" = .data$location_key,
                            "country_id"   = .data$country_code,
                            "country"      = .data$country_name,
@@ -158,7 +161,8 @@ DiseasystoreGoogleCovid19 <- R6::R6Class(
 
         # Load and parse
         out <- source_conn_path(source_conn, "by-age.csv") |>
-          readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE)
+          readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                          show_col_types = FALSE)
 
         # We need a map between age_bin and age_group
         age_bin_map <- out |>
@@ -210,7 +214,8 @@ DiseasystoreGoogleCovid19 <- R6::R6Class(
 
         # Load and parse
         out <- source_conn_path(source_conn, "weather.csv") |>
-          readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE) |>
+          readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                          show_col_types = FALSE) |>
           dplyr::mutate("date" = as.Date(.data$date)) |>
           dplyr::filter({{ start_date }} <= .data$date, .data$date <= {{ end_date }}) |>
           dplyr::select("key_location" = "location_key",
@@ -233,7 +238,8 @@ DiseasystoreGoogleCovid19 <- R6::R6Class(
 
         # Load and parse
         out <- source_conn_path(source_conn, "weather.csv") |>
-          readr::read_csv(n_max = ifelse(testthat::is_testing(), 1000, Inf), show_col_types = FALSE) |>
+          readr::read_csv(n_max = getOption("diseasystore.DiseasystoreGoogleCovid19.n_max", default = Inf),
+                          show_col_types = FALSE) |>
           dplyr::mutate("date" = as.Date(.data$date)) |>
           dplyr::filter({{ start_date }} <= .data$date, .data$date <= {{ end_date }}) |>
           dplyr::select("key_location" = "location_key",

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -113,3 +113,6 @@ purrr::walk(conns, ~ {
   DBI::dbDisconnect(.)
   rm(.)
 })
+
+# Set testing options
+withr::local_options("diseasystore.DiseasystoreGoogleCovid19.n_max" = 1000)
diff --git a/tests/testthat/test-DiseasystoreBase.R b/tests/testthat/test-DiseasystoreBase.R
@@ -212,7 +212,7 @@ test_that("active binding: ds_map works", {
   expect_null(ds$ds_map)
 
   # Try to set the ds_map
-  expect_identical(tryCatch(ds$ds_map <- list("testing" = "n_positive"), error = \(e) e),                                # nolint: implicit_assignment_linter
+  expect_identical(tryCatch(ds$ds_map <- list("testing" = "n_positive"), error = \(e) e),                               # nolint: implicit_assignment_linter
                    simpleError("`$ds_map` is read only"))
   expect_null(ds$ds_map)
   rm(ds)
@@ -227,7 +227,7 @@ test_that("active binding: available_features works", {
 
   # Try to set the available_features
   # test_that cannot capture this error, so we have to hack it
-  expect_identical(tryCatch(ds$available_features <- list("n_test", "n_positive"), error = \(e) e),                      # nolint: implicit_assignment_linter
+  expect_identical(tryCatch(ds$available_features <- list("n_test", "n_positive"), error = \(e) e),                     # nolint: implicit_assignment_linter
                    simpleError("`$available_features` is read only"))
   expect_null(ds$available_features)
   rm(ds)
@@ -241,7 +241,7 @@ test_that("active binding: label works", {
   expect_null(ds$label)
 
   # Try to set the label
-  expect_identical(tryCatch(ds$label <- "test", error = \(e) e),                                                         # nolint: implicit_assignment_linter
+  expect_identical(tryCatch(ds$label <- "test", error = \(e) e),                                                        # nolint: implicit_assignment_linter
                    simpleError("`$label` is read only"))
   expect_null(ds$label)
   rm(ds)