diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java index aea39489db98957faa8048ecfe9e8687fddfd185..f20be7018e35f78907005a487464c90e798b5c34 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/env/REnvironment.java @@ -55,6 +55,7 @@ import com.oracle.truffle.r.runtime.data.RDataFactory; import com.oracle.truffle.r.runtime.data.RFunction; import com.oracle.truffle.r.runtime.data.RList; import com.oracle.truffle.r.runtime.data.RPromise; +import com.oracle.truffle.r.runtime.data.RSharingAttributeStorage; import com.oracle.truffle.r.runtime.data.RStringVector; import com.oracle.truffle.r.runtime.data.UpdateShareableChildValue; import com.oracle.truffle.r.runtime.env.frame.FrameSlotChangeMonitor; @@ -888,6 +889,14 @@ public abstract class REnvironment extends RAttributeStorage { throw new PutException(RError.Message.ENV_ADD_BINDINGS); } } + if (value instanceof RSharingAttributeStorage) { + RSharingAttributeStorage shareable = (RSharingAttributeStorage) value; + if (!shareable.isShared()) { + shareable.incRefCount(); + } + } else { + RSharingAttributeStorage.verify(value); + } frameAccess.put(key, value); } diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test index b85c0d981e0f06154d27e9499e34045b0024d7da..d1e096ec5a2319b4bdf224d05ed423358f5bc4b4 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test @@ -81930,6 +81930,19 @@ Error in get("x") : object 'x' not found #{ x <- function(){3} ; gg <- function() { assign("x", 4) ; g <- function() { if (FALSE) { x <- 2 } ; f <- function() { h <- function() { x() } ; h() } ; f() } ; g() } ; gg() } [1] 3 +##com.oracle.truffle.r.test.library.base.TestEnvironments.testSharing# +#{ e <- new.env(); e$vec <- c(1,2,3); vv <- e$vec; vv[[1]] <- 42; e$vec; } +[1] 1 2 3 + +##com.oracle.truffle.r.test.library.base.TestEnvironments.testSharing# +#{ e <- new.env(); f <- new.env(); e$vec <- c(1,2,3); f$vec <- e$vec; e$vec[[1]] <- 42; list(f = f$vec, e = e$vec); } +$f +[1] 1 2 3 + +$e +[1] 42 2 3 + + ##com.oracle.truffle.r.test.library.base.TestIsElement.testIsElement# #{ is.element('b', c('a', 'b', 'b')) } [1] TRUE diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestEnvironments.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestEnvironments.java index 1f2f9713d5eda8af8729943f9336c0f680c3aa87..6afdff5532990a62d8d2a4cf4632d6cd39fc34b5 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestEnvironments.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestEnvironments.java @@ -294,4 +294,10 @@ public class TestEnvironments extends TestBase { // Turning frame into an environment should not evaluate all the promises: assertEval("{ makefun <- function(f,s) function(a) f(a); s <- function() cat('side effect'); .Internal(islistfactor(environment(makefun(function(b) 2*b, s()))$f, F)); }"); } + + @Test + public void testSharing() { + assertEval("{ e <- new.env(); e$vec <- c(1,2,3); vv <- e$vec; vv[[1]] <- 42; e$vec; }"); + assertEval("{ e <- new.env(); f <- new.env(); e$vec <- c(1,2,3); f$vec <- e$vec; e$vec[[1]] <- 42; list(f = f$vec, e = e$vec); }"); + } }