Improve management of temporary files

R/initGRASS.R

@@ -88,6 +88,8 @@
 #'   `set.ignore.stderrOption`; can be set to TRUE to silence
 #'   `system()` output to standard error; does not apply on Windows
 #'   platforms.
+#' @param tempdir a directory to use for temporary files. You may want to
+#'   provide the same value for `home`.
 #'
 #' @return The function runs `gmeta6` before returning the current values
 #'   of the running GRASS session that it provides.
@@ -163,7 +165,11 @@
 initGRASS <- function(
     gisBase = NULL, home, SG, gisDbase, addon_base, location,
     mapset, override = FALSE, use_g.dirseps.exe = TRUE, pid,
-    remove_GISRC = FALSE, ignore.stderr = get.ignore.stderrOption()) {
+    remove_GISRC = FALSE, ignore.stderr = get.ignore.stderrOption(),
+    tempdir = base::tempdir()) {
+
+  Sys.setenv(RGRASS_TEMPDIR = tempdir)
+
   # check for existing GRASS session from rc filename specified in GISRC
   if (nchar(Sys.getenv("GISRC")) > 0 && !override) {
     ask_override(
@@ -396,7 +402,7 @@ initGRASS <- function(
     # check if the working directory is writable otherwise use a tempfile
     if (file.access(".", 2) != 0) {
       warning("working directory not writable, using tempfile for GISRC")
-      Sys.setenv(GISRC = paste(tempfile(), "junk", sep = "_"))
+      Sys.setenv(GISRC = paste(tempfile(tmpdir = Sys.getenv("RGRASS_TEMPDIR")), "junk", sep = "_"))
     }
 
     # write the GISRC file
@@ -416,7 +422,7 @@ initGRASS <- function(
     if (!missing(gisDbase)) {
       if (!file.exists(gisDbase)) dir.create(gisDbase)
     } else {
-      gisDbase <- tempdir()
+      gisDbase <- Sys.getenv("RGRASS_TEMPDIR")
     }
 
     gisDbase <- ifelse(
@@ -496,7 +502,7 @@ initGRASS <- function(
     if (!missing(gisDbase)) {
       if (!file.exists(gisDbase)) dir.create(gisDbase)
     } else {
-      gisDbase <- tempdir()
+      gisDbase <- Sys.getenv("RGRASS_TEMPDIR")
     }
 
     cat("GISDBASE:", gisDbase, "\n", file = Sys.getenv("GISRC"))
@@ -710,7 +716,7 @@ initGRASS <- function(
 
   if (mSG) {
     if (nzchar(wkt_SG)) {
-      tf <- tempfile()
+      tf <- tempfile(tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
       writeLines(wkt_SG, con = tf)
 
       MS <- execGRASS(

R/rast_link.R

@@ -362,7 +362,7 @@ read_RAST <- function(
       } else {
         NODATAi <- NODATA[i]
       }
-      tmplist[[i]] <- tempfile(fileext = fxt)
+      tmplist[[i]] <- tempfile(fileext = fxt, tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
       if (is.null(flags)) flags <- c("overwrite", "c", "m")
       if (!is.null(cat) && cat[i]) flags <- c(flags, "t")
       if (is.null(typei)) {
@@ -775,7 +775,8 @@ write_RAST <- function(
         drv <- "GTiff"
         fxt <- ".tif"
       }
-      tf <- tempfile(fileext = fxt)
+      tf <- tempfile(fileext = fxt, tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+      on.exit(unlink(tf))
       res <- getMethod("writeRaster", c("SpatRaster", "character"))(x,
         filename = tf, overwrite = TRUE, filetype = drv)
       tmpfl <- TRUE
@@ -794,7 +795,8 @@ write_RAST <- function(
     if (getMethod("nlyr", "SpatRaster")(x) == 1L) {
       xcats <- getMethod("cats", "SpatRaster")(x)[[1]]
       if (!is.null(xcats)) {
-        tfc <- tempfile()
+        tfc <- tempfile(tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+        on.exit(unlink(tfc), add = TRUE)
         write.table(xcats, tfc,
           sep = ":", row.names = FALSE,
           col.names = FALSE, quote = FALSE

R/vect_link_ng.R

@@ -212,7 +212,7 @@ read_VECT <- function(
 
   } else {
     if (layer == "") layer <- "1"
-    tf <- tempfile(fileext = ".gpkg")
+    tf <- tempfile(fileext = ".gpkg", tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
     execGRASS("v.out.ogr",
               flags = flags, input = vname, type = type,
               layer = layer, output = tf, output_layer = vname,
@@ -274,7 +274,7 @@ write_VECT <- function(x, vname, flags = "overwrite",
   }
 
   if (!file.exists(tf)) {
-    tf <- tempfile(fileext = ".gpkg")
+    tf <- tempfile(fileext = ".gpkg", tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
     getMethod("writeVector", c("SpatVector", "character"))(x, filename = tf,
       filetype = "GPKG", options = NULL, overwrite = TRUE)
   }

R/xml1.R

@@ -51,8 +51,12 @@ parseGRASS <- function(cmd, legacyExec = NULL) {
       tr <- try(system(cmd0, intern = TRUE))
       if (inherits(tr, "try-error")) stop(paste(cmd, "not found"))
     } else {
-      errFile <- tempfile()
-      outFile <- tempfile()
+      errFile <- tempfile(tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+      outFile <- tempfile(tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+      on.exit({
+          unlink(errFile)
+          unlink(outFile)
+      })
       command <- paste(prep, cmd, ext, sep = "")
       arguments <- "--interface-description"
       res <- system2(
@@ -716,8 +720,12 @@ execGRASS <- function(
     command <- attr(syscmd, "cmd")
     arguments <- substring(syscmd, (nchar(command) + 2), nchar(syscmd))
 
-    errFile <- tempfile(fileext = ".err")
-    outFile <- tempfile(fileext = ".out")
+    errFile <- tempfile(fileext = ".err", tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+    outFile <- tempfile(fileext = ".out", tmpdir = Sys.getenv("RGRASS_TEMPDIR"))
+    on.exit({
+        unlink(errFile)
+        unlink(outFile)
+    })
 
     res <- system2(command, arguments,
       stderr = errFile,

tests/testthat/test-execGRASS.R

@@ -5,13 +5,19 @@ test_that("testing basic doGRASS, execGRASS, stringexecGRASS", {
   skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH")
   skip_if(is.null(testdata), "GRASS GIS example dataset is not available")
 
+  # This test case will also check the `tempdir` argument to `initGRASS`.
+  tp = tempfile()
+  dir.create(tp)
+  previous.tempdir.contents = dir(tempdir())
+
   loc <- initGRASS(
-    home = tempdir(),
+    home = tp,
     gisBase = gisBase,
     gisDbase = testdata$gisDbase,
     location = "nc_basic_spm_grass7",
     mapset = "PERMANENT",
-    override = TRUE
+    override = TRUE,
+    tempdir = tp
   )
 
   # test assembling the command using arguments
@@ -85,6 +91,9 @@ test_that("testing basic doGRASS, execGRASS, stringexecGRASS", {
     "Invalid parameter name: silent"
   )
 
+  # Our parameters to `initGRASS` should've prevented creating any new files
+  # at the root of `tempdir()`.
+  expect_equal(dir(tempdir()), previous.tempdir.contents)
 })
 
 test_that("testing options doGRASS, execGRASS, stringexecGRASS", {