[WIP] use unique tempfiles for interemediate rasters

with ropensci#18 requires fix for rspatial/raster#315
achubaty · Jul 17, 2023 · bc0a53a · bc0a53a
1 parent bb8bfbb
commit bc0a53a
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 9 deletions.
diff --git a/R/tile.R b/R/tile.R
@@ -1,3 +1,7 @@
+tmprst <- function() {
+  tempfile(pattern = "tmp_raster_", fileext = ".tif")
+}
+
 #' Create map tiles
 #'
 #' Create geographic and non-geographic map tiles from a file.
@@ -137,9 +141,12 @@ tile <- function(file, tiles, zoom, crs = NULL, resume = FALSE, viewer = TRUE,
     }
   }
   dir.create(tiles, showWarnings = FALSE, recursive = TRUE)
-  projected <- .proj_check(file, crs, ...)
+  tf <- tmprst()
+
+  projected <- .proj_check(file, crs, tmpf = tf, ...)
+
   if(ext %in% .supported_filetypes$ras)
-    file <- file.path(tempdir(), "tmp_raster.tif")
+    file <- tf
   dir.create(g2t_tmp_dir <- tempfile("g2ttmp_"),
              showWarnings = FALSE, recursive = TRUE)
   if(projected){
@@ -162,7 +169,7 @@ tile <- function(file, tiles, zoom, crs = NULL, resume = FALSE, viewer = TRUE,
     cat("Creating tile viewer...\n")
     w <- h <- NULL
     if(!projected){
-      if(file == file.path(tempdir(), "tmp_raster.tif")){
+      if(file == tf){
         x <- raster::raster(file)
         w <- ncol(x)
         h <- nrow(x)
@@ -185,10 +192,11 @@ tile <- function(file, tiles, zoom, crs = NULL, resume = FALSE, viewer = TRUE,
   invisible()
 }
 
-.proj_check <- function(file, crs = NULL, ...){
+.proj_check <- function(file, crs = NULL, tmpf = tmprst(), ...){
   ext <- .get_ext(file)
   if(ext %in% .supported_filetypes$img) return(FALSE)
   dots <- list(...)
+  browser()
   r <- raster::readAll(raster::stack(file))
   bands <- raster::nlayers(r)
   if(!bands %in% c(1, 3, 4))
@@ -230,8 +238,7 @@ tile <- function(file, tiles, zoom, crs = NULL, resume = FALSE, viewer = TRUE,
                      ext = dots$ext)
   }
   cat("Preparing for tiling...\n")
-  raster::writeRaster(r, file.path(tempdir(), "tmp_raster.tif"),
-                      overwrite = TRUE, datatype = "INT1U")
+  raster::writeRaster(r, filename = tmpf, overwrite = TRUE, datatype = "INT1U")
   projected
 }
 

diff --git a/tests/testthat/test-tile.R b/tests/testthat/test-tile.R
@@ -21,15 +21,15 @@ test_that("tile works on different inputs", {
   # Test RGB/RGBA multi-band rasters
   idx <- grep("rgb", files)
   suppressWarnings(for(i in idx)
-    expect_is(tile(files[i], tiles[i], "0"), "NULL"))
+    expect_is(tile(files[i], tiles[i], "0"), "NULL")) ## TODO: fails for i=12; see raster#315
 
   files <- files[-idx]
   tiles <- tiles[-idx]
 
   # Test rejection of file with number of layers other than 1, 3 or 4
   r <- raster(files[basename(files) == "map_albers.grd"])
   r <- stack(r, r)
-  tmp <- file.path(tempdir(), "tmp_raster.tif")
+  tmp <- tmprst()
   writeRaster(r, tmp)
   err <- "`file` is multi-band but does not appear to be RGB or RGBA layers."
   expect_error(tile(tmp, "tmp_raster", "0"), err)
@@ -44,7 +44,7 @@ test_that("tile works on different inputs", {
 
   # missing CRS
 
-  # Change needed: Thes files used to read in with raster as having NA for crs,
+  # Change needed: These files used to read in with raster as having NA for crs,
   # but no longer do. It looks like wgs84 is assumed on read.
   # See data-raw/data.R for context.