从父函数抛出错误（忽略子函数）

Question

前提

我正在设计一个自定义 R 函数（称之为 oedipus()）以错误终止其父函数。现在很明显，在 oedipus() 内对 stop() 的简单调用将满足该要求：

oedipus <- function() { stop("Ow, my eyes!") } laius <- function() { oedipus() } laius() #> Error in oedipus() : Ow, my eyes! #> #> 3. stop("Ow, my eyes!") #> 2. oedipus() #> 1. laius()

扭曲

但是，我希望错误看起来像是 源自父级 ，而不是从调用堆栈中记录存在的子级“冒出来”。也就是说，我希望错误归因于 laius() 像这样

laius() #> Error in laius() : Ow, my eyes!

理想情况下，我希望 oedipus() 从调用堆栈中完全省略：

laius() #> Error in laius() : Ow, my eyes! #> #> 2. stop("Ow, my eyes!") #> 1. laius()

理论上是否可以设计这样一个...COMPLEX oedipus() 函数？

也许 oedipus() 可以用 evalq() 和 on.exit() 修改 laius()，这样 laius() 将在它“死”之前修改调用堆栈转?

奖金

是否可以设计 oedipus() 使其可以从调用堆栈中的任意（第 n 个）“祖先”抛出错误？

oedipus <- function(n) { # ... # ? # ... } laius <- function(...) { oedipus(...) } labdacus <- function(...) { laius(...) } polydorus <- function(...) { labdacus(...) } polydorus(0) #> Error in oedipus(...) : Ow, my eyes! polydorus(1) #> Error in laius(...) : Ow, my eyes! polydorus(2) #> Error in labdacus(...) : Ow, my eyes! polydorus(3) #> Error in polydorus(3) : Ow, my eyes!

Answer 1

这是一个自定义函数 oedipus()，它利用 rlang 来定位给定的 nth 祖先。

解决方案

该方法的关键是使用 do.call() to "inject" a stop() call as an "error thrower" at the front of the ancestor's on.exit() "queue"; and then the use of rlang::return_from() 让祖先立即触发错误抛出器。

注意：为了稳定性，oedipus()旨在保留其祖先的“退出队列”。

oedipus <- function(n) {
  # Target the ancestor from which the error should be thrown.
  from_env <- rlang::caller_env(n = n)
  # Construct the error thrower.
  from_err <- rlang::expr(stop("Ow, my eyes!"))
  
  # Inject the error thrower into the ancestor's exit queue.
  do.call(
    what = on.exit,
    args = list(
      expr = from_err,
      # Preserve the existing exit queue...
      add = TRUE,
      # ...while injecting the thrower at the front; so the error occurs
      # immediately and is followed by the rest of the queue, just as if
      # 'stop()' had been called in the middle of the ancestor's body.
      after = FALSE
    ),
    quote = FALSE,
    envir = from_env
  )
  
  # Immediately return from that function (with an inert value), and so
  # trigger the error thrower.
  rlang::return_from(
    frame = from_env,
    value = rlang::expr(invisible(NULL))
  )
}

结果

简单

祖先定义在您问题的 Twist 部分

laius <- function(...) {
  oedipus(...)
}

labdacus <- function(...) {
  laius(...)
}

polydorus <- function(...) {
  labdacus(...)
}

然后 oedipus() 将产生您想要的结果：

polydorus(0)
#> Error in oedipus(...) : Ow, my eyes! 

polydorus(1)
#> Error in laius(...) : Ow, my eyes!

polydorus(2)
#> Error in labdacus(...) : Ow, my eyes! 

polydorus(3)
#> Error in polydorus(3) : Ow, my eyes!

详细

为了便于说明，让 oedipus() 的祖先重新定义为“退出队列”，如下所示：


laius <- function(...) {
  # Test that the exit queue behaves normally.
  on.exit(cat("'laius()' should display this message on exit.\n"))
  
  oedipus(...)
}

labdacus <- function(...) {
  # Test that the exit queue behaves normally.
  on.exit(cat("'labdacus()' should display this message on exit.\n"))
  
  laius(...)
}

polydorus <- function(...) {
  # Test that the exit queue behaves normally.
  on.exit(cat("'polydorus()' should display this message on exit.\n"))
  
  labdacus(...)
}

然后 oedipus() 应该会产生以下结果，并显示回溯：

polydorus(0)
#> Error in oedipus(...) : Ow, my eyes!
#> 
#>   5. stop("Ow, my eyes!")
#>   4. oedipus(...)
#>   3. laius(...)
#>   2. labdacus(...)
#>   1. polydorus(0)
#> 
#> 'laius()' should display this message on exit.
#> 'labdacus()' should display this message on exit.
#> 'polydorus()' should display this message on exit.


polydorus(1)
#> Error in laius(...) : Ow, my eyes!
#> 
#>   4. stop("Ow, my eyes!")
#>   3. laius(...)
#>   2. labdacus(...)
#>   1. polydorus(1)
#> 
#> 'laius()' should display this message on exit.
#> 'labdacus()' should display this message on exit.
#> 'polydorus()' should display this message on exit.


polydorus(2)
#> Error in labdacus(...) : Ow, my eyes!
#>   
#>   3. stop("Ow, my eyes!")
#>   2. labdacus(...)
#>   1. polydorus(2)
#> 
#> 'labdacus()' should display this message on exit.
#> 'polydorus()' should display this message on exit.

 
polydorus(3)
#> Error in polydorus(3) : Ow, my eyes!
#> 
#> 'polydorus()' should display this message on exit.

从父函数抛出错误（忽略子函数）

Throw Error From Parent Function (While Ignoring Child)

error-handling

callstack

r

前提

扭曲

奖金

解决方案

结果

简单

详细