diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Rm.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Rm.java index b493cf9ea6ca362c737cbbec9dd08b934163dd34..f3839b1da0d08ce990dc7d35a5dcac940537bf10 100644 --- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Rm.java +++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Rm.java @@ -33,12 +33,15 @@ import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX; import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL; import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary; +import com.oracle.truffle.api.dsl.Cached; import com.oracle.truffle.api.dsl.Specialization; import com.oracle.truffle.r.nodes.builtin.RBuiltinNode; import com.oracle.truffle.r.runtime.RError; import com.oracle.truffle.r.runtime.builtins.RBuiltin; import com.oracle.truffle.r.runtime.data.RNull; import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector; +import com.oracle.truffle.r.runtime.data.nodes.VectorAccess; +import com.oracle.truffle.r.runtime.data.nodes.VectorAccess.SequentialIterator; import com.oracle.truffle.r.runtime.env.REnvironment; import com.oracle.truffle.r.runtime.env.REnvironment.PutException; @@ -57,19 +60,47 @@ public abstract class Rm extends RBuiltinNode.Arg3 { @Specialization @TruffleBoundary - protected Object rm(RAbstractStringVector list, REnvironment envir, @SuppressWarnings("unused") boolean inherits) { - for (int i = 0; i < list.getLength(); i++) { - String key = list.getDataAt(i); + protected Object rm(RAbstractStringVector list, REnvironment envir, boolean inherits, + @Cached("createSlowPath(list)") VectorAccess access) { + try (SequentialIterator access2 = access.access(list)) { + while (access.next(access2)) { + String key = access.getString(access2); + if (!removeFromEnv(envir, key, inherits)) { + warning(RError.Message.UNKNOWN_OBJECT, key); + } + } + + } catch (PutException ex) { + error(ex); + } + + return RNull.instance; + } + + private static boolean removeFromEnv(REnvironment envir, String key, boolean inherits) throws PutException { + REnvironment curEnv = envir; + while (curEnv != REnvironment.emptyEnv()) { try { - envir.rm(key); + curEnv.rm(key); + // found and successfully removed + return true; } catch (PutException ex) { - if (envir == REnvironment.globalEnv()) { - warning(RError.Message.UNKNOWN_OBJECT, key); + // 'key' is not in the 'curEnv' + + // Special treatment for base env and base namespace env + if (curEnv == REnvironment.baseEnv() || curEnv == REnvironment.baseNamespaceEnv() || curEnv.isLocked()) { + throw ex; + } + + if (inherits) { + curEnv = curEnv.getParent(); + continue; } else { - throw error(ex); + return false; } } } - return RNull.instance; + // not found in any environment + return false; } } 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 60b308dcab5f96f7a67e275c35f13f884e3634e0..31b07e1765a1bc1bb3d96297b1d9543bcb95bb48 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 @@ -51860,7 +51860,7 @@ integer(0) # e <- new.env(); e$a <- 42; rm(list='a', envir=e); e$a NULL -##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests#Output.IgnoreErrorContext# +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# #tmp <- 42; f <- function() rm(list='tmp',inherits=T); f(); tmp Error: object 'tmp' not found @@ -51872,6 +51872,73 @@ Error: object 'tmp' not found #tmp <- 42; rm(tmp); tmp Error: object 'tmp' not found +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ e <- new.env(); e$a <- 1234L; lockBinding('a', e); rm(list='a', envir=e); ls(e) } +character(0) + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ e <- new.env(); e$a <- 1234L; lockEnvironment(e); rm(list='a', envir=e); ls(e) } +Error in rm(list = "a", envir = e) : + cannot remove bindings from a locked environment + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ e <- new.env(); e$a <- 1234L; rm(list=c('c', 'a'), envir=e); ls(e) } +character(0) +Warning message: +In rm(list = c("c", "a"), envir = e) : object 'c' not found + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ e <- new.env(parent=baseenv()); e$a <- 1234L; rm(c('c', 'a'), envir=e, inherits=T); ls(e) } +Error in rm(c("c", "a"), envir = e, inherits = T) : + ... must contain names or character strings + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ e <- new.env(parent=baseenv()); rm('c', envir=e, inherits=T) } +Error in rm("c", envir = e, inherits = T) : + cannot remove variables from the base environment + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ env0 <- new.env(); env0$a <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('a', envir=env1, inherits=F); lapply(c(env0, env1), function(x) ls(x)) } +[[1]] +[1] "a" + +[[2]] +[1] "b" + +Warning message: +In rm("a", envir = env1, inherits = F) : object 'a' not found + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ env0 <- new.env(); env0$a <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('a', envir=env1, inherits=T); lapply(c(env0, env1), function(x) ls(x)) } +[[1]] +character(0) + +[[2]] +[1] "b" + + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ env0 <- new.env(); env0$b <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('b', envir=env1, inherits=F); lapply(c(env0, env1), function(x) ls(x)) } +[[1]] +[1] "b" + +[[2]] +character(0) + + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ rm(list='a', envir=emptyenv()) } +Warning message: +In rm(list = "a", envir = emptyenv()) : object 'a' not found + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ rm(list=ls(baseenv(), all.names=TRUE), envir=baseenv()) } +Error in rm(list = ls(baseenv(), all.names = TRUE), envir = baseenv()) : + cannot remove variables from the base environment + +##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.basicTests# +#{ rm(list=ls(emptyenv()), envir=emptyenv()) } + ##com.oracle.truffle.r.test.builtins.TestBuiltin_rm.testArgsCasting# #.Internal(remove(list=33, environment(), F)) Error: invalid first argument diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_rm.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_rm.java index 15ac77f83a1e5334aa682d597a9de56d8068e55a..87a859f0dcc32421826f6aac4b8360cb31574b13 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_rm.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_rm.java @@ -33,7 +33,18 @@ public class TestBuiltin_rm extends TestBase { assertEval("tmp <- 42; rm(tmp); tmp"); assertEval("tmp <- 42; rm(list='tmp'); tmp"); assertEval(" e <- new.env(); e$a <- 42; rm(list='a', envir=e); e$a"); - assertEval(Output.IgnoreErrorContext, "tmp <- 42; f <- function() rm(list='tmp',inherits=T); f(); tmp"); + assertEval("tmp <- 42; f <- function() rm(list='tmp',inherits=T); f(); tmp"); + assertEval("{ env0 <- new.env(); env0$a <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('a', envir=env1, inherits=T); lapply(c(env0, env1), function(x) ls(x)) }"); + assertEval("{ env0 <- new.env(); env0$a <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('a', envir=env1, inherits=F); lapply(c(env0, env1), function(x) ls(x)) }"); + assertEval("{ env0 <- new.env(); env0$b <- 123L; env1 <- new.env(parent=env0); env1$b <- 456L; rm('b', envir=env1, inherits=F); lapply(c(env0, env1), function(x) ls(x)) }"); + assertEval("{ rm(list=ls(baseenv(), all.names=TRUE), envir=baseenv()) }"); + assertEval("{ e <- new.env(parent=baseenv()); rm('c', envir=e, inherits=T) }"); + assertEval("{ e <- new.env(parent=baseenv()); e$a <- 1234L; rm(c('c', 'a'), envir=e, inherits=T); ls(e) }"); + assertEval("{ e <- new.env(); e$a <- 1234L; rm(list=c('c', 'a'), envir=e); ls(e) }"); + assertEval("{ e <- new.env(); e$a <- 1234L; lockEnvironment(e); rm(list='a', envir=e); ls(e) }"); + assertEval("{ e <- new.env(); e$a <- 1234L; lockBinding('a', e); rm(list='a', envir=e); ls(e) }"); + assertEval("{ rm(list='a', envir=emptyenv()) }"); + assertEval("{ rm(list=ls(emptyenv()), envir=emptyenv()) }"); } @Test