test_that With match.fun Throws Unexpected Error w

Question

I'm having a problem using match.fun together with test_that when match.fun is used inside nested functions. To illustrate, I've built a quick toy example R package containing two functions. The latter simply calls the former:

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

i_throw_error <- function(function_name)
  i_dont_throw_error(function_name)

I then wrote testthat tests as follows:

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")
})

The first test is fine, but I get an error with the second test. The output from testthat is

==> 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)

I don't understand why the first test passes but the second test fails. In fact, running the failing test directly from the console works just fine:

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

I know it has something to do with the environments, but I would have expected this to work after match.fun searches through two environments. Any idea what I'm missing here? Thanks in advance for the help.

Answer 1

Related questions:

• evaluation inside of test_that call
• Unit test works as standalone but fails in test_that call
• object no found error in testthat tests

I spent a few hours getting to the bottom of this issue. It is an environment issue related to how testthat evaluates expressions when run via devtools::test() but not when run interactively.

Short version

testthat creates a number of new environments (to ensure independence of different tests and thus avoid errors from code interaction) when running tests and these don't inherit in the same way they do when you run interactively. The solution is generally to use dynGet() to find the object because this uses black magic to find the object (which is to say I don't understand how it works).

Long version

I created a new package, test.package, based on your functions, available here and it replicates your error. I suspected it was an environment issue because I've had similar bugs in the past where I had to think hard about get(), parent.frame(), parent.env() etc. See introduction to environments in Hadley's Advanced R.

Debugging stuff when not running interactively is hard. But devtools::test() does print warnings to the console, so I used that as my way to extract debugging information. Doing so required me to write a somewhat complicated function to help with this:

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)
}

The purpose of the function is basically to help print nicely formatted warnings about the environments that are searched when looking for an object. The reason I didn't just use print() is that this doesn't get shown in the right place in the testthat log but warnings do.

First, I renamed and modified your functions to:

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)
}

Thus, it now prints (as warnings) 2/3 environments and their parents when you evaluate it. The console output looks like this for 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)

Which is quite long, but it is broken into 4 parts: 3 parts that relate to the recursive printing of the environments, and the error that occurs at the end. The environments are tagged with the prefix seen in the function definition so it is easy to see what is going on. E.g. current environment is the current (inside the function call) environment.

Going over the three lists we find these paths:

1. current: 0x397a2a8 (function environment) > namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv. None of these have the object we want i.e. print_function.
2. parent.frame: 0x3d25070 (an empty environment, not sure why it is there) > 0x3d25070 (has our object!) > 0x3cff218 (another empty environment) > 0x370c908 (one more) > namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv.
3. defining/enclosing: namespace:test.package > 0x23aa1a0 > namespace:base > R_GlobalEnv.

The paths of defining/enclosing and parent frame overlap with the former being a subset of the latter. It turns out that our object is in parent.frame, but 2 steps up. Thus, we can fetch the function in this case with get(function_name, envir = parent.frame(n = 2)). Thus, second iteration is:

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)
}

This still works interactively because we added an if clause where it first tries to find it the normal way, and then if not, tries the parent.frame(n = 2) way.

On testing via devtools::test() we find that outer_v2 now works but we broke inner_v2 though it works interactively. If we inspect the log we see:

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

So our object is two steps up, but we still miss it. How? Well, we called it parent.frame(n = 2) from a different place than before and this changes something. If we replace it with parent.frame(n = 1) it works again.

So, using parent.frame() is not a thorough solution because one needs to know how many steps to go back up which depends on how many nested functions one has. Is there a better way? Yes. dynGet() uses black magic to figure this out on its own (i.e. I don't know how it works). One could presumably also accomplish this by implementing a custom get2() that loops through all the possible values for n in parent.frame() (left as exercise to the reader).

Thus, our final version of the functions are:

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)
}

These pass both the interactive and devtools::test() tests. Hooray!