Remove usage of forbidden function

CRAN finally started enforcing the removal of internal functions that
the R core team does not consider parts of its public API. This affects
unlocking environments, even though this would be “benign” in our case.
However, there is strictly speaking no need to unlock anything, so the
code was rewritten (though at the cost of added complexity).

This squashed commit also contains the following changes:

* Test environment locking more thoroughly
* Silence annoying message in test
* Update outdated URL
* Update roxygen2 version
* Document changes

Author: klmr

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: box
 Title: Write Reusable, Composable and Modular R Code
-Version: 1.2.0.9000
+Version: 1.2.1
 Authors@R: c(
         person(
             'Konrad', 'Rudolph',
@@ -39,4 +39,4 @@ Suggests:
 Enhances:
     rstudioapi
 VignetteBuilder: knitr
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2

Makefile

@@ -1,4 +1,4 @@
-R_HOME ?= $(shell Rscript --vanilla -e 'cat(Sys.getenv("R_HOME"))')
+R_HOME ?= $(shell Rscript --vanilla -e 'cat(R.home())')
 rscript = ${R_HOME}/bin/Rscript --no-save --no-restore
 r = ${R_HOME}/bin/R --no-save --no-restore
 

NEWS.md

@@ -1,10 +1,15 @@
-# box (development version)
+# box 1.2.1
 
 ## Bug fixes
 
 * Suppress a spurious internal warning upon reloading a module, caused by a dependent module being imported more than once (#363).
 
 
+## Miscellaneous
+
+* Changed the way environments are locked, since environment unlocking is no longer allowed by the CRAN policies.
+
+
 # box 1.2.0
 
 ## Breaking changes

R/env.r

@@ -189,10 +189,6 @@ strict_extract = function (e1, e2) {
     invisible(x)
 }
 
-unlock_environment = function (env) {
-    invisible(.Call(c_unlock_env, env))
-}
-
 find_import_env = function (x, spec, info, mod_ns) {
     UseMethod('find_import_env')
 }

R/use.r

@@ -97,7 +97,7 @@
 #'
 #' A module which has not declared any exports is treated as a \emph{legacy
 #' module} and exports \emph{all} default-visible names (that is, all names that
-#' do not start with a dot (\code{.}). This usage is present only for backwards
+#' do not start with a dot (\code{.})). This usage is present only for backwards
 #' compatibility with plain \R scripts, and its usage is \emph{not recommended}
 #' when writing new modules.
 #'
@@ -314,12 +314,15 @@ use_one = function (declaration, alias, caller, use_call) {
 #' @param info the physical module information
 #' @rdname importing
 load_and_register = function (spec, info, caller) {
-    mod_ns = load_mod(info)
+    ret = load_mod(info)
+    mod_ns = ret$mod_ns
+    is_apex = ret$is_apex
+    on.exit(lock_all_environments(is_apex))
     register_as_import(spec, info, mod_ns, caller)
 
     if (is_mod_still_loading(info)) {
         # Module was cached but hasn’t fully loaded yet. This happens for
-        # cyclic imports (1. A -> 2. B -> 3. A)) in step (3). To proceed, we
+        # cyclic imports (1. A -> 2. B -> 3. A) in step (3). To proceed, we
         # take note of the issue and wait until we bounce back to step (1) to
         # perform deferred finalization.
 
@@ -374,7 +377,7 @@ export_and_attach = function (spec, info, mod_ns, caller) {
     finalize_deferred(info)
 
     mod_exports = mod_exports(info, spec, mod_ns)
-    lockEnvironment(mod_exports, bindings = TRUE)
+    defer_locking(mod_exports)
 
     assign_alias(spec, mod_exports, caller)
     attach_to_caller(spec, info, mod_exports, mod_ns, caller)
@@ -398,38 +401,50 @@ load_from_source = function (info, mod_ns) {
     make_S3_methods_known(mod_ns)
 }
 
-#' @return \code{load_mod} returns the module or package namespace environment
-#' of the specified module or package info.
+#' @return \code{load_mod} returns a named \code{list(mod_ns, is_apex)}
+#' containing the module or package namespace environment of the specified
+#' module or package info, as well as a flag specifying whether the loaded
+#' module is an “apex” module, i.e. not loaded from within another module. This
+#' information is then used to lock all environments that were created during
+#' the loading. — This must happen after nested modules are fully loaded, since
+#' deferred finalization otherwise cannot modify these environments during
+#' cyclic imports.
 #' @rdname importing
 load_mod = function (info) {
     UseMethod('load_mod')
 }
 
 `load_mod.box$mod_info` = function (info) {
-    if (is_mod_loaded(info)) return(loaded_mod(info))
+    if (is_mod_loaded(info)) {
+        return(list(mod_ns = loaded_mod(info), is_apex = is_at_apex()))
+    }
 
     # Load module/package and dependencies; register the module now, to allow
     # cyclic imports without recursing indefinitely — but deregister upon
     # failure to load.
-    on.exit(deregister_mod(info))
+
+    on.exit({
+        deregister_mod(info)
+        lock_all_environments(is_apex)
+    })
 
     mod_ns = make_namespace(info)
+    is_apex = defer_locking(mod_ns)
     register_mod(info, mod_ns)
     load_from_source(info, mod_ns)
     mod_loading_finished(info, mod_ns)
 
     # Call `.on_load` hook just after loading is finished but before exporting
     # symbols, so that `.on_load` can modify these symbols.
     call_hook(mod_ns, '.on_load', mod_ns)
-    lockEnvironment(mod_ns, bindings = TRUE)
 
     on.exit()
-    mod_ns
+    list(mod_ns = mod_ns, is_apex = is_apex)
 }
 
 `load_mod.box$pkg_info` = function (info) {
     pkg = info$name
-    base::.getNamespace(pkg) %||% loadNamespace(pkg)
+    list(mod_ns = base::.getNamespace(pkg) %||% loadNamespace(pkg), is_apex = is_at_apex())
 }
 
 #' @return \code{mod_exports} returns an export environment containing the
@@ -517,6 +532,7 @@ assign_temp_alias = function (spec, caller) {
     create_mod_alias = is.null(spec$attach) || spec$explicit
     if (! create_mod_alias) return()
 
+    self = environment()
     callers = list()
 
     binding = function (mod_exports) {
@@ -527,25 +543,47 @@ assign_temp_alias = function (spec, caller) {
                 sys.calls()
             )), 1L)
             frame = sys.frame(mod_exports_frame_index)
-            env = frame$env
-            assign('callers', append(callers, env), envir = parent.env(environment()))
+            self$callers = c(callers, frame$env)
 
             # FIXME: Do we need to create transitive placeholder active bindings?
-            structure(list(), class = 'placeholder')
+            structure(list(), class = 'box$placeholder')
         } else {
             # Resolve assignments
             for (env in callers) {
-                box_unlock_binding(spec$alias, env)
                 assign(spec$alias, mod_exports, envir = env)
-                lockBinding(spec$alias, env)
+                defer_locking(env)
             }
+
             # Replace myself
-            unlock_environment(caller)
             rm(list = spec$alias, envir = caller)
             assign(spec$alias, mod_exports, envir = caller)
-            lockEnvironment(caller)
         }
     }
 
     makeActiveBinding(spec$alias, structure(binding, class = 'box$placeholder'), caller)
 }
+
+lock_info = new.env(parent = emptyenv())
+lock_info$envs = list()
+
+defer_locking = function (ns) {
+    is_apex = is_at_apex()
+    lock_info$envs = c(lock_info$envs, list(ns))
+    is_apex
+}
+
+is_at_apex = function () {
+    length(lock_info$envs) == 0L
+}
+
+lock_all_environments = function (is_apex) {
+    if (! is_apex) {
+        return()
+    }
+
+    for (ns in lock_info$envs) {
+        lockEnvironment(ns, bindings = TRUE)
+    }
+
+    lock_info$envs = list()
+}

src/exports.c

@@ -2,11 +2,9 @@
 #include "Rinternals.h"
 
 SEXP strict_extract(SEXP e1, SEXP e2);
-SEXP unlock_env(SEXP env);
 
 static const R_CallMethodDef methods[] = {
     {"c_strict_extract", (DL_FUNC) &strict_extract, 2},
-    {"c_unlock_env", (DL_FUNC) &unlock_env, 1},
     {NULL, NULL, 0}
 };
 

src/unlock_env.c

@@ -1,5 +1,5 @@
 app = box::file('shiny-app')
 tryCatch(
-    shiny::runApp(app, launch.browser = FALSE),
+    suppressMessages(shiny::runApp(app, launch.browser = FALSE)),
     error = invisible
 )

tests/testthat/support/run-shiny.r

@@ -68,9 +68,14 @@ test_that('hidden objects are not exported', {
 test_that('module bindings are locked', {
     box::use(mod/a)
 
+    ns = attr(a, 'namespace')
+
     expect_true(environmentIsLocked(a))
+    expect_true(environmentIsLocked(ns))
     expect_true(bindingIsLocked('get_counter', a))
     expect_true(bindingIsLocked('modname', a))
+    expect_true(bindingIsLocked('get_counter', ns))
+    expect_true(bindingIsLocked('modname', ns))
 
     err = try({a$counter = 2L}, silent = TRUE)
     expect_s3_class(err, 'try-error')

tests/testthat/test-basic.r

@@ -2,12 +2,18 @@ context('circular dependencies')
 
 test_that('cyclic dependencies load in finite time', {
     box::use(mod/cyclic_a)
-    expect_true(TRUE)
+    ns = attr(cyclic_a, 'namespace')
+    expect_true(environmentIsLocked(cyclic_a))
+    expect_true(bindingIsLocked('name', cyclic_a))
+    expect_true(environmentIsLocked(ns))
+    expect_true(bindingIsLocked('name', ns))
 })
 
 test_that('cyclic import fully loads dependencies', {
     box::use(a = mod/cyclic_a)
     box::use(b = mod/cyclic_b)
+    ns_a = attr(a, 'namespace')
+    ns_b = attr(b, 'namespace')
 
     expect_equal(a$name, 'a')
     expect_equal(b$name, 'b')
@@ -19,4 +25,13 @@ test_that('cyclic import fully loads dependencies', {
     expect_equal(a$b$a$name, 'a')
     expect_equal(b$a$b$a_name(), 'a')
     expect_equal(b$a$b$name, 'b')
+
+    expect_true(environmentIsLocked(a))
+    expect_true(bindingIsLocked('name', a))
+    expect_true(environmentIsLocked(b))
+    expect_true(bindingIsLocked('name', b))
+    expect_true(environmentIsLocked(ns_a))
+    expect_true(bindingIsLocked('name', ns_a))
+    expect_true(environmentIsLocked(ns_b))
+    expect_true(bindingIsLocked('name', ns_b))
 })