Merge pull request #144 from ropensci/better_way

use base R fns to compare versions, add tests, improve readability
ropensci · May 1, 2024 · 29f7601 · 29f7601
2 parents 8251eac + 95b3028
commit 29f7601
Show file tree

Hide file tree

Showing 3 changed files with 63 additions and 38 deletions.
diff --git a/R/digests.R b/R/digests.R
@@ -2,31 +2,21 @@
   write.dcf(data_digest, file.path(path, "DATADIGEST"))
 }
 
-.check_dataversion_string <- function(old_data_digest, new_data_digest) {
-  oldwarn <- options("warn")$warn
-  suppressWarnings({
-    oldv <- strsplit(old_data_digest[["DataVersion"]], "\\.")
-    newv <- strsplit(new_data_digest[["DataVersion"]], "\\.")
-    oldv <- lapply(oldv, as.numeric)[[1]]
-    newv <- lapply(newv, as.numeric)[[1]]
-  })
-  if (any(is.na(oldv)) | any(is.na(newv))) {
-    .multilog_fatal(paste0(
-      "Invalid DataVersion string found ",
-      old_data_digest[["DataVersion"]],
-      " and ", new_data_digest[["DataVersion"]]
-    ))
-  }
-  greater <- apply(t(cbind(oldv, newv)), 2, function(x) x[2] > x[1])
-  equal <- apply(t(cbind(oldv, newv)), 2, function(x) x[2] == x[1])
-  list(
-    isgreater = ((greater[1]) | (equal[1] & greater[2]) |
-      (equal[1] & equal[2] &
-        greater[3])),
-    isequal = all(equal),
-    isless = !((greater[1]) | (equal[1] & greater[2]) |
-      (equal[1] & equal[2] & greater[3])) & !all(equal)
-  )
+#' Check dataversion string
+#'
+#' @param new_data_digest New data digest list with element named "DataVersion"
+#'   containing a valid DataVersion
+#' @param old_data_digest Old data digest list with element named "DataVersion"
+#'   containing a valid DataVersion
+#' @returns Character, ("lower", "equal", or "higher"), where new DataVersion is
+#'   ____ relative to old DataVersion. version
+#' @noRd
+.check_dataversion_string <- function(new_data_digest, old_data_digest) {
+  new <- validate_DataVersion(new_data_digest[["DataVersion"]])
+  old <- validate_DataVersion(old_data_digest[["DataVersion"]])
+  comp <- utils::compareVersion(new, old)
+  txt <- c(lower = -1L, equal = 0L, higher = 1L)
+  names(txt[which(txt == comp)])
 }
 
 .compare_digests <- function(old_digest, new_digest) {

diff --git a/R/processData.R b/R/processData.R
@@ -393,26 +393,26 @@ do_digests <- function(pkg_dir, dataenv) {
                pkg_path = pkg_dir)
     return(TRUE)
   }
-  string_check <- .check_dataversion_string(
-    old_data_digest,
-    new_data_digest
+  check_new_DataVersion <- .check_dataversion_string(
+    new_data_digest,
+    old_data_digest
   )
   can_write <- FALSE
   same_digests <- .compare_digests(old_data_digest, new_data_digest)
-  if ((! same_digests) && string_check$isgreater){
+  if ((! same_digests) && check_new_DataVersion == "higher"){
     # not sure how this would actually happen
     err_msg <- 'Digest(s) differ but DataVersion had already been incremented'
     .multilog_fatal(err_msg)
     stop(err_msg, call. = FALSE)
   }
-  if (same_digests && string_check$isequal) {
+  if (same_digests && check_new_DataVersion == "equal") {
     can_write <- TRUE
     .multilog_trace(paste0(
       "Processed data sets match ",
       "existing data sets at version ",
       new_data_digest[["DataVersion"]]
     ))
-  } else if ((! same_digests) && string_check$isequal) {
+  } else if ((! same_digests) && check_new_DataVersion == "equal") {
     updated_version <- .increment_data_version(
       pkg_desc,
       new_data_digest
@@ -432,15 +432,15 @@ do_digests <- function(pkg_dir, dataenv) {
       "string incremented automatically to ",
       new_data_digest[["DataVersion"]]
     ))
-  } else if (same_digests && string_check$isgreater) {
+  } else if (same_digests && check_new_DataVersion == "higher") {
     # edge case that shouldn't happen
     # but we test for it in the test suite
     can_write <- TRUE
     .multilog_trace(paste0(
       "Data hasn't changed but the ",
       "DataVersion has been bumped."
     ))
-  } else if (string_check$isless && same_digests) {
+  } else if (check_new_DataVersion == "lower" && same_digests) {
     # edge case that shouldn't happen but
     # we test for it in the test suite.
     .multilog_trace(paste0(
@@ -452,7 +452,7 @@ do_digests <- function(pkg_dir, dataenv) {
                  validate_DataVersion(new_data_digest[["DataVersion"]])
     )
     can_write <- TRUE
-  } else if (string_check$isless && ! same_digests) {
+  } else if (check_new_DataVersion == "lower" && ! same_digests) {
     updated_version <- .increment_data_version(
       pkg_desc,
       new_data_digest

diff --git a/tests/testthat/test-edge-cases.R b/tests/testthat/test-edge-cases.R
@@ -175,10 +175,45 @@ test_that("validate_DataVersion works as expected", {
 })
 
 test_that(".check_dataversion_string works as expected", {
-  suppressWarnings(expect_error(DataPackageR:::.check_dataversion_string(
-    list(DataVersion = "1.1.1"),
-    list(DataVersion = "1.a.1")
-  )))
+  expect_error(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.1.1"),
+      list(DataVersion = NULL)
+    )
+  )
+  expect_error(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.1.1"),
+      list(DataVersion = NA_character_)
+    )
+  )
+  expect_error(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.1.1"),
+      list(DataVersion = "1.a.1")
+    )
+  )
+  expect_equal(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.0.1"),
+      list(DataVersion = "1.0.1")
+    ),
+    "equal"
+  )
+  expect_equal(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.0.1"),
+      list(DataVersion = "1.1.1")
+    ),
+    "lower"
+  )
+  expect_equal(
+    DataPackageR:::.check_dataversion_string(
+      list(DataVersion = "1.0.2"),
+      list(DataVersion = "1.0.1")
+    ),
+    "higher"
+  )
 })