Sample code for unlocking environments in R

unlockEnvironment.r

library(inline)

inc <- '
/* This is taken from envir.c in the R 2.15.1 source 
   https://github.com/SurajGupta/r-source/blob/master/src/main/envir.c
*/
#define FRAME_LOCK_MASK (1<<14)
#define FRAME_IS_LOCKED(e) (ENVFLAGS(e) & FRAME_LOCK_MASK)
#define UNLOCK_FRAME(e) SET_ENVFLAGS(e, ENVFLAGS(e) & (~ FRAME_LOCK_MASK))
'

src <- '
  if (TYPEOF(env) == NILSXP)
    error("use of NULL environment is defunct");
  if (TYPEOF(env) != ENVSXP)
    error("not an environment");

  UNLOCK_FRAME(env);

  // Return TRUE if unlocked; FALSE otherwise
  SEXP result = PROTECT( Rf_allocVector(LGLSXP, 1) );
  LOGICAL(result)[0] = FRAME_IS_LOCKED(env) == 0;
  UNPROTECT(1);

  return result;
'

unlockEnvironment <- cfunction(signature(env = "environment"),
                        includes = inc,
                        body = src)

unlockEnvironment(new.env()) # TRUE

unlockEnvironment('foo') # error

# TODO: Write proper R wrapper function
# - should return(invisible(TRUE)) if successful, error otherwise.
# - should also check type is environment
# - add 'bindings' option to also unlock bindings

# ============== test unlocking bindings

e <- new.env()
e$x <- 5
e$x # 5
lockEnvironment(e, bindings = TRUE)
e$x <- 6 # ERROR

environmentIsLocked(e) # TRUE
e$y <- 6 # ERROR

bindingIsLocked('x', e)  # TRUE
unlockBinding('x', e)
bindingIsLocked('x', e)  # FALSE
e$x <- 7 # OK

# Re-lock environment and bindings
lockEnvironment(e, bindings = TRUE)
e$y <- 6 # ERROR


# Run our custom function
unlockEnvironment(e) # TRUE
environmentIsLocked(e) # FALSE
e$y <- 8 # OK

bindingIsLocked('x', e)  # TRUE
e$x <- 7 # ERROR

unlockBinding(ls(e, all.names=TRUE), e)
e$x <- 7 # OK

bindingIsLocked('x', e)  # FALSE
bindingIsLocked('y', e)  # FALSE
e$y <- 8 # OK
e$z <- 9 # OK


# =============== test on a real package
# Modify devtools namespace
# We'll insert a function 'foo()' into the namespace env and package env,
# and also add it to the namespace's exports

library(devtools)

# Add something to namespace environment
ns_env <- asNamespace('devtools')
unlockEnvironment(ns_env)
ns_env$foo <- function() {
  ls(parent.env(environment()))
}
environment(ns_env$foo) <- ns_env # Set the environment of the function to the namespace
devtools:::foo  # prints function, with environment
devtools:::foo() # returns contents of devtools, including non-exported objects

# Add to package environment
pkg_env <- as.environment('package:devtools')
unlockEnvironment(pkg_env)
pkg_env$foo <- ns_env$foo
pkg_env$foo # OK
devtools::foo # Error: 'foo' is not an exported object from 'namespace:devtools'

# Add to exports for devtools
export_env <- ns_env$.__NAMESPACE__.$exports
ls(export_env)
export_env$foo <- c(foo="foo")
devtools::foo # OK
devtools::foo() # returns contents of devtools, including non-exported objects

Soon it will be is 3 years since that gist, maybe there is some better way? without inline dependency?

This SO answer looks like an alternative?