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

相关问题：

• test_that调用内部的评估
• 单元测试作为独立工作，但在test_that调用中失败
• 对象没有在testthat测试中发现错误

我花了几个小时来解决这个问题。 这是一个环境问题，与testthat在通过devtools::test()运行时如何计算表达式有关，但在交互式运行时却没有。

简洁版本

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

长版

我根据你的功能创建了一个新的包test.package ， 可以在这里复制你的错误。 我怀疑这是一个环境问题，因为我过去曾遇到类似的错误，我必须认真考虑get() ， parent.frame() ， parent.env()等。请参阅Hadley的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()是，这并没有显示在testthat log中的正确位置，而是警告。

首先，我将您的功能重命名并修改为：

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 ，控制台输出如下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是当前（在函数调用内）环境。

通过三个列表，我们找到了这些路径：

1. current： 0x397a2a8 （function environment）> namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv 。 这些都没有我们想要的对象，即print_function 。
2. parent.frame： 0x3d25070 （一个空的环境，不知道它为什么会出现）> 0x3d25070 （有我们的对象！）> 0x3cff218 （另一个空环境）> 0x370c908 （还有一个）> namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv 。
3. namespace:test.package / enclosing： 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()测试。 万岁！