diff --git a/.Rbuildignore b/.Rbuildignore index b378cdb..d8bb55d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,4 @@ _pkgdown.yml ^.*\.Rproj$ ^\.Rproj\.user$ ^\.github$ +^codecov\.yml$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..c252cca --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,52 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: R-CMD-check + +permissions: read-all + +jobs: + R-CMD-check: + strategy: + matrix: + os: [ubuntu-22.04, ubuntu-24.04] + + runs-on: ${{ matrix.os }} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Install common system dependencies + run: | + sudo apt-get update + sudo apt-get install -y grass-dev libgdal-dev libudunits2-dev libharfbuzz-dev libfribidi-dev + + - name: Download test dataset + run: | + wget https://grass.osgeo.org/sampledata/north_carolina/nc_basic_spm_grass7.zip -O /tmp/nc_basic_spm_grass7.zip + unzip /tmp/nc_basic_spm_grass7.zip -d /tmp/grassdb + rm /tmp/nc_basic_spm_grass7.zip + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck, any::terra + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/check-releasebranch.yaml b/.github/workflows/check-releasebranch.yaml new file mode 100644 index 0000000..5606e97 --- /dev/null +++ b/.github/workflows/check-releasebranch.yaml @@ -0,0 +1,74 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: releasebranch_8_4-ubuntu + +permissions: read-all + +jobs: + R-CMD-check-releasebranch: + runs-on: ubuntu-latest + strategy: + matrix: + container: [ + "osgeo/grass-gis:releasebranch_8_4-ubuntu", + "osgeo/grass-gis:main-ubuntu" + ] + + container: + image: ${{ matrix.container }} + options: --privileged + + steps: + - uses: actions/checkout@v4 + + - name: Install system deps + run: | + apt-get update + apt-get install -y \ + libudunits2-dev \ + libharfbuzz-dev \ + libfribidi-dev \ + gdal-bin \ + libmysqlclient-dev \ + libfontconfig1-dev \ + qpdf \ + pandoc \ + pandoc-citeproc + + - name: Install R + run: | + wget -qO- https://cloud.r-project.org/bin/linux/ubuntu/marutter_pubkey.asc | tee -a /etc/apt/trusted.gpg.d/cran_ubuntu_key.asc + echo "deb https://cloud.r-project.org/bin/linux/ubuntu jammy-cran40/" | tee -a /etc/apt/sources.list + apt-get update + apt-get install -y r-base-dev + + - name: Configure RSPM in .Renviron + run: | + echo 'options(repos = c(CRAN = "https://packagemanager.posit.co/cran/__linux__/jammy/latest"))' >> ~/.Rprofile + echo 'options(HTTPUserAgent = sprintf("R/%s R (%s)", getRversion(), paste(getRversion(), R.version["platform"], R.version["arch"], R.version["os"])))' >> ~/.Rprofile + echo 'options(Ncpus=parallel::detectCores())' >> ~/.Rprofile + + - name: Install R dependencies + run: | + R -e "install.packages(c('remotes', 'rcmdcheck'))" + R -e "remotes::install_deps(dependencies = TRUE)" + R -e "install.packages('terra', repos = 'https://cloud.r-project.org/', type = 'source')" + + - name: Download test dataset + run: | + wget https://grass.osgeo.org/sampledata/north_carolina/nc_basic_spm_grass7.zip -O /tmp/nc_basic_spm_grass7.zip + unzip /tmp/nc_basic_spm_grass7.zip -d /tmp/grassdb + rm /tmp/nc_basic_spm_grass7.zip + + # - name: Run R CMD check + # run: | + # R -e "rcmdcheck::rcmdcheck(args = c('--no-manual', '--no-build-vignettes'), error_on = 'error', check_dir = 'check')" + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..9a35395 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,66 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + +name: test-coverage.yaml + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - name: Install common system dependencies + run: | + sudo apt-get update + sudo apt-get install -y grass-dev libgdal-dev libudunits2-dev libharfbuzz-dev libfribidi-dev + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2, any::terra + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + covr::to_cobertura(cov) + shell: Rscript {0} + + - uses: codecov/codecov-action@v4 + with: + # Fail if error if not on PR, or if on PR and token is given + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + file: ./cobertura.xml + plugin: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/DESCRIPTION b/DESCRIPTION index e967eee..147ac1b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,7 +13,16 @@ Authors@R: c( Description: An interface between the 'GRASS' geographical information system ('GIS') and 'R', based on starting 'R' from within the 'GRASS' 'GIS' environment, or running a free-standing 'R' session in a temporary 'GRASS' location; the package provides facilities for using all 'GRASS' commands from the 'R' command line. The original interface package for 'GRASS 5' (2000-2010) is described in Bivand (2000) and Bivand (2001) . This was succeeded by 'spgrass6' for 'GRASS 6' (2006-2016) and 'rgrass7' for 'GRASS 7' (2015-present). The 'rgrass' package modernizes the interface for 'GRASS 8' while still permitting the use of 'GRASS 7'. Depends: R (>= 3.5.0) Imports: stats, utils, methods, xml2 -Suggests: terra (>= 1.6-16), sp (>= 0.9), knitr, rmarkdown, sf, stars, raster (>= 3.6-3), codetools +Suggests: + terra (>= 1.6-16), + sp (>= 0.9), + knitr, + rmarkdown, + sf, + stars, + raster (>= 3.6-3), + codetools, + testthat (>= 3.0.0) VignetteBuilder: knitr SystemRequirements: GRASS (>= 7) License: GPL (>= 2) @@ -22,3 +31,4 @@ BugReports: https://github.com/osgeo/rgrass/issues/ RoxygenNote: 7.3.2 Roxygen: list(markdown = TRUE) Encoding: UTF-8 +Config/testthat/edition: 3 diff --git a/R/gmeta.R b/R/gmeta.R index ad7f279..cc6585b 100644 --- a/R/gmeta.R +++ b/R/gmeta.R @@ -188,10 +188,9 @@ getLocationProj <- function(ignore.stderr = FALSE, g.proj_WKT = NULL) { if (!g.proj_WKT) WKT2 <- FALSE } if (WKT2 && !old_proj) { - res <- paste(execGRASS("g.proj", - flags = c("w"), intern = TRUE, - ignore.stderr = ignore.stderr - ), collapse = "\n") + res <- execGRASS("g.proj", flags = c("w"), intern = TRUE, ignore.stderr = TRUE) + res <- paste(res, collapse = "\n") + if (substr(res, 1, 5) != "ERROR") { if (nchar(res) == 0L) { res <- paste(execGRASS("g.proj", diff --git a/R/vect_link.R b/R/vect_link.R index 3baa90d..a3595c2 100644 --- a/R/vect_link.R +++ b/R/vect_link.R @@ -171,10 +171,12 @@ vDataCount <- function(vname, layer, ignore.stderr = NULL) { vect2neigh <- function( vname, ID = NULL, ignore.stderr = NULL, remove = TRUE, vname2 = NULL, units = "k") { + if (get.suppressEchoCmdInFuncOption()) { inEchoCmd <- get.echoCmdOption() tull <- set.echoCmdOption(FALSE) } + if (is.null(ignore.stderr)) { ignore.stderr <- get("ignore.stderr", envir = .GRASS_CACHE) } @@ -182,13 +184,13 @@ vect2neigh <- function( vinfo <- vInfo(vname) types <- names(vinfo)[which(vinfo > 0)] + if (length(grep("areas", types)) == 0) { stop("Vector object not of area type") } n <- vDataCount(vname, ignore.stderr = ignore.stderr) - if (!is.null(ID)) { if (!is.character(ID)) stop("ID not character string") # cmd <- paste(paste("v.info", .addexe(), sep=""), @@ -222,9 +224,11 @@ vect2neigh <- function( } } vname2_was_null <- FALSE + if (is.null(vname2)) { pid <- as.integer(round(runif(1, 1, 1000))) vname2 <- paste(vname, pid, sep = "") + tull <- execGRASS("g.remove", type = "vector", name = vname2, flags = "f", intern = TRUE, ignore.stderr = ignore.stderr @@ -326,7 +330,7 @@ vect2neigh <- function( if (remove) { tull <- execGRASS("g.remove", name = paste(vname2, vname2a, sep = ","), type = "vector", - intern = TRUE, ignore.stderr = ignore.stderr + intern = TRUE, ignore.stderr = ignore.stderr, flags = "f" ) } diff --git a/R/vect_link_ng.R b/R/vect_link_ng.R index 73e21b1..a8a6bff 100644 --- a/R/vect_link_ng.R +++ b/R/vect_link_ng.R @@ -222,16 +222,21 @@ write_VECT <- function(x, vname, flags = "overwrite", if (!(requireNamespace("terra", quietly = TRUE))) { stop("terra required for SpatVector input") } + stopifnot(is.logical(ignore.stderr), !is.na(ignore.stderr)) + if (get.suppressEchoCmdInFuncOption()) { inEchoCmd <- set.echoCmdOption(FALSE) } + srcs <- getMethod("sources", "SpatVector")(x) + if (length(srcs) == 1L) { tf <- srcs } else { tf <- "" } + # exit when the source is a GRASS database layer already: if (grepl("[/\\\\]head::[^/\\\\]+$", tf)) { grass_layername <- regmatches( @@ -254,7 +259,7 @@ write_VECT <- function(x, vname, flags = "overwrite", if (!file.exists(tf)) { tf <- tempfile(fileext = ".gpkg") getMethod("writeVector", c("SpatVector", "character"))(x, filename = tf, - filetype = "GPKG", overwrite = TRUE) + filetype = "GPKG", options = NULL, overwrite = TRUE) } type <- NULL @@ -267,6 +272,7 @@ write_VECT <- function(x, vname, flags = "overwrite", flags = flags, input = tf, output = vname, type = type, ignore.stderr = ignore.stderr ) + if (get.suppressEchoCmdInFuncOption()) { tull <- set.echoCmdOption(inEchoCmd) } diff --git a/README.md b/README.md index 6e07187..9c95e34 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ # rgrass -[![CRAN](http://www.r-pkg.org/badges/version/rgrass)](https://cran.r-project.org/package=rgrass) +[![CRAN status](https://www.r-pkg.org/badges/version/rgrass)](https://CRAN.R-project.org/package=rgrass) +[![Codecov test coverage](https://codecov.io/gh/stevenpawley/rgrass/graph/badge.svg)](https://app.codecov.io/gh/stevenpawley/rgrass) ### Interface Between GRASS Geographical Information System and R diff --git a/codecov.yml b/codecov.yml new file mode 100644 index 0000000..04c5585 --- /dev/null +++ b/codecov.yml @@ -0,0 +1,14 @@ +comment: false + +coverage: + status: + project: + default: + target: auto + threshold: 1% + informational: true + patch: + default: + target: auto + threshold: 1% + informational: true diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..cd6253e --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(rgrass) + +test_check("rgrass") diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R new file mode 100644 index 0000000..a69ebfd --- /dev/null +++ b/tests/testthat/helper.R @@ -0,0 +1,40 @@ +download_nc_basic <- function() { + if (Sys.info()["sysname"] == "Linux") { + tmpdir <- "/tmp" + } else{ + tmpdir <- tempdir() + } + + if (!file.exists(file.path(tmpdir, "nc_basic_spm_grass7.zip"))) { + base_url <- "https://grass.osgeo.org/sampledata" + path_url <- "north_carolina" + file_url <- "nc_basic_spm_grass7.zip" + + download.file( + paste(base_url, path_url, file_url, sep = "/"), + file.path(tmpdir, "nc_basic_spm_grass7.zip") + ) + + unzip( + file.path(tmpdir, "nc_basic_spm_grass7.zip"), + exdir = file.path(tmpdir, "grassdb") + ) + } + + dataset <- list( + gisDbase = file.path(tmpdir, "grassdb"), + location = "nc_basic_spm_grass7" + ) + + return(dataset) +} + +get_gisbase <- function() { + if (Sys.info()["sysname"] == "Linux") { + gisBase <- system2("grass", "--config path", stdout = TRUE) + } else { + gisBase <- Sys.getenv("GRASS_INSTALLATION") + } + + return(gisBase) +} diff --git a/tests/testthat/test-execGRASS.R b/tests/testthat/test-execGRASS.R new file mode 100644 index 0000000..72c98f5 --- /dev/null +++ b/tests/testthat/test-execGRASS.R @@ -0,0 +1,113 @@ +library(testthat) +library(terra) +source("helper.R") + +# setup +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +test_that("testing basic doGRASS, execGRASS, stringexecGRASS", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # test assembling the command using arguments + cmd <- doGRASS( + "r.slope.aspect", + elevation = "elevation", + slope = "slope", + aspect = "aspect" + ) + + expect_type(cmd, "character") + expect_equal(attributes(cmd)$cmd, "r.slope.aspect") + expect_equal(as.character(cmd), "r.slope.aspect elevation=elevation slope=slope aspect=aspect") + + # test assembling the command using a list + params <- list(elevation = "elevation", slope = "slope", aspect = "aspect") + cmd2 <- doGRASS("r.slope.aspect", parameters = params) + expect_equal(cmd, cmd2) + + # test executing the command + stringexecGRASS(cmd) + aspect <- read_RAST("aspect") + expect_equal(as.numeric(minmax(aspect)), c(0, 360)) + execGRASS("g.remove", type = "raster", name = c("slope", "aspect"), flags = "f") + + # test executing the command based on the execGRASS wrapper + execGRASS( + "r.slope.aspect", + elevation = "elevation", + slope = "slope", + aspect = "aspect" + ) + aspect <- read_RAST("aspect") + expect_equal(as.numeric(minmax(aspect)), c(0, 360)) + execGRASS("g.remove", type = "raster", name = c("slope", "aspect"), flags = "f") + + # Try executing 'r.stats' command which will fail because "fire_blocksgg" + # does not exist in the mapset + expect_error( + execGRASS("r.stats", input = "fire_blocksgg", flags = c("c", "n")), + "Raster map not found" + ) + + # Test using an invalid parameter + expect_error( + execGRASS("r.stats", input = "elevation", flags = c("c", "n"), silent = TRUE), + "Invalid parameter name: silent" + ) +}) + +test_that("testing options doGRASS, execGRASS, stringexecGRASS", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # test 'intern' = TRUE + raster_maps <- c("basins", "elevation", "elevation_shade", "geology", "lakes", + "landuse", "soils") + + res <- execGRASS("g.list", type = "raster") + expect_type(res, "integer") + expect_true(res == 0) + expect_named(attributes(res), c("resOut", "resErr")) + expect_equal(attr(res, "resOut"), raster_maps) + expect_length(attr(res, "resErr"), 0) + + res <- execGRASS("g.list", type = "raster", intern = TRUE) + expect_type(res, "character") + expect_equal(res, raster_maps) + + # Execute 'r.stats' with legacyExec + res <- execGRASS( + "r.stats", + input = "elevation", + flags = c("C", "n"), + legacyExec = TRUE + ) + expect_equal(res, 0) + + # Test redirect (allows command to fail with only warning) + expect_warning( + execGRASS( + "r.stats", + input = "fire_blocksgg", + flags = c("C", "n"), + redirect = TRUE, + legacyExec = TRUE + ) + ) +}) diff --git a/tests/testthat/test-gmeta.R b/tests/testthat/test-gmeta.R new file mode 100644 index 0000000..e5480a8 --- /dev/null +++ b/tests/testthat/test-gmeta.R @@ -0,0 +1,55 @@ +library(testthat) +library(terra) +source("helper.R") + +# setup +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +testthat::test_that("testing gmeta", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # Initialize a temporary GRASS project using the example data + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # Test gmeta working + meta <- gmeta() + + expect_equal( + names(meta), + c("GISDBASE", "LOCATION_NAME", "MAPSET", "GRASS_GUI", "projection", "zone", "n", + "s", "w", "e", "t", "b", "nsres", "nsres3", "ewres", "ewres3", "tbres", "rows", "rows3", + "cols", "cols3", "depths", "cells", "cells3", "proj4") + ) + + expect_equal(meta$LOCATION_NAME, testdata$location) + expect_equal(meta$projection, "99") + + # Test old proj4 output from grass + meta2 <- gmeta(g.proj_WKT = FALSE) + expect_equal(meta2$proj4, paste(crs("epsg:3358", proj = TRUE), "+type=crs")) + + # Test gmeta2grd + meta3 <- gmeta2grd() + expect_s4_class(meta3, "GridTopology") + + # Test just returning the projection + meta4 <- getLocationProj() + expect_equal(meta4, meta$proj4) + + meta4 <- getLocationProj(g.proj_WKT = FALSE) + expect_equal(meta4, paste(crs("epsg:3358", proj = TRUE), "+type=crs")) + + # Test coercion of projection into terra and sp classes + gLP <- getLocationProj() + expect_type(terra::crs(gLP), "character") + + # disabled due to unknown issue with sp reading WTK + # expect_s4_class(sp::CRS(gLP), "CRS") +}) diff --git a/tests/testthat/test-initGRASS.R b/tests/testthat/test-initGRASS.R new file mode 100644 index 0000000..6bebb54 --- /dev/null +++ b/tests/testthat/test-initGRASS.R @@ -0,0 +1,121 @@ +library(testthat) +library(terra) +source("helper.R") + +# setup +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +test_that("testing basic initGRASS", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # Initialize a temporary GRASS project using the example data + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + expect_s3_class(loc, "gmeta") + expect_equal(loc$LOCATION_NAME, "nc_basic_spm_grass7") + expect_equal(loc$projection, "99") + expect_equal(crs(loc$proj4, describe = TRUE)$name, "NAD83(HARN) / North Carolina") +}) + +test_that("testing initialization from SpatRaster", { + meuse_grid <- rast(system.file("ex/meuse.tif", package = "terra")) + loc <- initGRASS(gisBase = gisBase, SG = meuse_grid, override = TRUE) + expect_s3_class(loc, "gmeta") +}) + +test_that("testing remove_GISRC", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + remove_GISRC = TRUE, + pid = 1000, + override = TRUE + ) + + lockfile <- Sys.getenv("GISRC") + expect_true(file.exists(lockfile)) + + remove_GISRC() + expect_false(file.exists(lockfile)) +}) + +test_that("testing set/unset.GIS_LOCK", { + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + remove_GISRC = TRUE, + override = TRUE + ) + + expect_false( + file.exists(file.path(testdata$gisDbase, "nc_basic_spm_grass7", "user1", ".gislock")) + ) + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + remove_GISRC = TRUE, + pid = 1000, + override = TRUE + ) + + # note - shouldn't this be an integer? + expect_equal(get.GIS_LOCK(), "1000") + + # test setting a lock by switching to mapset + execGRASS("g.mapset", mapset = "user1") + expect_true( + file.exists(file.path(testdata$gisDbase, "nc_basic_spm_grass7", "user1", ".gislock")) + ) + + # changing mapset will cause the lockfile to be removed for current session + execGRASS("g.mapset", mapset = "PERMANENT") + expect_false( + file.exists(file.path(testdata$gisDbase, "nc_basic_spm_grass7", "user1", ".gislock")) + ) + + # test removing the lock + unset.GIS_LOCK() + expect_equal(get.GIS_LOCK(), "") + + # test removing the GICRC + expect_error( + initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "user1", + override = FALSE + ), + regexp = "A GRASS location" + ) + + remove_GISRC() + + expect_no_error( + initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "user1", + override = FALSE + ) + ) + + unlink(file.path(testdata$gisDbase, "nc_basic_spm_grass7", "user1", ".gislock")) +}) diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R new file mode 100644 index 0000000..8c92e5a --- /dev/null +++ b/tests/testthat/test-options.R @@ -0,0 +1,183 @@ +library(testthat) +library(terra) +source("helper.R") + +# setup +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +test_that("testing ignore.stderrOption", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # test setting ignore.stderrOption + expect_false(get.ignore.stderrOption()) + set.ignore.stderrOption(TRUE) + expect_true(get.ignore.stderrOption()) + + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + ignore.stderr = TRUE, + override = TRUE + ) + expect_true(get.ignore.stderrOption()) + + # restore defaults + set.ignore.stderrOption(FALSE) +}) + +test_that("testing stop_on_no_flags_parasOption", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # testing stop_on_no_flags_parasOption set to TRUE by default + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + expect_true(get.stop_on_no_flags_parasOption()) + + # TODO: what is the purpose of stop_on_no_flags_parasOption because + # commands with no arguments appear to succeed irrespectively, and commands + # missing required arguments appear to fail irrespectively? + # expect_error( + # execGRASS("g.gisenv"), + # regexp = "required parameters with no defaults missing:" + # ) + + set.stop_on_no_flags_parasOption(FALSE) + expect_false(get.stop_on_no_flags_parasOption()) + # expect_no_error(execGRASS("g.gisenv")) + + # restore defaults + set.stop_on_no_flags_parasOption(TRUE) +}) + +test_that("testing echoCmdOption option", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # testing echoCmdOption (set to FALSE by default) + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + expect_false(get.echoCmdOption()) + + # testing echoCmdOption set to true with the GRASS command printed to the console + set.echoCmdOption(TRUE) + expect_true(get.echoCmdOption()) + + res <- capture.output({ + x <- execGRASS("g.list", type = "raster", intern = TRUE) + } + ) + expect_true(length(res) > 0) + + # testing echoCmdOption set to false with the GRASS command is silent + set.echoCmdOption(FALSE) + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + res <- capture.output({ + x <- execGRASS("g.list", type = "raster", intern = TRUE) + } + ) + expect_length(res, 0) + + # restore defaults + set.stop_on_no_flags_parasOption(FALSE) +}) + +test_that("testing useInternOption option", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # testing echoCmdOption (set to FALSE by default) + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + expect_false(get.useInternOption()) + res <- execGRASS("g.list", type = "raster") + expect_true(res == 0) + + # test echoCmdOption set to TRUE + set.useInternOption(TRUE) + expect_true(get.useInternOption()) + res <- execGRASS("g.list", type = "raster") + expect_length(res, 7) + + # restore defaults + set.useInternOption(FALSE) +}) + +test_that("testing legacyExecOption option", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # testing echoCmdOption (set to FALSE by default) + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # test legacyExecOption set to FALSE (uses system2 which returns resOut and resErr) + expect_false(get.legacyExecOption()) + res <- execGRASS("r.stats", input = "elevation", flags = c("C", "n")) + expect_named(attributes(res), c("resOut", "resErr")) + + # test legacyExecOption set to TRUE (uses system only returns the module return code) + set.legacyExecOption(TRUE) + res <- execGRASS("r.stats", input = "elevation", flags = c("C", "n")) + expect_equal(res, 0) + expect_null(attributes(res)) + + # restore defaults + set.legacyExecOption(FALSE) +}) + +test_that("testing defaultFlagsOption option", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # testing echoCmdOption (set to FALSE by default) + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + + # test defaultFlagsOption set to NULL + expect_null(get.defaultFlagsOption()) + + # test defaultFlagsOption set to "verbose" + set.defaultFlagsOption("verbose") + expect_equal(get.defaultFlagsOption(), "verbose") + + # restore defaults + set.defaultFlagsOption(NULL) +}) diff --git a/tests/testthat/test-read_RAST.R b/tests/testthat/test-read_RAST.R new file mode 100644 index 0000000..c59c074 --- /dev/null +++ b/tests/testthat/test-read_RAST.R @@ -0,0 +1,67 @@ +library(testthat) +library(terra) +library(sp) +source("helper.R") + +# setup (share grass session across tests) +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +if (!is.null(gisBase)) { + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) +} + +test_that("testing read_RAST using terra", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + # read a categorical raster map + v1 <- read_RAST("landuse", cat = TRUE, return_format = "terra") + expect_s4_class(v1, "SpatRaster") + expect_false(inMemory(v1)) + + # check the values and labels + lvls <- terra::levels(v1) + expect_equal(lvls[[1]]$value, 0:7) + expect_equal( + lvls[[1]]$label, + c("undefined", "developed", "agriculture", "herbaceous", "shrubland", + "forest", "water", "sediment") + ) +}) + +test_that("testing read_RAST using sp", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + skip_on_ci() + skip_on_cran() + + # check getting the location + grass_crs <- execGRASS("g.proj", flags = c("w"), intern = TRUE, ignore.stderr = TRUE) + grass_crs <- paste(grass_crs, collapse = "\n") + + crs_terra <- terra::crs(grass_crs) + expect_type(crs_terra, "character") + expect_equal(terra::crs(grass_crs, describe = TRUE)$code, "3358") + + crs_sp <- sp::CRS(terra::crs(grass_crs)) + expect_s4_class(crs_sp, "CRS") + + grass_crs1 <- getLocationProj() + expect_type(terra::crs(grass_crs1), "character") + expect_equal(terra::crs(grass_crs1, describe = TRUE)$code, "3358") + + # test reading a raster map using sp + nc_basic <- read_RAST("landuse", cat = TRUE, return_format = "SGDF") + lvls <- levels(nc_basic$landuse) + + expect_equal( + lvls, + c("developed", "agriculture", "herbaceous", "shrubland", + "forest", "water", "sediment") + ) +}) diff --git a/tests/testthat/test-read_VECT.R b/tests/testthat/test-read_VECT.R new file mode 100644 index 0000000..e599db0 --- /dev/null +++ b/tests/testthat/test-read_VECT.R @@ -0,0 +1,68 @@ +library(testthat) +library(terra) +source("helper.R") + +# setup (share grass session across tests) +testdata <- download_nc_basic() +gisBase <- get_gisbase() + +# test basic read_VECT operation +test_that("testing read_VECT", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + if (!is.null(gisBase)) { + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + } + + # test basic read/write (using grass gdal driver, misses epsg code) + schs <- read_VECT("schools") + expect_s4_class(schs, "SpatVector") + # expect_equal(crs(schs, describe = TRUE)$code, NA_character_) + + # expect failute when using gdal driver (not using grass driver) + schs2 <- read_VECT("schools", use_gdal_grass_driver = FALSE) + expect_s4_class(schs, "SpatVector") + # expect_equal(crs(schs, describe = TRUE)$code, "3358") +}) + +test_that("testing write_VECT", { + shp <- vect(system.file("ex/lux.shp", package = "terra")) + elev <- rast(system.file("ex/elev.tif", package = "terra")) + + loc <- initGRASS(gisBase = gisBase, SG = elev, override = TRUE) + write_VECT(shp, "lux") + + lux <- read_VECT("lux") + expect_s4_class(lux, "SpatVector") + expect_equal(nrow(lux), nrow(shp)) + expect_equal(ncol(lux) - 1, ncol(shp)) + expect_setequal(names(lux), c("cat", names(shp))) + + grass_colummns <- vColumns("lux")[, 2] + expect_setequal(grass_colummns, c("cat", names(shp))) +}) + +# test basic vect2neigh operation +test_that("testing vect2neigh", { + skip_if_not(!is.null(gisBase), "GRASS GIS not found on PATH") + + if (!is.null(gisBase)) { + loc <- initGRASS( + gisBase = gisBase, + gisDbase = testdata$gisDbase, + location = "nc_basic_spm_grass7", + mapset = "PERMANENT", + override = TRUE + ) + } + + cen_neig <- vect2neigh("census", ignore.stderr = TRUE) + expect_s3_class(cen_neig, c("data.frame", "GRASSneigh", "spatial.neighbour")) + expect_equal(names(cen_neig), c("left", "right", "length")) +})