Add neasted calling of withMadratLogging with different parameters and add warningsAsErrors parameter

R/downloadSource.R

@@ -122,9 +122,7 @@ downloadSource <- function(type, subtype = NULL, overwrite = FALSE, numberOfTrie
   with_dir(downloadInProgressDirectory, {
     setWrapperActive("wrapperChecks")
     # convert warnings to errors, because in download functions warnings usually mean data was not downloaded properly
-    withr::with_options(c(warn = 2), {
-      meta <- withMadratLogging(eval(parse(text = functionCall)), logOnly = FALSE)
-    })
+    meta <- withMadratLogging(eval(parse(text = functionCall)), logOnly = FALSE, warningsAsErrors = TRUE)
     setWrapperInactive("wrapperChecks")
 
     # define mandatory elements of meta data and check if they exist

R/withMadratLogging.R

@@ -6,7 +6,10 @@
 #'
 #'
 #' @param expr expression to be evaluated.
-#' @param logOnly passed to vcat, determines if warning/error is thrown after logging
+#' @param logOnly passed to vcat, determines if warning/error is thrown after logging.
+#'   If omitted in a nested call, the enclosing logging policy is inherited.
+#' @param warningsAsErrors whether warnings should be logged and handled as errors.
+#'   If omitted in a nested call, the enclosing logging policy is inherited.
 #' @author Jan Philipp Dietrich
 #' @seealso \code{\link{vcat}}
 #' @keywords internal
@@ -15,7 +18,15 @@
 #' madrat:::withMadratLogging(message("Hello world!"))
 #' }
 #'
-withMadratLogging <- function(expr, logOnly = TRUE) {
+withMadratLogging <- function(expr, logOnly = TRUE, warningsAsErrors = FALSE) {
+  loggingPolicy <- getOption(
+    "madrat_loggingPolicy",
+    list(logOnly = TRUE, warningsAsErrors = FALSE)
+  )
+  if (!missing(logOnly)) loggingPolicy$logOnly <- logOnly
+  if (!missing(warningsAsErrors)) loggingPolicy$warningsAsErrors <- warningsAsErrors
+  withr::local_options(madrat_loggingPolicy = loggingPolicy)
+
   if (isWrapperActive("callingHandler")) {
     return(expr)
   }
@@ -27,11 +38,14 @@ withMadratLogging <- function(expr, logOnly = TRUE) {
   }
 
   warningHandler <- function(w) {
-    vcat(0, w$message, logOnly = logOnly)
+    loggingPolicy <- getOption("madrat_loggingPolicy")
+    verbosity <- ifelse(loggingPolicy$warningsAsErrors, -1, 0)
+    vcat(verbosity, w$message, logOnly = loggingPolicy$logOnly)
   }
 
   errorHandler <- function(w) {
-    vcat(-1, w$message, logOnly = logOnly)
+    loggingPolicy <- getOption("madrat_loggingPolicy")
+    vcat(-1, w$message, logOnly = loggingPolicy$logOnly)
   }
 
   setWrapperActive("callingHandler")

tests/testthat/test-vcat-withMadratLogging.R

@@ -22,6 +22,42 @@ test_that("withMadratLogging properly logs warnings", {
   }
 })
 
+test_that("withMadratLogging can treat warnings as errors", {
+  warningMessage <- "This warning is an error"
+  expect_error(
+    expect_message(
+      withMadratLogging(warning(warningMessage), logOnly = FALSE, warningsAsErrors = TRUE),
+      paste0("^ERROR: ", warningMessage, "\n$")
+    ),
+    warningMessage,
+    fixed = TRUE
+  )
+})
+
+test_that("nested withMadratLogging calls inherit and can override policies", {
+  inheritedWarning <- "This warning inherits the outer policy"
+  expect_error(
+    withMadratLogging(
+      withMadratLogging(warning(inheritedWarning)),
+      logOnly = FALSE,
+      warningsAsErrors = TRUE
+    ),
+    inheritedWarning,
+    fixed = TRUE
+  )
+
+  overriddenWarning <- "This warning overrides the outer policy"
+  expect_warning(
+    withMadratLogging(
+      withMadratLogging(warning(overriddenWarning), logOnly = TRUE, warningsAsErrors = FALSE),
+      logOnly = FALSE,
+      warningsAsErrors = TRUE
+    ),
+    overriddenWarning,
+    fixed = TRUE
+  )
+})
+
 test_that("withMadratLogging properly logs messages", {
   m <- "This is a message"
   mExp <- paste0("^NOTE: ", m, "\n$")