r - 不会中止的自定义 R 重启功能

Question

是如何muffleWarning实施的invokeRestart("muffleWarning")？我问是因为在以下代码中：

e <-expression({
  warning("Step 1",immediate.=TRUE)
  warning("Step 2",immediate.=TRUE)
})

r <- withRestarts(withCallingHandlers(eval(e)
                                      ,warning=function(co){
                                        print(co) #1
                                        invokeRestart("mymuffleWarn",co)
                                      })
                  , mymuffleWarn=function(co) print(conditionMessage(co)))

我得到了第一个警告的输出（来自#1）。但是，如果我替换mymufflewarn为muffleWarning（在invokeRestart）中，所有print(co)输出都会出现。

谢谢

Answer 1

Grepping the R source code reveals this:

.signalSimpleWarning <- function(msg, call)
    withRestarts({
           .Internal(.signalCondition(simpleWarning(msg, call), msg, call))
           .Internal(.dfltWarn(msg, call))
        }, muffleWarning = function() NULL)

which is be called from

static void vsignalWarning(SEXP call, const char *format, va_list ap)
{
    char buf[BUFSIZE];
    SEXP hooksym, hcall, qcall;

    hooksym = install(".signalSimpleWarning");
    if (SYMVALUE(hooksym) != R_UnboundValue &&
        SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {
        PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));
        PROTECT(hcall = LCONS(qcall, R_NilValue));
        Rvsnprintf(buf, BUFSIZE - 1, format, ap);
        hcall = LCONS(mkString(buf), hcall);
        PROTECT(hcall = LCONS(hooksym, hcall));
        eval(hcall, R_GlobalEnv);
        UNPROTECT(3);
    }
    else vwarningcall_dflt(call, format, ap);
}

which is called from

void warningcall(SEXP call, const char *format, ...)
{
    va_list(ap);
    va_start(ap, format);
    vsignalWarning(call, format, ap);
    va_end(ap);
}

That function is used to generate warnings in C code, and is also called from do_warning which is the C function that backs warning().

So the muffleWarning handler is always available whenever a warning is raised.