From 4138bd65770d6ab72500e49239262d14abd332e0 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Fri, 26 May 2017 14:06:18 +0200
Subject: [PATCH] CachedExtractVector node evaluates promises extracted from
environments.
---
.../r/nodes/access/vector/CachedExtractVectorNode.java | 6 ++++++
.../oracle/truffle/r/nodes/builtin/InternalNode.java | 6 ++++++
.../com/oracle/truffle/r/test/ExpectedTestOutput.test | 10 +++++++++-
.../truffle/r/test/library/base/TestEnvironments.java | 10 +++++++++-
4 files changed, 30 insertions(+), 2 deletions(-)
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java
index 6a51aee479..7e8564b4ec 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java
@@ -37,6 +37,7 @@ import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetDimNa
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetDimAttributeNode;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetDimNamesAttributeNode;
+import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
import com.oracle.truffle.r.nodes.profile.AlwaysOnBranchProfile;
import com.oracle.truffle.r.nodes.profile.VectorLengthProfile;
import com.oracle.truffle.r.runtime.RError;
@@ -49,6 +50,7 @@ import com.oracle.truffle.r.runtime.data.RLanguage;
import com.oracle.truffle.r.runtime.data.RList;
import com.oracle.truffle.r.runtime.data.RLogical;
import com.oracle.truffle.r.runtime.data.RNull;
+import com.oracle.truffle.r.runtime.data.RPromise;
import com.oracle.truffle.r.runtime.data.RString;
import com.oracle.truffle.r.runtime.data.RStringVector;
import com.oracle.truffle.r.runtime.data.RTypedValue;
@@ -86,6 +88,7 @@ final class CachedExtractVectorNode extends CachedVectorNode {
@Child private ExtractDimNamesNode extractDimNames;
private final ConditionProfile resultHasDimensions = ConditionProfile.createBinaryProfile();
+ private final ConditionProfile promiseInEnvironment = ConditionProfile.createBinaryProfile();
/**
* Profile if any metadata was applied at any point in time. This is useful extract primitive
@@ -254,6 +257,9 @@ final class CachedExtractVectorNode extends CachedVectorNode {
String positionString = tryCastSingleString(positionsCheckNode, positions);
if (positionString != null) {
Object obj = env.get(positionString);
+ if (promiseInEnvironment.profile(obj instanceof RPromise)) {
+ obj = PromiseHelperNode.evaluateSlowPath(null, (RPromise) obj);
+ }
return obj == null ? RNull.instance : obj;
}
throw error(RError.Message.WRONG_ARGS_SUBSET_ENV);
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/InternalNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/InternalNode.java
index 7fceec433d..7b9821cf93 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/InternalNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/InternalNode.java
@@ -43,6 +43,7 @@ import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
import com.oracle.truffle.r.runtime.data.REmpty;
import com.oracle.truffle.r.runtime.data.RFunction;
+import com.oracle.truffle.r.runtime.data.RPromise;
import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector;
import com.oracle.truffle.r.runtime.nodes.RBaseNode;
import com.oracle.truffle.r.runtime.nodes.RNode;
@@ -245,6 +246,7 @@ public abstract class InternalNode extends OperatorNode {
Object[] args = new Object[arguments.length];
for (int i = 0; i < args.length; i++) {
args[i] = arguments[i].execute(frame);
+ assert !(args[i] instanceof RPromise);
}
return args;
}
@@ -273,6 +275,7 @@ public abstract class InternalNode extends OperatorNode {
value = forcePromises(frame, (RArgsValuesAndNames) value);
}
args[i] = value;
+ assert !(args[i] instanceof RPromise);
}
return args;
}
@@ -281,6 +284,7 @@ public abstract class InternalNode extends OperatorNode {
Object[] array = new Object[varArgs.getLength()];
for (int i = 0; i < array.length; i++) {
array[i] = promiseHelper.checkEvaluate(frame, varArgs.getArgument(i));
+ assert !(array[i] instanceof RPromise);
}
return new RArgsValuesAndNames(array, varArgs.getSignature());
}
@@ -303,10 +307,12 @@ public abstract class InternalNode extends OperatorNode {
for (int i = 0; i < args.length - 1; i++) {
args[i] = arguments[i].execute(frame);
+ assert !(args[i] instanceof RPromise);
}
Object[] varArgs = new Object[arguments.length - (factory.getSignature().getLength() - 1)];
for (int i = 0; i < varArgs.length; i++) {
varArgs[i] = arguments[args.length - 1 + i].execute(frame);
+ assert !(varArgs[i] instanceof RPromise);
}
args[args.length - 1] = new RArgsValuesAndNames(varArgs, ArgumentsSignature.empty(varArgs.length));
return args;
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 1ebb798330..78cd51bfc5 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
@@ -78624,6 +78624,14 @@ Error in rm("foo", envir = baseenv()) :
#{ x <- 1; lockBinding("x", globalenv()); x <- 1 }
Error: cannot change value of locked binding for 'x'
+##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrameToEnv#
+#{ makefun <- function(f) function(a) f(a); .Internal(islistfactor(environment(makefun(function(b) 2*b))$f, F)); }
+[1] FALSE
+
+##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrameToEnv#
+#{ makefun <- function(f,s) function(a) f(a); s <- function() cat('side effect'); .Internal(islistfactor(environment(makefun(function(b) 2*b, s()))$f, F)); }
+[1] FALSE
+
##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrames#
#{ t1 <- function() { aa <- 1; t2 <- function() { cat("current frame is", sys.nframe(), "; "); cat("parents are frame numbers", sys.parents(), "; "); print(ls(envir = sys.frame(-1))) }; t2() }; t1() }
current frame is 2 ; parents are frame numbers 0 1 ; [1] "aa" "t2"
@@ -130695,7 +130703,7 @@ Error in attr(to, "a") <- "a" : external object cannot be attributed
#if (length(grep("FastR", R.Version()$version.string)) != 1) { cat('Error in attr(to, which = "a") : external object cannot be attributed<<<NEWLINE>>>') } else { to <- .fastr.interop.new(.fastr.java.class('com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass')); attr(to, which = 'a') }
Error in attr(to, which = "a") : external object cannot be attributed
-##com.oracle.truffle.r.test.library.fastr.TestJavaInterop.testClassAsParameter#
+##com.oracle.truffle.r.test.library.fastr.TestJavaInterop.testClassAsParameter#Ignored.ImplementationError#
#if (length(grep("FastR", R.Version()$version.string)) != 1) { "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass" } else { tc <- .fastr.java.class('com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass'); t <- .fastr.interop.new(tc); t$classAsArg(tc) }
[1] "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass"
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 44ac9c7cfa..31bbd86d48 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
@@ -4,7 +4,7 @@
* http://www.gnu.org/licenses/gpl-2.0.html
*
* Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2016, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2017, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -285,4 +285,12 @@ public class TestEnvironments extends TestBase {
assertEval("{ e <- new.env(); assign(\"x\", 1, e); attach(e, 2); x; detach(2); x }");
assertEval("{ detach(\"missing\"); x }");
}
+
+ @Test
+ public void testFrameToEnv() {
+ // Note: islistfactor is internal and should fail if it gets promise directly
+ assertEval("{ makefun <- function(f) function(a) f(a); .Internal(islistfactor(environment(makefun(function(b) 2*b))$f, F)); }");
+ // 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)); }");
+ }
}
--
GitLab