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

短版

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

长版

我根据您的函数available here创建了一个新的包 test.package ，它会复制您的错误。我怀疑这是一个环境问题，因为我过去曾有类似的错误，我必须仔细考虑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()的原因是，这并没有显示在 testthat 日志中的正确位置，但警告会显示。

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

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（功能环境）＆gt; namespace:test.package＆gt; 0x23aa1a0＆gt; namespace:base＆gt; R_GlobalEnv。这些都没有我们想要的对象，print_function。
parent.frame：0x3d25070（一个空的环境，不知道它为什么存在）＆gt; 0x3d25070（有我们的对象！）＆gt; 0x3cff218（另一个空白环境）＆gt; 0x370c908（再一次）＆gt; namespace:test.package＆gt; 0x23aa1a0＆gt; namespace:base＆gt; R_GlobalEnv。
定义/封闭：namespace:test.package＆gt; 0x23aa1a0＆gt; namespace:base＆gt; 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()

这些传递了交互式和{{1}}测试。万岁！

test_that使用match.fun深度使用两个级别时会引发意外错误

1 个答案:

短版

长版