Merge pull request #3016 from PecanProject/remove-testthat-funs

Replace `testthat` funs used in package code
PecanProject · Aug 25, 2022 · f5194f8 · f5194f8
2 parents 22874d3 + 45aa35f
commit f5194f8
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 81 deletions.
diff --git a/models/ed/R/check_ed_metheader.R b/models/ed/R/check_ed_metheader.R
@@ -13,48 +13,35 @@
 #' @inheritParams read_ed_metheader
 #' @export
 check_ed_metheader <- function(ed_metheader, check_files = TRUE) {
-  testthat::test_that(
-    "ED met header object is a nested list",
-    {
-      testthat::expect_true(!is.null(names(ed_metheader[[1]])))
-    }
-  )
+  if(is.null(names(ed_metheader[[1]]))) {
+    stop("ED met header object is not a nested list")
+  }
   .z <- lapply(ed_metheader, check_ed_metheader_format, check_files = check_files)
   invisible(TRUE)
 }
 
 #' @rdname check_ed_metheader
 #' @export
 check_ed_metheader_format <- function(ed_metheader_format, check_files = TRUE) {
-  testthat::test_that(
-    "Format has the correct names",
-    {
-      correct_names <- c("path_prefix", "nlon", "nlat", "dx", "dy", "xmin", "ymin", "variables")
-      all(names(ed_metheader_format) %in% correct_names)
-    }
-  )
-  testthat::test_that(
-    "ED met header files exist and are not empty",
-    {
-      met_files <- PEcAn.utils::match_file(ed_metheader_format$path_prefix)
-      testthat::expect_gte(length(met_files), 1)
-      testthat::expect_true(all(file.exists(met_files)))
-      testthat::expect_true(all(file.size(met_files) > 0))
-    }
-  )
+  correct_names <- c("path_prefix", "nlon", "nlat", "dx", "dy", "xmin", "ymin", "variables")
+  if(!all(names(ed_metheader_format) %in% correct_names)) {
+    stop("Format does not have the correct names")
+  }
+
+  met_files <- PEcAn.utils::match_file(ed_metheader_format$path_prefix)
+  stopifnot(length(met_files) >= 1)
+  stopifnot(all(file.exists(met_files)))
+  stopifnot(all(file.size(met_files) > 0))
+  stopifnot(is.numeric(ed_metheader_format$nlon))
+  stopifnot(is.numeric(ed_metheader_format$nlat))
+  stopifnot(is.numeric(ed_metheader_format$dx))
+  stopifnot(is.numeric(ed_metheader_format$dy))
+  stopifnot(is.numeric(ed_metheader_format$xmin))
+  stopifnot(is.numeric(ed_metheader_format$ymin))
+  if (!inherits(ed_metheader_format$variables, "data.frame")) {
+    stop()
+  }
 
-  testthat::test_that(
-    "Met header metadata fields are valid",
-    {
-      testthat::expect_true(is.numeric(ed_metheader_format$nlon))
-      testthat::expect_true(is.numeric(ed_metheader_format$nlat))
-      testthat::expect_true(is.numeric(ed_metheader_format$dx))
-      testthat::expect_true(is.numeric(ed_metheader_format$dy))
-      testthat::expect_true(is.numeric(ed_metheader_format$xmin))
-      testthat::expect_true(is.numeric(ed_metheader_format$ymin))
-      testthat::expect_is(ed_metheader_format$variables, "data.frame")
-    }
-  )
 
   if (check_files) {
     met_files <- PEcAn.utils::match_file(ed_metheader_format$path_prefix, suffix = "h5")
@@ -71,10 +58,7 @@ check_ed_metfile <- function(metfile, variables) {
   hfile <- hdf5r::H5File$new(metfile, mode = "r")
   # Remove variables that are not constants
   variables <- variables[variables$flag != 4, ]
-  testthat::test_that(
-    "All variables present in metfile",
-    {
-      testthat::expect_true(all(variables$variable %in% hfile$ls()$name))
-    }
-  )
+  if(!all(variables$variable %in% hfile$ls()$name)) {
+    stop("All variables not present in metfile")
+  }
 }
diff --git a/models/ed/R/check_veg.R b/models/ed/R/check_veg.R
@@ -9,59 +9,42 @@
 #' @return `NULL` (invisibly)
 #' @export
 check_css <- function(css, pss = NULL) {
-  testthat::test_that(
-    "css file is formatted correctly",
-    {
-      testthat::expect_is(css, "data.frame")
-      testthat::expect_gte(nrow(css), 1)
-      testthat::expect_equal(
-        colnames(css),
-        c("time", "patch", "cohort", "dbh", "hite", "pft",
-          "n", "bdead", "balive", "lai")
-      )
-    }
-  )
+  if(!inherits(css, "data.frame") | nrow(css) == 0) {
+    stop("css file should be a data frame")
+  }
+
+  if(colnames(css) != c("time", "patch", "cohort", "dbh", "hite", "pft",
+                        "n", "bdead", "balive", "lai")) {
+    stop("css file is formatted incorrectly")
+  }
+
   if (!is.null(pss)) {
-    testthat::test_that(
-      "css file and pss file are compatible",
-      {
-        # All cohort patches are defined in patch file
-        testthat::expect_true(all(unique(css$patch) %in% unique(pss$patch)))
-      }
-    )
+    if(!all(unique(css$patch) %in% unique(pss$patch))) {
+      stop("css file and pss file are not compatible")
+    }
   }
+
 }
 
 #' @rdname check_css
 #' @export
 check_pss <- function(pss, site = NULL) {
-  testthat::test_that(
-    "pss file is formatted correctly",
-    {
-      testthat::expect_is(pss, "data.frame")
-      testthat::expect_gte(nrow(pss), 1)
-    }
-  )
+  if(!inherits(pss, "data.frame") | nrow(pss) == 0) {
+    stop("css file should be a data frame")
+  }
   if (!is.null(site)) {
-    testthat::test_that(
-      "pss and site files are compatible",
-      {
-        testthat::expect_true(all(unique(pss$site) %in% unique(site$sitenum)))
-      }
-    )
+
+    if(!all(unique(pss$site) %in% unique(site$sitenum))) {
+      stop("pss and site files are not compatible")
+    }
   }
 }
 
 #' @rdname check_css
 #' @export
 check_site <- function(site) {
-  testthat::test_that(
-    "site file is formatted correctly",
-    {
-      testthat::expect_gte(nrow(site), 1)
-      testthat::expect_true(!is.null(attributes(site)))
-      testthat::expect_is(attr(site, "nsite"), "numeric")
-      testthat::expect_true(attr(site, "file_format") %in% c(1, 2, 3))
-    }
-  )
+      stopifnot(nrow(site) >= 1)
+      stopifnot(!is.null(attributes(site)))
+      stopifnot(attr(site, "nsite") == "numeric")
+      stopifnot(attr(site, "file_format") %in% c(1, 2, 3))
 }