Turn a specific warning to an error or debug about debugverse HOT 2 OPEN

debug_warning <- function(pattern = NULL, class = NULL) {
  code <- '`*tmp_warning*` <- function (..., call. = TRUE, immediate. = FALSE, noBreaks. = FALSE, domain = NULL) {
    if (...length() == 1L && inherits(..1, "condition")) {
      if ((is.null(CLASS) || inherits(..1, CLASS)) && (is.null(PATTERN) || grepl(PATTERN , ..1))) {
        called_by_rlang_warn <- !is.null(call <- sys.call(-1)) && is.call(call) && (
          identical(call[[1]], quote(warn)) || identical(call[[1]], quote(rlang::warn))
        )
        env <- if (called_by_rlang_warn) parent.frame(2) else parent.frame()
        on.exit(eval(quote(browser()), env), add = TRUE)
      }
      cond <- ..1
      if (nargs() > 1L)
        cat(gettext("additional arguments ignored in warning()"),
            "\n", sep = "", file = stderr())
      message <- conditionMessage(cond)
      call <- conditionCall(cond)
      withRestarts({
        .Internal(.signalCondition(cond, message, call))
        .Internal(.dfltWarn(message, call))
      }, muffleWarning = function() NULL)
      invisible(message)
    }
    else {
      if (is.null(PATTERN) || grepl(PATTERN , paste(c(...), collapse = ""))) {
        called_by_rlang_warn <- !is.null(call <- sys.call(-1)) && is.call(call) && (
          identical(call[[1]], quote(warn)) || identical(call[[1]], quote(rlang::warn))
        )
        env <- if (called_by_rlang_warn) parent.frame(2) else parent.frame()
        on.exit(eval(quote(browser()), env), add = TRUE)
      }
      .Internal(warning(call., immediate., noBreaks., .makeMessage(..., domain = domain)))
    }
  }
  unlockBinding("warning", baseenv())
  assign("warning", value = `*tmp_warning*`, envir = baseenv())
  lockBinding("warning", baseenv())
  #rm(`*tmp_warning*`)
  '
  code <- gsub("PATTERN", deparse(pattern), code)
  code <- gsub("CLASS", deparse(class), code)
  con <- textConnection(code)
  source(con, .GlobalEnv)
}

test <- function() {
  foo <- 1
  print(foo)
  warning("some warning")
  foo <- foo + 1
  print(foo)
  rlang::warn("other warning", "foo")
  foo
}

test()