Merge branch 'main' into develop

R/build.R

@@ -8,7 +8,7 @@
 #' @param vignettes \code{logical} specify whether to build vignettes. Default FALSE.
 #' @param log log level \code{INFO,WARN,DEBUG,FATAL}
 #' @param deps \code{logical} should we pass data objects into subsequent scripts? Default TRUE
-#' @param install \code{logical} automatically install and load the package after building. (default TRUE)
+#' @param install \code{logical} automatically install and load the package after building. Default FALSE
 #' @param ... additional arguments passed to \code{install.packages} when \code{install=TRUE}.
 #' @importFrom roxygen2 roxygenise roxygenize
 #' @importFrom devtools build_vignettes build parse_deps reload

R/digests.R

@@ -30,42 +30,38 @@
 }
 
 .compare_digests <- function(old_digest, new_digest) {
-  valid <- ifelse(length(old_digest) != length(new_digest), FALSE, TRUE)
-  if (valid) {
-    for (i in names(new_digest)[-1L]) {
-      if (new_digest[[i]] != old_digest[[i]]) {
-        .multilog_warn(paste0(i, " has changed."))
-        valid <- FALSE
+  # Returns FALSE when any exisiting data has is changed, new data is added, or data is removed, else return TRUE.
+  # Use .mutlilog_warn when there is a change and multilog_debug when new data is added.
+
+  existed <- names(new_digest)[names(new_digest) %in% names(old_digest)]
+  added <- setdiff(names(new_digest), existed)
+  removed <- names(old_digest)[!names(old_digest) %in% names(new_digest)]
+  existed <- existed[existed != "DataVersion"]  
+
+  if(length(existed) > 0){
+    changed <- names(new_digest)[ unlist(new_digest[existed]) != unlist(old_digest[existed]) ] 
+    if(length(changed) > 0){
+      for(name in changed){
+        .multilog_warn(paste(name, "has changed."))
       }
-    }
-    if (!valid) {
       warning()
-    }
-  } else {
-    difference <- setdiff(names(new_digest), names(old_digest))
-    intersection <- intersect(names(new_digest), names(old_digest))
-    # No existing or new objects are changed
-    if (length(difference) == 0) {
-      valid <- TRUE
-    } else {
-      # some new elements exist
-      valid <- FALSE
-      for (i in difference) {
-        .multilog_debug(paste0(i, " added."))
-      }
-    }
-    for (i in intersection) {
-      if (new_digest[[i]] != old_digest[[i]]) {
-        .multilog_debug(paste0(i, " changed"))
-        # some new elements are not the same
-        valid <- FALSE
-      }
+      return(FALSE)
     }
   }
-  return(valid)
-}
 
+  for(name in removed){
+    .multilog_debug(paste(name, "was removed."))
+    return(FALSE)
+  }
+
+  for(name in added){
+    .multilog_debug(paste(name, "was added."))
+    return(FALSE)
+  }
 
+  return(TRUE)
+};
+
 .combine_digests <- function(new, old) {
   intersection <- intersect(names(new), names(old))
   difference <- setdiff(names(new), names(old))

tests/testthat/test-data-name-change.R

@@ -0,0 +1,61 @@
+test_that("data object can be renamed", {
+
+  addData <- function(dataset, pname){
+    fil <- sprintf("data(%s, envir=environment())", dataset)
+    writeLines(fil, file.path(tempdir(), sprintf("%s/data-raw/%s.R", pname, dataset)))
+
+    yml <- yml_add_files(file.path(tempdir(), pname), c(sprintf("%s.R", dataset)))
+    yml <- yml_add_objects(yml, dataset)
+    yml_write(yml)
+
+    package_build(file.path(tempdir(), pname))
+  }
+
+  changeName <- function(old_dataset_name, new_dataset_name, pname){
+    process_path <- file.path(tempdir(), sprintf("%s/data-raw/%s.R", pname, old_dataset_name))
+    fil <- c(readLines(process_path), sprintf("%s <- %s", new_dataset_name, old_dataset_name))
+    writeLines(fil, process_path)
+
+    yml <- yml_remove_objects(file.path(tempdir(), pname), old_dataset_name)
+    yml <- yml_add_objects(yml, new_dataset_name)
+    yml_write(yml)
+
+    package_build(file.path(tempdir(), pname))
+  }
+
+  removeName <- function(dataset_name, script, pname){
+    process_path <- file.path(tempdir(), sprintf("%s/data-raw/%s", pname, script))
+    fil <- gsub(paste0("^", dataset_name, ".+$"), "", readLines(process_path))
+    writeLines(fil, process_path)
+
+    yml <- yml_remove_objects(file.path(tempdir(), pname), dataset_name)
+    yml_write(yml)
+
+    package_build(file.path(tempdir(), pname))
+  }
+
+  ## test change when one object is present 
+  pname <- "nameChangeTest1"
+  datapackage_skeleton(pname, tempdir(), force = TRUE)
+  addData("mtcars", pname)
+  expect_error(changeName("mtcars", "mtcars2", pname), NA)
+  expect_error(removeName("mtcars2", "mtcars.R", pname), "exiting")
+
+  ## test change when two objects are present 
+  pname <- "nameChangeTest2"
+  datapackage_skeleton(pname, tempdir(), force = TRUE)
+  addData("mtcars", pname)
+  addData("iris", pname)
+  expect_error(changeName("mtcars", "mtcars2", pname), NA)
+  expect_error(removeName("mtcars2", "mtcars.R", pname), NA)
+
+  ## test change when more than 2 objects are present 
+  pname <- "nameChangeTest3"
+  datapackage_skeleton(pname, tempdir(), force = TRUE)
+  addData("mtcars", pname)
+  addData("iris", pname)
+  addData("ToothGrowth", pname)
+  expect_error(changeName("mtcars", "mtcars2", pname), NA)
+  expect_error(removeName("mtcars2", "mtcars.R", pname), NA)
+
+})

tests/testthat/test-edge-cases.R

@@ -171,7 +171,8 @@ test_that("package built in different edge cases", {
   package.skeleton("foo", path = tempdir())
   DataPackageR:::.multilog_setup(normalizePath(file.path(tempdir(),"test.log"), winslash = "/"))
   DataPackageR:::.multilog_thresold(INFO, TRACE)
-
+
+  # data in digest changes while names do not
   suppressWarnings(expect_false({
     DataPackageR:::.compare_digests(
       list(
@@ -185,6 +186,64 @@ test_that("package built in different edge cases", {
     )
   }))
 
+  # names in digest changes while data do not
+  suppressWarnings(expect_false({
+    DataPackageR:::.compare_digests(
+      list(
+        DataVersion = "1.1.1",
+        a = paste0(letters[1:10], collapse = "")
+      ),
+      list(
+        DataVersion = "1.1.2",
+        b = paste0(letters[1:10], collapse = "")
+      )
+    )
+  }))
+
+  # names in digest nor data changes
+  suppressWarnings(expect_true({
+    DataPackageR:::.compare_digests(
+      list(
+        DataVersion = "1.1.1",
+        a = paste0(letters[1:10], collapse = "")
+      ),
+      list(
+        DataVersion = "1.1.1",
+        a = paste0(letters[1:10], collapse = "")
+      )
+    )
+  }))
+
+  # names in old digest have one more than new
+  suppressWarnings(expect_false({
+    DataPackageR:::.compare_digests(
+      list(
+        DataVersion = "1.1.1",
+        a = paste0(letters[1:10], collapse = ""),
+        b = paste0(LETTERS[1:10], collapse = "")
+      ),
+      list(
+        DataVersion = "1.1.2",
+        a = paste0(letters[1:10], collapse = "")
+      )
+    )
+  }))
+
+  # names in new digest have one more than old
+  suppressWarnings(expect_false({
+    DataPackageR:::.compare_digests(
+      list(
+        DataVersion = "1.1.1",
+        a = paste0(letters[1:10], collapse = "")
+      ),
+      list(
+        DataVersion = "1.1.2",
+        a = paste0(letters[1:10], collapse = ""),
+        b = paste0(LETTERS[1:10], collapse = "")
+      )
+    )
+  }))
+
   unlink(file.path(tempdir(), "foo"),
     force = TRUE,
     recursive = TRUE