Skip to content

Instantly share code, notes, and snippets.

@ssimeonov
Created June 20, 2012 01:25
Show Gist options
  • Save ssimeonov/2957567 to your computer and use it in GitHub Desktop.
Save ssimeonov/2957567 to your computer and use it in GitHub Desktop.
Proto environment confusion with do.call()

Environment confusion in proto

Problem Description

This gist demonstrates a strange behavior in the proto package for R when functions are dynamically invoked via do.call. When do.call is invoked inside a proto object, variables that belong to a function's closure are not visible, even though a naive navigation of the environment chain shows these variables to be present. This problem does not occur when do.call is used outside of proto.

Reproducibility

The problem is isolated to a testthat test in test-cmd.r.

The test sets up a function op() which returns the value of command_result (100) from its parent environment. op() uses a utility function, show.frame(), to list all variables in the environment chain.

Three test cases invoke op in three different ways:

  1. directly
  2. via do.call
  3. via do.call inside a proto object

The first two test cases succeed. The third test case fails.

Test output

The test output is shown in test-cmd-output.r. The environment chain output in all three cases from inside op() is the same, yet in the third case, even though, show.frame() can find and print command_result's value, op() fails with object 'command_result' not found.

> test('pipeline')
Loading pipeline
Testing pipeline
proto with functions as data :
Current environment
<environment: 0x7f91a4fec5c0>
---- Calling op directly
Frame 0
Showing frame 0 with the following environment
<environment: 0x7f91a81076d8>
Variables:
n:
[1] 0
Frame 1
Showing frame 1 with the following environment
<environment: 0x7f91a4fec5c0>
Variables:
command_result:
[1] 100
Frame 2
Showing frame 2 with the following environment
<environment: 0x7f91a4fe3898>
Variables:
enclos:
<environment: base>
envir:
<environment: 0x7f91a4fec5c0>
expr:
{
command_result <- 100
op <- function() {
show.frame <- function(upn) {
if (upn < 0) {
env <- .GlobalEnv
}
else {
env <- parent.frame(n = upn + 1)
}
cat("\nShowing frame", upn, "with the following environment\n")
print(env)
cat("Variables:\n")
vars <- ls(envir = env)
for (vr in vars) {
vrg <- get(vr, envir = env)
if (!is.function(vrg)) {
cat(vr, ":\n", sep = "")
print(vrg)
}
}
}
for (n in c(0, 1, 2)) {
cat("\nFrame", n, "\n")
show.frame(n)
}
command_result
}
cat("\n\nCurrent environment\n")
print(environment())
cat("\n---- Calling op directly\n")
expect_equal(op(), command_result)
cat("\n---- Calling op with do.call\n")
expect_equal(do_call_test(op), command_result)
cat("\n---- Calling op with do.call inside proto\n")
cmd <- register("cmd", op)
expect_equal(cmd$perform(), command_result)
}
.
---- Calling op with do.call
Frame 0
Showing frame 0 with the following environment
<environment: 0x7f91a2354788>
Variables:
n:
[1] 0
Frame 1
Showing frame 1 with the following environment
<environment: 0x7f91a4fec5c0>
Variables:
command_result:
[1] 100
Frame 2
Showing frame 2 with the following environment
<environment: 0x7f91a4fe3898>
Variables:
enclos:
<environment: base>
envir:
<environment: 0x7f91a4fec5c0>
expr:
{
command_result <- 100
op <- function() {
show.frame <- function(upn) {
if (upn < 0) {
env <- .GlobalEnv
}
else {
env <- parent.frame(n = upn + 1)
}
cat("\nShowing frame", upn, "with the following environment\n")
print(env)
cat("Variables:\n")
vars <- ls(envir = env)
for (vr in vars) {
vrg <- get(vr, envir = env)
if (!is.function(vrg)) {
cat(vr, ":\n", sep = "")
print(vrg)
}
}
}
for (n in c(0, 1, 2)) {
cat("\nFrame", n, "\n")
show.frame(n)
}
command_result
}
cat("\n\nCurrent environment\n")
print(environment())
cat("\n---- Calling op directly\n")
expect_equal(op(), command_result)
cat("\n---- Calling op with do.call\n")
expect_equal(do_call_test(op), command_result)
cat("\n---- Calling op with do.call inside proto\n")
cmd <- register("cmd", op)
expect_equal(cmd$perform(), command_result)
}
.
---- Calling op with do.call inside proto
Frame 0
Showing frame 0 with the following environment
<environment: 0x7f91a5e32320>
Variables:
n:
[1] 0
Frame 1
Showing frame 1 with the following environment
<environment: 0x7f91a4fec5c0>
Variables:
cmd:
proto object
$ perform:function (., ...)
$ name : chr "cmd"
$ func :function ()
command_result:
[1] 100
Frame 2
Showing frame 2 with the following environment
<environment: 0x7f91a4fe3898>
Variables:
enclos:
<environment: base>
envir:
<environment: 0x7f91a4fec5c0>
expr:
{
command_result <- 100
op <- function() {
show.frame <- function(upn) {
if (upn < 0) {
env <- .GlobalEnv
}
else {
env <- parent.frame(n = upn + 1)
}
cat("\nShowing frame", upn, "with the following environment\n")
print(env)
cat("Variables:\n")
vars <- ls(envir = env)
for (vr in vars) {
vrg <- get(vr, envir = env)
if (!is.function(vrg)) {
cat(vr, ":\n", sep = "")
print(vrg)
}
}
}
for (n in c(0, 1, 2)) {
cat("\nFrame", n, "\n")
show.frame(n)
}
command_result
}
cat("\n\nCurrent environment\n")
print(environment())
cat("\n---- Calling op directly\n")
expect_equal(op(), command_result)
cat("\n---- Calling op with do.call\n")
expect_equal(do_call_test(op), command_result)
cat("\n---- Calling op with do.call inside proto\n")
cmd <- register("cmd", op)
expect_equal(cmd$perform(), command_result)
}
1
Command : ..
Cleaning up from previous runs : .
Registering commands :
Default namespace : ......
Multiple registrations : ..
Custom namespace : ....
Creating a pipeline : ......
1. Error: cmd execution ------------------------------------------------------------------------------------
object 'command_result' not found
1: expect_equal(cmd$perform(), command_result)
2: expect_that(object, equals(expected, label = expected.label, ...), info = info, label = label)
3: condition(object)
4: all.equal(expected, actual, ...)
5: all.equal.numeric(expected, actual, ...)
6: attr.all.equal(target, current, tolerance = tolerance, scale = scale, ...)
7: mode(current)
8: cmd$perform()
9: get(x, envir = this, inherits = inh)(this, ...)
10: do.call(func, list(), envir = environment(operation))
11: function ()
{
show.frame <- function(upn) {
if (upn < 0) {
env <- .GlobalEnv
}
else {
env <- parent.frame(n = upn + 1)
}
cat("\nShowing frame", upn, "with the following environment\n")
print(env)
cat("Variables:\n")
vars <- ls(envir = env)
for (vr in vars) {
vrg <- get(vr, envir = env)
if (!is.function(vrg)) {
cat(vr, ":\n", sep = "")
print(vrg)
}
}
}
for (n in c(0, 1, 2)) {
cat("\nFrame", n, "\n")
show.frame(n)
}
command_result
}()
>
# wrap a function into a command object
register <- function(name, operation) {
proto(
name = name,
func = operation,
perform = function(., ...) {
func <- with(., func) # unwrap bound proto method
do.call(func, list(), envir=environment(operation))
}
)
}
# dynamic invocation test outside of proto
do_call_test <- function(operation) {
do.call(operation, list(), envir=environment(operation))
}
context('proto with functions as data')
test_that("cmd execution", {
# This varible should be visible inside op
command_result <- 100
op <- function() {
# Utility to list all variables in an environment
# Modified from Matloff, Norman. The Art of R Programming
show.frame <- function(upn) {
# determine the proper environment
if (upn < 0) {
env <- .GlobalEnv
} else {
env <- parent.frame(n=upn+1)
}
cat('\nShowing frame', upn, 'with the following environment\n')
print(env)
cat('Variables:\n')
# get the list of variable names
vars <- ls(envir=env)
# for each variable name, print its value
for (vr in vars) {
vrg <- get(vr,envir=env)
if (!is.function(vrg)) {
cat(vr,":\n",sep="")
print(vrg)
}
}
}
for (n in c(0, 1, 2)) {
cat("\nFrame", n, "\n")
show.frame(n)
}
command_result
}
cat('\n\nCurrent environment\n')
print(environment())
cat("\n---- Calling op directly\n")
expect_equal(op(), command_result)
cat("\n---- Calling op with do.call\n")
expect_equal(do_call_test(op), command_result)
cat("\n---- Calling op with do.call inside proto\n")
cmd <- register('cmd', op)
expect_equal(cmd$perform(), command_result)
})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment