warning.expression阻止last.warning更新

时间:2018-01-03 05:34:58

标签: r

我有兴趣尝试在没有围绕方法创建支持基础结构的情况下在上调用警告。也就是说,我需要能够捕获警告,而无需使用包装代码:

tryCatch(..., warning = function() { action() } )

我相信我可以使用warning.expression处理程序执行此操作。

但是,我遇到的问题是last.warning在警告调度warning.expression期间调用时无法检索到最新警告。

例如:

warning_handler = function() {
  if (exists("last.warning", baseenv()) &&
      !is.null(last.warning)) {
    warning_contents =  names(last.warning)
  } else {
    warning_contents =  NA
  }

  message(warning_contents)
}


options(warning.expression = quote({ warning_handler() }))

warning("test1")
# test1
warning("testing2")
# test1
warning("sampletest3")
# test1

如果我恢复使用默认处理程序,例如NULL,然后更新消息,代价是无法与之交互。

options(warning.expression = NULL)

warning("test1")
# Warning message:
# test1
warning("testing2")
# Warning message:
# testing2
warning("sampletest3")
# Warning message:
# sampletest3

我是否遗漏了与处理程序相关的内容或?

2 个答案:

答案 0 :(得分:2)

添加warning.expression几乎肯定会干扰警告收集机制。我不是100%肯定这一点,但如果你看(R.3.4.0,我有一份旧的资料副本),你可以在errors.c@335看到:

static void vwarningcall_dflt(SEXP call, const char *format, va_list ap)
{
    int w;
    SEXP names, s;
    const char *dcall;
    char buf[BUFSIZE];
    RCNTXT *cptr;
    RCNTXT cntxt;

    if (inWarning)
        return;

    s = GetOption1(install("warning.expression"));
    if( s != R_NilValue ) {
        if( !isLanguage(s) &&  ! isExpression(s) )
            error(_("invalid option \"warning.expression\""));
        cptr = R_GlobalContext;
        while ( !(cptr->callflag & CTXT_FUNCTION) && cptr->callflag )
            cptr = cptr->nextcontext;
        eval(s, cptr->cloenv);
        return;
    }
  // ... snip ...


    else if(w == 0) {   /* collect them */
        if(!R_CollectWarnings) setupwarnings();
        if(R_CollectWarnings < R_nwarnings) {
            SET_VECTOR_ELT(R_Warnings, R_CollectWarnings, call);
            Rvsnprintf(buf, min(BUFSIZE, R_WarnLength+1), format, ap);
  // ... snip ...
}

因此return之后的部分不会运行。

last.value看起来像printWarnings在errors.c@466中填充,所以这可能发生在warning.expressions处理程序之后,或者更可能发生在<{1}}之后:

attribute_hidden
void PrintWarnings(void)
{
  // ... snip to very end of fun ...

    /* now truncate and install last.warning */
    PROTECT(s = allocVector(VECSXP, R_CollectWarnings));
    PROTECT(t = allocVector(STRSXP, R_CollectWarnings));
    names = CAR(ATTRIB(R_Warnings));
    for(i = 0; i < R_CollectWarnings; i++) {
        SET_VECTOR_ELT(s, i, VECTOR_ELT(R_Warnings, i));
        SET_STRING_ELT(t, i, STRING_ELT(names, i));
    }
    setAttrib(s, R_NamesSymbol, t);
    SET_SYMVALUE(install("last.warning"), s);
    UNPROTECT(2);

    endcontext(&cntxt);

    inPrintWarnings = 0;
    R_CollectWarnings = 0;
    R_Warnings = R_NilValue;
    return;
}

所以很可能发生了什么。我还没有完成流程模式,所以我可能错了。如果我是对的,似乎没有办法从warning.expression获取警告信息。

除此之外,请注意last.warning被记录为未记录,FWIW。

答案 1 :(得分:0)

chat中@lionel提供的另一个答案是:在顶级安装警告处理程序,您可以通过使用.Internal()

调用内部函数来执行此操作
handlers <- list(warning = function(cnd) cat("hello\n")) 
classes <- names(handlers) 
.Internal(.addCondHands(classes, handlers, globalenv(), NULL, TRUE)) 

warn("plop")

这种方法的唯一缺点是CRAN会因内部呼叫而拒绝提交的包裹。