3

我在嵌套函数中与whenmatch.fun一起使用时遇到问题。为了说明，我构建了一个包含两个函数的快速玩具示例 R 包。后者简单地调用前者：test_thatmatch.fun

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搜索两个环境后它会起作用。知道我在这里缺少什么吗？在此先感谢您的帮助。

4

1 回答 1

1

相关问题：

我花了几个小时才弄清楚这个问题。这是一个环境问题，与testthat在运行时如何评估表达式有关，devtools::test()但不是在交互运行时。

精简版

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

长版

我根据您的功能创建了一个新包test.package，可在此处获得，它会复制您的错误。我怀疑这是一个环境问题，因为过去我也遇到过类似的错误，我不得不仔细考虑get()，parent.frame()等等。请参阅Hadley 的Advanced Rparent.env()中的环境介绍。

不以交互方式运行时调试东西很困难。但是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是当前（函数调用内部）环境。

遍历这三个列表，我们找到了这些路径：

  1. 当前：（0x397a2a8功能环境） > namespace:test.package> 0x23aa1a0> namespace:base> R_GlobalEnv. 这些都没有我们想要的对象，即print_function。
  2. parent.frame：（0x3d25070一个空的环境，不知道为什么会在那里）> 0x3d25070（有我们的对象！）> （0x3cff218另一个空的环境）>（另一个0x370c908）>>>> 。namespace:test.package0x23aa1a0namespace:baseR_GlobalEnv
  3. 定义/封闭：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()使用黑魔法自己解决这个问题（即我不知道它是如何工作的）。大概也可以通过实现一个自定义来实现这一点，该自定义循环遍历inget2()的所有可能值（留给读者作为练习）。nparent.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()测试。万岁！

于 2018-02-15T19:34:43.910 回答