diff --git a/R/initGRASS.R b/R/initGRASS.R index 136cdea5e..2f699b114 100644 --- a/R/initGRASS.R +++ b/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( diff --git a/R/rast_link.R b/R/rast_link.R index 3f33c181e..44fc2d3fe 100644 --- a/R/rast_link.R +++ b/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 diff --git a/R/vect_link_ng.R b/R/vect_link_ng.R index 416004d00..e8aaf863d 100644 --- a/R/vect_link_ng.R +++ b/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) } diff --git a/R/xml1.R b/R/xml1.R index 1286c946c..21abcd112 100644 --- a/R/xml1.R +++ b/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, diff --git a/man/initGRASS.Rd b/man/initGRASS.Rd index 30480a59b..8d710e47c 100644 --- a/man/initGRASS.Rd +++ b/man/initGRASS.Rd @@ -21,7 +21,8 @@ initGRASS( use_g.dirseps.exe = TRUE, pid, remove_GISRC = FALSE, - ignore.stderr = get.ignore.stderrOption() + ignore.stderr = get.ignore.stderrOption(), + tempdir = base::tempdir() ) get.GIS_LOCK() @@ -79,6 +80,9 @@ terminates or when this package is unloaded.} \code{set.ignore.stderrOption}; can be set to TRUE to silence \code{system()} output to standard error; does not apply on Windows platforms.} + +\item{tempdir}{a directory to use for temporary files. You may want to +provide the same value for \code{home}.} } \value{ The function runs \code{gmeta6} before returning the current values diff --git a/tests/testthat/test-execGRASS.R b/tests/testthat/test-execGRASS.R index 25f395a31..23172fac0 100644 --- a/tests/testthat/test-execGRASS.R +++ b/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", {