Check existence of restarts before invokation

NEWS.md

@@ -1,6 +1,10 @@
 
 # testthat (development version)
 
+* Existence of restarts is first checked before invokation. This makes
+  it possible to signal warnings or messages with a different
+  condition signaller (#874).
+
 * Unexpected errors are now printed with a simplified backtrace.
 
 * `expect_error()` and `expect_condition()` now display a backtrace

R/capture-condition.R

@@ -81,7 +81,7 @@ capture_messages <- function(code) {
     code,
     message = function(condition) {
       out$push(condition)
-      invokeRestart("muffleMessage")
+      maybe_restart("muffleMessage")
     }
   )
 
@@ -97,7 +97,7 @@ capture_warnings <- function(code) {
     code,
     warning = function(condition) {
       out$push(condition)
-      invokeRestart("muffleWarning")
+      maybe_restart("muffleWarning")
     }
   )
 

R/evaluate-promise.R

@@ -19,13 +19,13 @@ evaluate_promise <- function(code, print = FALSE) {
   warnings <- Stack$new()
   handle_warning <- function(condition) {
     warnings$push(condition)
-    invokeRestart("muffleWarning")
+    maybe_restart("muffleWarning")
   }
 
   messages <- Stack$new()
   handle_message <- function(condition) {
     messages$push(condition)
-    invokeRestart("muffleMessage")
+    maybe_restart("muffleMessage")
   }
 
   temp <- file()

R/test-that.R

@@ -123,11 +123,12 @@ test_code <- function(test, code, env = test_env(), skip_on_empty = TRUE) {
 
     handled <<- TRUE
     register_expectation(e, 5)
-    invokeRestart("muffleWarning")
+
+    maybe_restart("muffleWarning")
   }
   handle_message <- function(e) {
     handled <<- TRUE
-    invokeRestart("muffleMessage")
+    maybe_restart("muffleMessage")
   }
   handle_skip <- function(e) {
     handled <<- TRUE

R/try-again.R

@@ -23,7 +23,7 @@ try_again <- function(times, code) {
         },
         warning = function(e) {
           if (identical(e$message, "restarting interrupted promise evaluation")) {
-            invokeRestart("muffleWarning")
+            maybe_restart("muffleWarning")
           }
         }
       ),

R/utils.R

@@ -104,3 +104,9 @@ paste_line <- function(...) {
 maybe_root_dir <- function(path) {
   tryCatch(pkgload::pkg_path(path), error = function(...) path)
 }
+
+maybe_restart <- function(restart) {
+  if (!is.null(findRestart(restart))) {
+    invokeRestart(restart)
+  }
+}

tests/testthat/test-test-that.R

@@ -132,3 +132,10 @@ test_that("line numbers captured for stop()s", {
   })
   expect_equal(lines, 2)
 })
+
+test_that("can signal warnings and messages without restart", {
+  expect_null(signalCondition(message_cnd("foo")))
+
+  return("Skipping following test because it verbosely registers the warning")
+  expect_null(signalCondition(warning_cnd("foo")))
+})