Proto environment confusion with do.call()

readme.md

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-cmd-output.r

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

test-cmd.r

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