r - test_that 与 match.fun 一起使用时，在两级深度时抛出意外错误

Question

我在使用 match.fun 时遇到问题连同test_that当match.fun在嵌套函数中使用。为了说明这一点，我构建了一个包含两个函数的快速玩具示例 R 包。后者简单地调用前者:

i_dont_throw_error <- function(function_name)
  match.fun(function_name)("hello")

i_throw_error <- function(function_name)
  i_dont_throw_error(function_name)

然后我写了 testthat测试如下:

test_that("Testing for an error with match.fun one level deep.",{
  print_function <- function(x)
    print(x)

  expect_equal(i_dont_throw_error("print_function"), "hello")
})

test_that("Testing for an error with match.fun two levels deep.",{
  print_function <- function(x)
    print(x)

  expect_equal(i_throw_error("print_function"), "hello")
})

第一个测试没问题，但第二个测试出现错误。 testthat 的输出是

==> devtools::test()

Loading testthatTest
Loading required package: testthat
Testing testthatTest
[1] "hello"
.1
1. Error: Testing for an error with match.fun two levels deep. -----------------
object 'print_function' of mode 'function' was not found
1: withCallingHandlers(eval(code, new_test_environment), error = capture_calls, message = function(c) invokeRestart("muffleMessage"))
2: eval(code, new_test_environment)
3: eval(expr, envir, enclos)
4: expect_equal(i_throw_error("print_function"), "hello") at test_test_me.R:12
5: expect_that(object, equals(expected, label = expected.label, ...), info = info, label = label)
6: condition(object)
7: compare(actual, expected, ...)
8: i_throw_error("print_function")
9: i_dont_throw_error(function_name) at C:\Users\jowhitne\Desktop\eraseMe\testthatTest/R/test_func.R:4
10: match.fun(function_name) at C:\Users\jowhitne\Desktop\eraseMe\testthatTest/R/test_func.R:1
11: get(as.character(FUN), mode = "function", envir = envir)

我不明白为什么第一个测试通过但第二个测试失败。事实上，直接从控制台运行失败的测试工作得很好:

> print_function <- function(x)
+     print(x)
> i_throw_error("print_function") 
[1] "hello"

我知道这与环境有关，但我希望在 match.fun 之后它会起作用。搜索两个环境。知道我在这里缺少什么吗？在此先感谢您的帮助。

Answer 1

相关问题:

evaluation inside of test_that call

Unit test works as standalone but fails in test_that call

object no found error in testthat tests

我花了几个小时才弄清这个问题的根源。这是一个环境问题，涉及到如何 测试通过 devtools::test() 运行时计算表达式但不是在交互式运行时。

精简版

测试在运行测试时创建许多新环境(以确保不同测试的独立性，从而避免代码交互中的错误)，并且这些环境的继承方式与交互运行时的方式不同。解决方法一般是用 dynGet()找到对象，因为这使用黑魔法来查找对象(也就是说我不明白它是如何工作的)。

长版

我创建了一个新包， 测试包 ，根据您的功能， available here它会复制您的错误。我怀疑是环境问题，因为我过去也遇到过类似的错误，我不得不仔细考虑 get() , parent.frame() , parent.env()等。参见 Hadley's Advanced R 中的环境介绍。 .

不以交互方式运行时调试东西是很困难的。但是 devtools::test()确实将警告打印到控制台，所以我用它作为我提取调试信息的方式。这样做需要我编写一个有点复杂的函数来帮助解决这个问题:

print_envir = function(x, prefix = "", recursive = F, list_objects = T, max_objects = 10, use_names = T, no_attr = T, skip_beyond_global = T) {
  # browser()
  #use names
  if (use_names) {
    env_name_attr = attr(x, "name")
    if (is.null(env_name_attr)) {
      env_name_attr = ""
    } else {
      env_name_attr = sprintf(" (%s)", env_name_attr)
    }
  } else {
    env_name_attr = ""
  }

  #strip attributes?
  if (no_attr) {
    attributes(x) = NULL
  }

  #get name
  env_name = {capture.output(print(x))}

  #get parent env name
  # parent_env_name = {capture.output(print(parent.env(x)))}

  #objects
  if (list_objects) {
    env_objects = names(x)

    #limit
    env_objects = na.omit(env_objects[1:max_objects])

    #explicit none
    if (length(env_objects) == 0) {
      env_objects = "(none)"
    }
  } else {
    env_objects = "(not requested)"
  }


  #issue print as warning so they come thru testthat console
  warning(sprintf("%senvironment `%s`%s with objects: %s",
                  prefix,
                  env_name,
                  env_name_attr,
                  str_c(env_objects, collapse = ", ")
                  ), call. = F)

  #recursive?
  if (recursive) {
    #stop when parent is empty envir
    if (!identical(parent.env(x), emptyenv())) {
      #skip on top of global?
      if (!identical(x, globalenv())) {
        print_envir(parent.env(x), recursive = T, list_objects = list_objects, max_objects = max_objects, use_names = use_names, prefix = prefix, no_attr = no_attr)
      }
    }
  }

  invisible(NULL)
}

该函数的目的基本上是帮助打印有关在查找对象时搜索的环境的格式良好的警告。我不只是使用 print() 的原因是这没有显示在 中的正确位置测试记录但警告。

首先，我将您的函数重命名并修改为:

inner_func1 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)

  match.fun(function_name)("hello")
}

outer_func1 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)
  print_envir(environment(inner_func1), "defining/enclosing ", recursive = T)

  #failing call
  inner_func1(function_name)
}

因此，它现在在您评估它时打印(作为警告)2/3 环境及其父级。 outer_v1 的控制台输出如下所示:

test_functions.R:13: warning: outer_v1
current environment `<environment: 0x397a2a8>` with objects: function_name

test_functions.R:13: warning: outer_v1
current environment `<environment: namespace:test.package>` with objects: print_envir, .__DEVTOOLS__, inner_func1, .packageName, inner_func2, inner_func3, outer_func1, outer_func2, outer_func3, .__NAMESPACE__.

test_functions.R:13: warning: outer_v1
current environment `<environment: 0x23aa1a0>` with objects: library.dynam.unload, system.file

test_functions.R:13: warning: outer_v1
current environment `<environment: namespace:base>` with objects: Sys.Date, c.warnings, as.expression.default, as.POSIXlt.factor, [.hexmode, unique.warnings, dimnames<-, regexpr, !, parse

test_functions.R:13: warning: outer_v1
current environment `<environment: R_GlobalEnv>` with objects: .Random.seed

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: 0x313b150>` with objects: (none)

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: 0x3d25070>` with objects: print_function

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: 0x3cff218>` with objects: (none)

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: 0x370c908>` with objects: (none)

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: namespace:test.package>` with objects: print_envir, .__DEVTOOLS__, inner_func1, .packageName, inner_func2, inner_func3, outer_func1, outer_func2, outer_func3, .__NAMESPACE__.

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: 0x23aa1a0>` with objects: library.dynam.unload, system.file

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: namespace:base>` with objects: Sys.Date, c.warnings, as.expression.default, as.POSIXlt.factor, [.hexmode, unique.warnings, dimnames<-, regexpr, !, parse

test_functions.R:13: warning: outer_v1
parent.frame environment `<environment: R_GlobalEnv>` with objects: .Random.seed

test_functions.R:13: warning: outer_v1
defining/enclosing environment `<environment: namespace:test.package>` with objects: print_envir, .__DEVTOOLS__, inner_func1, .packageName, inner_func2, inner_func3, outer_func1, outer_func2, outer_func3, .__NAMESPACE__.

test_functions.R:13: warning: outer_v1
defining/enclosing environment `<environment: 0x23aa1a0>` with objects: library.dynam.unload, system.file

test_functions.R:13: warning: outer_v1
defining/enclosing environment `<environment: namespace:base>` with objects: Sys.Date, c.warnings, as.expression.default, as.POSIXlt.factor, [.hexmode, unique.warnings, dimnames<-, regexpr, !, parse

test_functions.R:13: warning: outer_v1
defining/enclosing environment `<environment: R_GlobalEnv>` with objects: .Random.seed

(skipped because these are from inner_v1)

test_functions.R:13: error: outer_v1
object 'print_function' of mode 'function' was not found
1: expect_equal(outer_func1("print_function"), "hello") at /4tb/GP/code/test.package/tests/testthat/test_functions.R:13
2: quasi_label(enquo(object), label)
3: eval_bare(get_expr(quo), get_env(quo))
4: outer_func1("print_function")
5: inner_func1(function_name) at /code/test.package/R/functions.R:62
6: match.fun(function_name) at /code/test.package/R/functions.R:7
7: get(as.character(FUN), mode = "function", envir = envir)

这很长，但它分为 4 部分:3 部分与环境的递归打印有关，以及最后发生的错误。环境用函数定义中的前缀标记，因此很容易看到发生了什么。例如。 current environment是当前(在函数调用内部)环境。

遍历三个列表，我们找到了以下路径:

当前:0x397a2a8 (功能环境)> namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv .这些都没有我们想要的对象，即 print_function .

父框架:0x3d25070 (一个空的环境，不知道为什么会在那里)> 0x3d25070 (有我们的目标!)> 0x3cff218 (另一个空环境)> 0x370c908 (又一)> namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv .

定义/封闭:namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv .

定义/封闭和父框架的路径重叠，前者是后者的子集。事实证明，我们的对象在 parent.frame 中，但是向上移动了 2 步。因此，在这种情况下，我们可以使用 get(function_name, envir = parent.frame(n = 2)) 获取函数。 .因此，第二次迭代是:

inner_func2 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)

  #try to get object in current envir
  #if it isnt there, try parent.frame
  if (exists(function_name)) {
    warning(sprintf("%s exists", function_name))
    func = get(function_name)
  } else {
    warning(sprintf("%s does not exist", function_name))
    func = get(function_name, envir = parent.frame(n = 2))
  }

  func("hello")
}

outer_func2 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)
  print_envir(environment(inner_func2), "defining/enclosing ", recursive = T)

  inner_func2(function_name)
}

这仍然可以交互工作，因为我们添加了一个 if 子句，它首先尝试以正常方式找到它，然后如果没有，则尝试 parent.frame(n = 2)道路。

通过 devtools::test() 进行测试我们发现 outer_v2现在可以用了，但我们坏了 inner_v2虽然它以交互方式工作。如果我们检查日志，我们会看到:

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: 0x41f0d78>` with objects: (none)

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: 0x478aa60>` with objects: print_function

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: 0x47546d0>` with objects: (none)

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: 0x4152c20>` with objects: (none)

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: namespace:test.package>` with objects: print_envir, .__DEVTOOLS__, inner_func1, .packageName, inner_func2, inner_func3, outer_func1, outer_func2, outer_func3, .__NAMESPACE__.

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: 0x2df41a0>` with objects: library.dynam.unload, system.file

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: namespace:base>` with objects: Sys.Date, c.warnings, as.expression.default, as.POSIXlt.factor, [.hexmode, unique.warnings, dimnames<-, regexpr, !, parse

test_functions.R:20: warning: inner_v2
parent.frame environment `<environment: R_GlobalEnv>` with objects: .Random.seed

test_functions.R:20: warning: inner_v2
print_function does not exist

test_functions.R:20: error: inner_v2
object 'print_function' not found
1: expect_equal(inner_func2("print_function"), "hello") at /code/test.package/tests/testthat/test_functions.R:20
2: quasi_label(enquo(object), label)
3: eval_bare(get_expr(quo), get_env(quo))
4: inner_func2("print_function")
5: get(function_name, envir = parent.frame(n = 2)) at /code/test.package/R/functions.R:23

所以我们的对象上升了两步，但我们仍然错过了它。如何？好吧，我们称之为 parent.frame(n = 2)来自与以前不同的地方，这改变了一些东西。如果我们将其替换为 parent.frame(n = 1)它再次起作用。

因此，使用 parent.frame()不是一个彻底的解决方案，因为人们需要知道要返回多少步骤，这取决于一个人有多少嵌套函数。有没有更好的办法？是的。 dynGet()使用黑魔法自己解决这个问题(即我不知道它是如何工作的)。人们大概也可以通过实现自定义 get2() 来实现这一点。循环遍历 n 的所有可能值在 parent.frame() (留给读者练习)。

因此，我们的函数的最终版本是:

inner_func3 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)

  #try to get object in current envir
  #if it isnt there, try parent.frame
  if (exists(function_name)) {
    warning(sprintf("%s exists", function_name))
    func = get(function_name)
  } else {
    warning(sprintf("%s does not exist", function_name))
    func = dynGet(function_name)
  }

  func("hello")
}

outer_func3 = function(function_name) {
  #print envirs
  print_envir(environment(), "current ", recursive = T)
  print_envir(parent.frame(), "parent.frame ", recursive = T)
  print_envir(environment(inner_func3), "defining/enclosing ", recursive = T)

  inner_func3(function_name)
}

这些通过交互式和 devtools::test()测试。万岁!