Ensured that active bindings and locked bindings play well together

core/src/main/java/org/renjin/sexp/Environment.java

@@ -346,18 +346,21 @@ public SEXP setVariable(Context context, Symbol symbol, SEXP value) {
 
     if(bindingIsLocked(symbol)) {
       throw new EvalException("cannot change value of locked binding for '%s'", symbol.getPrintName());
-    } else if(locked && frame.getVariable(symbol) == Symbol.UNBOUND_VALUE) {
-      throw new EvalException("cannot add bindings to a locked environment");
     }
+
     if(activeBindings != null && activeBindings.containsKey(symbol)) {
       Closure fun = activeBindings.get(symbol);
       PairList.Builder args = new PairList.Builder().add(value);
       return context.evaluate(new FunctionCall(fun, args.build()));
-    } else {
-      frame.setVariable(symbol, value);
-      modCount++;
-      return Null.INSTANCE;
     }
+
+    if(locked && frame.getVariable(symbol) == Symbol.UNBOUND_VALUE) {
+      throw new EvalException("cannot add bindings to a locked environment");
+    }
+
+    frame.setVariable(symbol, value);
+    modCount++;
+    return Null.INSTANCE;
   }
 
   /**
@@ -617,16 +620,28 @@ public void lock(boolean lockBindings) {
     this.locked = true;
     if(lockBindings) {
       lockedBindings = Sets.newHashSet(frame.getSymbols());
+      if(activeBindings != null) {
+        lockedBindings.addAll(activeBindings.keySet());
+      }
     }
   }
 
+  /**
+   * Returns true if the given {@code symbol} is bound to either a normal value, or
+   * to an active binding in this Environment.
+   */
+  public boolean exists(Symbol symbol) {
+    return frame.getVariable(symbol) != Symbol.UNBOUND_VALUE ||
+        isActiveBinding(symbol);
+  }
+
   /**
    * Locking the binding prevents changing the value of the variable
    *
    * @param symbol variable symbol
    */
   public void lockBinding(Symbol symbol) {
-    if(frame.getVariable(symbol) == Symbol.UNBOUND_VALUE) {
+    if (!exists(symbol)) {
       throw new EvalException("no binding for '%s'", symbol);
     }
     if(lockedBindings == null) {
@@ -636,14 +651,19 @@ public void lockBinding(Symbol symbol) {
   }
 
   /**
-   * Unlocks the binding to allow changing the value of the variable
+   * Unlocks the binding to allow changing the value of the given {@code symbol}.
+   *
+   * <p>A binding, either normal or active, <strong>must</strong> exist, or an error
+   * is thrown. No error is thrown if the binding exists but is not locked.</p>
    *
-   * @param symbol
+   * @throws EvalException if a binding for the given {@code symbol} does not exist.
    */
   public void unlockBinding(Symbol symbol) {
-    if(frame.getVariable(symbol) == Symbol.UNBOUND_VALUE) {
+
+    if(!exists(symbol)) {
       throw new EvalException("no binding for '%s'", symbol);
     }
+
     if(lockedBindings != null) {
       lockedBindings.remove(symbol);
     }

tests/src/test/R/makeActiveBinding.R

@@ -154,6 +154,93 @@ test.ellipses.1 <- function() {
     assertThat(g(43), throwsError())
 }
 
+
+
+test.locked.bindings <- function() {
+
+    env <- new.env();
+    fval <- 1L
+    f <- function(val) {
+        if(missing(val)) {
+            fval
+        } else {
+            fval <<- val
+        }
+    }
+
+    makeActiveBinding("f", f, env)
+
+
+    # Lock the environment so that symbols
+    # cannnot be added or removed,
+    # but DON'T lock the values themselves
+    lockEnvironment(env, bindings = FALSE)
+
+
+    # This should allow us to change a value
+    # via an active binding
+    env$f <- 33
+
+    assertThat(env$f, identicalTo(33))
+
+    # We should not be able to add new active bindings
+    assertThat( { makeActiveBinding("g", f, env) }, throwsError())
+}
+
+
+test.locked.binding <- function() {
+
+    env <- new.env();
+    fval <- 1L
+    f <- function(val) {
+        if(missing(val)) {
+            fval
+        } else {
+            fval <<- val
+        }
+    }
+
+    makeActiveBinding("f", f, env)
+
+    # Lock the environment so that symbols
+    # cannnot be added or removed,
+    # and DO lock the values themselves
+    lockEnvironment(env, bindings = TRUE)
+
+    # This means that values also cannot
+    # be set via active bindings.
+    assertThat( { env$f <- 33 }, throwsError())
+}
+
+
+
+test.single.locked.binding <- function() {
+
+    env <- new.env();
+    fval <- 1L
+    f <- function(val) {
+        if(missing(val)) {
+            fval * 2
+        } else {
+            fval <<- val
+        }
+    }
+
+    makeActiveBinding("f", f, env)
+
+    lockBinding("f", env)
+
+    # This means that values also cannot
+    # be set via active bindings.
+    assertThat( { env$f <- 33 }, throwsError())
+
+    unlockBinding("f", env)
+
+    env$f <- 33
+    assertThat(env$f, identicalTo(66))
+}
+
+
 test.ellipses.2 <- function() {
     assertThat(makeActiveBinding(sym=`...`, fun=function(...) 42), throwsError())
 }
@@ -174,3 +261,4 @@ test.ellipses.3 <- function() {
     }
     assertThat(g(c("A"),c("B")), identicalTo("B"))
 }
+