Merge pull request #402 from PredictiveEcology/cacheIdForced

cacheId bugfix
PredictiveEcology · Sep 19, 2024 · 631cc06 · 631cc06
2 parents 6f6cef4 + 82a3617
commit 631cc06
Show file tree

Hide file tree

Showing 8 changed files with 42 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -19,8 +19,8 @@ SystemRequirements: 'unrar' (Linux/macOS) or '7-Zip' (Windows) to work with '.ra
 URL: 
     https://reproducible.predictiveecology.org,
     https://github.com/PredictiveEcology/reproducible
-Date: 2024-07-19
-Version: 2.1.1.9005
+Date: 2024-09-17
+Version: 2.1.1.9006
 Authors@R: 
     c(person(given = "Eliot J B",
              family = "McIntire",

diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,9 @@
 * improved handling of symlinks in `remapFileNames()`;
 * pass `terra::project()` arguments `use_gdal` and `by_util` through `projectTo()` to `terra::project()`;
 
+## Bugfix
+* When forcing `cacheId`, e.g., in `Cache(..., cacheId = "myCacheItem")`, `myCacheItem` was not used. Fixed.
+
 # reproducible 2.1.0
 
 ## New

diff --git a/R/DBI.R b/R/DBI.R
@@ -261,7 +261,6 @@ loadFromCache <- function(cachePath = getOption("reproducible.cachePath"),
 
         if (length(sameCacheID)) {
           # if (!identical(whereInStack("sim"), .GlobalEnv)) {
-          #   browser()
           #   format <- setdiff(c("rds", "qs"), format)
           #   message("User tried to change options('reproducible.cacheSaveFormat') for an ",
           #           "existing cache, while using a simList. ",

diff --git a/R/cache.R b/R/cache.R
@@ -659,6 +659,9 @@ Cache <-
             messageCache("cacheId is not same as calculated hash. Manually searching for cacheId:", cacheId,
                          verbose = verbose
             )
+            sc <- showCacheFast(cacheId = outputHashManual)
+            if (NROW(sc))
+              inRepos$isInRepo <- sc[1,]
           }
           outputHash <- outputHashManual
         }
@@ -1545,7 +1548,6 @@ getFunctionName2 <- function(mc) {
       # The next line works for any object that is NOT in a ..., because the
       #   object never shows up in the environment; it is passed through
       # mced <- names(CacheMatchedCall)
-      # if (exists("aaaa")) browser()
 
       # if (!is.null(unlist(argsToKeep))) {
       FUNcapturedList <- as.list(FUNcaptured[-1])

diff --git a/R/options.R b/R/options.R
@@ -255,9 +255,12 @@ reproducibleOptions <- function() {
     reproducible.timeout = 1200,
     reproducible.useCache = TRUE, # override Cache function
     reproducible.useCloud = FALSE, #
-    reproducible.useDBI = {getEnv("R_REPRODUCIBLE_USE_DBI",
-      default = useDBI(getOption("reproducible.useDBI", NULL),  # a user may have set it before this runs; keep setting
-                       verbose = interactive() - (useDBI() + 1)), # `FALSE` is useMultipleDBFiles now
+    reproducible.useDBI = {
+      getEnv("R_REPRODUCIBLE_USE_DBI",
+      default = {
+        useDBI(getOption("reproducible.useDBI", NULL),  # a user may have set it before this runs; keep setting
+                       verbose = interactive() - (useDBI() + 1), default = TRUE)
+        }, # `FALSE` is useMultipleDBFiles now
       allowed = c("true", "false")
     ) |> as.logical()},
     reproducible.useGdown = FALSE,

diff --git a/R/postProcessTo.R b/R/postProcessTo.R
@@ -1839,7 +1839,6 @@ gdalTransform <- function(from, cropTo, projectTo, maskTo, writeTo, verbose) {
   #                            "-overwrite"
   #                          )))
   #
-  # browser()
   terra::writeVector(maskTo, filename = tf2)
   system.time(sf::gdal_utils(util = "vectortranslate", source = "C:/Eliot/GitHub/Edehzhie/modules/fireSense_dataPrepFit/data/NFDB_poly_20210707.shp",
                          destination = tf, options =

diff --git a/R/showCacheEtc.R b/R/showCacheEtc.R
@@ -706,7 +706,7 @@ checkFutures <- function(verbose = getOption("reproducible.verbose")) {
   }
 }
 
-useDBI <- function(set = NULL, verbose = getOption("reproducible.verbose")) {
+useDBI <- function(set = NULL, verbose = getOption("reproducible.verbose"), default = TRUE) {
   canSwitch <- TRUE
   if (!is.null(set)) {
     if (isTRUE(set)) {
@@ -717,7 +717,7 @@ useDBI <- function(set = NULL, verbose = getOption("reproducible.verbose")) {
       options("reproducible.useDBI" = set)
     }
   }
-  ud <- getOption("reproducible.useDBI", TRUE)
+  ud <- getOption("reproducible.useDBI", default)
   if (isTRUE(ud)) {
     drv <- getOption("reproducible.drv")
     if (is.null(drv)) {

diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R
@@ -1872,3 +1872,29 @@ test_that("test omitArgs = 'x', #400", {
                                   omitArgs = c("x")))
 
 })
+
+
+test_that("cacheId = 'customName'", {
+  testInit()
+  opts <- options(reproducible.cachePath = tmpdir)
+  on.exit(options(opts), add = TRUE)
+
+  fnName <- "rnorm_this_one"
+  d <- rnorm(2) |> Cache(.functionName = fnName, cacheId = "myCacheObj")
+  e <- rnorm(3) |> Cache(.functionName = fnName, cacheId = "myCacheObj")
+  expect_true(all.equalWONewCache(e, d))
+
+  rudbi <- getOption("reproducible.useDBI")
+
+
+  newDBI <- setdiff(c(TRUE, FALSE), rudbi)
+  opts <- options(reproducible.useDBI = newDBI)
+  on.exit(options(opts))
+
+  f <- rnorm(4) |> Cache(.functionName = fnName, cacheId = "myCacheObj")
+  g <- rnorm(5) |> Cache(.functionName = fnName, cacheId = "myCacheObj")
+  expect_true(all.equalWONewCache(e, d))
+  expect_true(all.equalWONewCache(e, f))
+  expect_true(all.equalWONewCache(e, g))
+})
+