Merge pull request #197 from r-spatial/tests_newer_qgis

Fix + test for optionally detecting and proposing newer QGIS (win/mac)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: qgisprocess
 Title: Use 'QGIS' Processing Algorithms
-Version: 0.2.0.9001
+Version: 0.2.0.9002
 Authors@R: c(
     person("Dewey", "Dunnington", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0002-9415-4582", affiliation = "Voltron Data")),

NEWS.md

@@ -1,6 +1,7 @@
 # qgisprocess (development version)
 
 - More consistent and intuitive handling of JSON input / output user settings (#195, #196; see `?qgis_using_json_output`).
+- Fix bug in support for environment variable `R_QGISPROCESS_DETECT_NEWER_QGIS` (#197).
 
 # qgisprocess 0.2.0
 

R/qgis-configure.R

@@ -145,8 +145,9 @@ qgis_configure <- function(quiet = FALSE, use_cached_data = FALSE) {
 
           # CACHE CONDITION: qgis_process is indeed available in the cached path
 
+          testopt <- getOption("qgisprocess.test_skip_path_availability_check")
           outcome <- try(qgis_run(path = cached_data$path), silent = TRUE)
-          if (inherits(outcome, "try-error")) {
+          if (inherits(outcome, "try-error") && !isTRUE(testopt)) {
             if (quiet) packageStartupMessage()
             packageStartupMessage(
               glue(
@@ -162,31 +163,24 @@ qgis_configure <- function(quiet = FALSE, use_cached_data = FALSE) {
           # environment variable/option to automatically switch to a newer
           # available QGIS version
           if (is_windows() || is_macos()) {
-            opt <- getOption(
-              "qgisprocess.detect_newer_qgis",
-              Sys.getenv("R_QGISPROCESS_DETECT_NEWER_QGIS")
+            opt <- resolve_flag_opt(
+              option_name = "qgisprocess.detect_newer_qgis",
+              envvar_name = "R_QGISPROCESS_DETECT_NEWER_QGIS"
             )
-            assert_that(
-              assertthat::is.flag(opt) ||
-                (assertthat::is.string(opt) && opt %in% c("", "TRUE", "FALSE", "true", "false")),
-              msg = "Option 'qgisprocess.detect_newer_qgis' must be 'TRUE' or 'FALSE'."
-            )
-            if (identical(opt, "")) opt <- NA
-            opt || grepl("TRUE|true", opt)
-
             first_qgis <- qgis_detect_paths()[1]
             newer_available <- !is.na(extract_version_from_paths(first_qgis)) &&
               !identical(cached_data$path, first_qgis)
 
-            if (isTRUE(opt) && isTRUE(newer_available) && interactive()) {
+            if (opt && isTRUE(newer_available) && rlang::is_interactive()) {
               packageStartupMessage()
               packageStartupMessage(glue(
                 "A newer QGIS installation seems to be available: ",
                 "{extract_version_from_paths(first_qgis)}."
               ))
               answer <- ""
               while (!grepl("^[Yy](?:[Ee][Ss])?$|^[Nn](?:[Oo])?$", answer)) {
-                answer <- readline("Do you want to try it and rebuild the cache? (y/n) ")
+                answer <- getOption("qgisprocess.test_try_new_qgis") %||%
+                  readline("Do you want to try it and rebuild the cache? (y/n) ")
               }
               if (grepl("^[Yy]", answer)) {
                 newer_ok <- FALSE

R/qgis-help.R

@@ -227,7 +227,7 @@ qgis_using_cached_help <- function() {
     Sys.getenv("R_QGISPROCESS_USE_CACHED_HELP", "true")
   )
 
-  isTRUE(opt) || identical(opt, "true") || identical(opt, "TRUE")
+  resolve_flag_opt(opt)
 }
 
 help_cache_file <- function(algorithm, json) {

R/qgis-state.R

@@ -317,7 +317,7 @@ qgis_using_json_input <- function() {
       !is.null(qgis_version()) &&
       (package_version(qgis_version(full = FALSE)) >= "3.23.0")
   } else {
-    json_input_is_set <- isTRUE(opt) || identical(opt, "true") || identical(opt, "TRUE")
+    json_input_is_set <- resolve_flag_opt(opt)
     if (
       json_input_is_set &&
         !is.null(qgis_version()) &&
@@ -395,6 +395,55 @@ readopt <- function(option_name, envvar_name) {
 }
 
 
+
+#' Resolve a boolean option or environmental variable to TRUE, FALSE or (optionally) NA
+#'
+#' @param value A result as obtained by [readopt()].
+#' @param keep_NA Return NA if option and env var are empty?
+#' (i.e. `NULL` and `""` respectively).
+#' The default (`FALSE`) will return `FALSE`.
+#'
+#' @noRd
+#'
+#' @keywords internal
+resolve_flag_opt <- function(
+    value = readopt(option_name, envvar_name),
+    option_name = NULL,
+    envvar_name = NULL,
+    keep_NA = FALSE
+    ) {
+  if (missing(value)) {
+    assert_that(
+      !missing(option_name),
+      !missing(envvar_name),
+      msg = paste(
+        "Both 'option_name' and 'envvar_name' must be provided if",
+        "'value' is missing."
+      )
+    )
+  }
+  if (!missing(option_name)) assert_that(is.string(option_name))
+  if (!missing(envvar_name)) assert_that(is.string(envvar_name))
+  assert_that(is.flag(keep_NA))
+  opt <- value
+  assert_that(
+    is.flag(opt) ||
+      (is.string(opt) && opt %in% c("", "TRUE", "FALSE", "true", "false")),
+    msg = glue("Option '{option_name %||% \"\"}' must be 'TRUE' or 'FALSE'.")
+  )
+  if (keep_NA) {
+    if (identical(opt, "")) opt <- NA
+    is.logical(opt) && length(opt) == 1 && opt
+  } else {
+    isTRUE(opt)
+  } ||
+    identical(opt, "true") ||
+    identical(opt, "TRUE")
+}
+
+
+
+
 #' Handle an explicitly set 'use_json_output'
 #'
 #' The `qgisprocess.use_json_output` option or the
@@ -416,9 +465,7 @@ readopt <- function(option_name, envvar_name) {
 #' @noRd
 #' @keywords internal
 resolve_explicit_json_output <- function(json_output_setting, qgis_version) {
-  json_output_is_set <- isTRUE(json_output_setting) ||
-    identical(json_output_setting, "true") ||
-    identical(json_output_setting, "TRUE")
+  json_output_is_set <- resolve_flag_opt(json_output_setting)
   # with JSON INput EXPLICITLY set as TRUE, always use JSON output if the
   # version requirement is met (it is how 'qgis_process run' works, so
   # better do that throughout the package)
@@ -442,9 +489,7 @@ resolve_explicit_json_output <- function(json_output_setting, qgis_version) {
 #' @keywords internal
 json_input_set_and_acceptable <- function(qgis_version) {
   opt_json_input <- readopt_json_input()
-  (isTRUE(opt_json_input) ||
-    identical(opt_json_input, "true") ||
-    identical(opt_json_input, "TRUE")) &&
+  resolve_flag_opt(opt_json_input) &&
     !is.null(qgis_version) &&
     package_version(qgis_version) >= "3.23.0"
 }

tests/testthat/test-qgis-configure.R

@@ -262,6 +262,134 @@ test_that("qgis_configure() works OK if cache condition 'use_json_output' unmet"
 
 
 
+test_that("qgis_configure() works OK with qgisprocess.detect_newer_qgis option or envvar", {
+  skip_if_not(has_qgis())
+  skip_if_not(is_windows() || is_macos())
+  version <- as.character(utils::packageVersion("qgisprocess"))
+  cache_data_file <- file.path(
+    rappdirs::user_cache_dir("R-qgisprocess"),
+    glue("cache-{version}.rds")
+  )
+  rlang::local_interactive()
+  withr::local_options(list(
+    qgisprocess.test_skip_path_availability_check = TRUE,
+    qgisprocess.detect_newer_qgis = TRUE
+  ))
+  local_mocked_bindings(
+    qgis_detect_paths = function(...) c(
+      "C:/Program Files/QGIS 3.30.0/bin/qgis_process-qgis-ltr.bat",
+      "C:/Program Files/QGIS 3.28.6/bin/qgis_process-qgis-ltr.bat"
+    )
+  )
+  withr::defer(
+    saveRDS(
+      list(
+        path = qgis_path(),
+        version = qgis_version(),
+        algorithms = qgis_algorithms(),
+        plugins = qgis_plugins(),
+        use_json_output = qgis_using_json_output()
+      ),
+      cache_data_file
+    )
+  )
+
+  # answering 'yes' triggers reconfiguration with newer version
+  withr::local_options(qgisprocess.test_try_new_qgis = "yes")
+  saveRDS(
+    list(
+      path = "C:/Program Files/QGIS 3.28.6/bin/qgis_process-qgis-ltr.bat",
+      version = "3.28.6-xxx",
+      algorithms = qgis_algorithms(),
+      plugins = qgis_plugins(),
+      use_json_output = qgis_using_json_output()
+    ),
+    cache_data_file
+  )
+  expect_message(
+    capture.output(qgis_configure(use_cached_data = TRUE), type = "message"),
+    "A newer QGIS installation seems to be"
+  )
+
+  # answering 'no' triggers another message
+  withr::local_options(qgisprocess.test_try_new_qgis = "no")
+  saveRDS(
+    list(
+      path = "C:/Program Files/QGIS 3.28.6/bin/qgis_process-qgis-ltr.bat",
+      version = "3.28.6-xxx",
+      algorithms = qgis_algorithms(),
+      plugins = qgis_plugins(),
+      use_json_output = qgis_using_json_output()
+    ),
+    cache_data_file
+  )
+  expect_message(
+    capture.output(qgis_configure(use_cached_data = TRUE), type = "message"),
+    "if you don't want to autodetect QGIS version updates"
+  )
+
+  # with newest version in place: not offering to switch
+  withr::local_options(qgisprocess.test_try_new_qgis = "yes")
+  saveRDS(
+    list(
+      path = "C:/Program Files/QGIS 3.30.0/bin/qgis_process-qgis-ltr.bat",
+      version = "3.30.0-xxx",
+      algorithms = qgis_algorithms(),
+      plugins = qgis_plugins(),
+      use_json_output = qgis_using_json_output()
+    ),
+    cache_data_file
+  )
+  expect_no_message(
+    capture.output(qgis_configure(use_cached_data = TRUE), type = "message"),
+    message = "A newer QGIS installation seems to be"
+  )
+
+  # without the option: not offering to switch
+  withr::local_options(list(
+    qgisprocess.detect_newer_qgis = NULL,
+    qgisprocess.test_try_new_qgis = "yes"
+  ))
+  saveRDS(
+    list(
+      path = "C:/Program Files/QGIS 3.28.6/bin/qgis_process-qgis-ltr.bat",
+      version = "3.28.6-xxx",
+      algorithms = qgis_algorithms(),
+      plugins = qgis_plugins(),
+      use_json_output = qgis_using_json_output()
+    ),
+    cache_data_file
+  )
+  expect_no_message(
+    capture.output(qgis_configure(use_cached_data = TRUE), type = "message"),
+    message = "A newer QGIS installation seems to be"
+  )
+
+  # when not interactive: not offering to switch
+  rlang::local_interactive(value = FALSE)
+  withr::local_options(list(
+    qgisprocess.detect_newer_qgis = TRUE,
+    qgisprocess.test_try_new_qgis = "yes"
+  ))
+  saveRDS(
+    list(
+      path = "C:/Program Files/QGIS 3.28.6/bin/qgis_process-qgis-ltr.bat",
+      version = "3.28.6-xxx",
+      algorithms = qgis_algorithms(),
+      plugins = qgis_plugins(),
+      use_json_output = qgis_using_json_output()
+    ),
+    cache_data_file
+  )
+  expect_no_message(
+    capture.output(qgis_configure(use_cached_data = TRUE), type = "message"),
+    message = "A newer QGIS installation seems to be"
+  )
+})
+
+
+
+
 test_that("abort_query_version() works", {
   lines <- c("aa", "bb")
   expect_error(

tests/testthat/test-qgis-state.R

@@ -146,3 +146,62 @@ test_that("Internal function debug_json() works", {
   expect_no_error(debug_json())
   expect_s3_class(debug_json(), "glue")
 })
+
+
+
+
+
+
+test_that("Internal function resolve_flag_opt() works", {
+  expect_true(resolve_flag_opt(TRUE))
+  expect_true(resolve_flag_opt("TRUE"))
+  expect_true(resolve_flag_opt("true"))
+  expect_false(resolve_flag_opt(""))
+  expect_false(resolve_flag_opt(FALSE))
+  expect_false(resolve_flag_opt("FALSE"))
+  expect_false(resolve_flag_opt("false"))
+  expect_identical(resolve_flag_opt("", keep_NA = TRUE), NA)
+  expect_identical(resolve_flag_opt(NA, keep_NA = TRUE), NA)
+  expect_error(resolve_flag_opt(NULL, keep_NA = TRUE), "must be")
+  expect_error(resolve_flag_opt("maybe"), "must be")
+  expect_error(resolve_flag_opt(c(TRUE, TRUE)), "must be")
+
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  expect_identical(
+    resolve_flag_opt(
+      option_name = "test_option",
+      envvar_name = "TEST_VAR",
+      keep_NA = TRUE
+    ),
+    NA
+  )
+
+  expect_error(resolve_flag_opt(option_name = "test_option"), "Both")
+  expect_error(resolve_flag_opt(envvar_name = "TEST_VAR"), "Both")
+
+  withr::local_options(test_option = TRUE)
+  expect_true(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  expect_error(resolve_flag_opt(option_name = "test_option"), "Both")
+  withr::local_options(test_option = "TRUE")
+  expect_true(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_options(test_option = FALSE)
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_options(test_option = "FALSE")
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_options(test_option = 3)
+  expect_error(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_options(test_option = NULL)
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+
+  withr::local_envvar(TEST_VAR = "TRUE")
+  expect_true(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  expect_error(resolve_flag_opt(envvar_name = "TEST_VAR"), "Both")
+  withr::local_envvar(TEST_VAR = "true")
+  expect_true(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_envvar(TEST_VAR = "FALSE")
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_envvar(TEST_VAR = "false")
+  expect_false(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+  withr::local_envvar(TEST_VAR = "3")
+  expect_error(resolve_flag_opt(option_name = "test_option", envvar_name = "TEST_VAR"))
+})