diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/opt/OptForcedEagerPromiseNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/opt/OptForcedEagerPromiseNode.java
index 852f8ff22b1ae9803ece4a407c79410268f5d47a..8183c468f2d4804e3482b741aa9132aa9a2f9464 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/opt/OptForcedEagerPromiseNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/opt/OptForcedEagerPromiseNode.java
@@ -68,6 +68,15 @@ public final class OptForcedEagerPromiseNode extends PromiseNode {
@Override
public Object execute(final VirtualFrame frame) {
Object value;
+ // TODO: The evaluation is too eager in some corner cases. There are ignored tests for this.
+ // This gets executed on the caller side, although it should be executed on the callee
+ // side. There can be differences in how the call stack looks like and built-in functions
+ // doing callstack introspection may give incorrect results. Moreover, functions with side
+ // effects must be invoked in the correct order. This is why we should not simply
+ // recursively evaluate the next promise unless it is again a simple expression. Moreover,
+ // when reading variables via lookups, we should create assumptions for them to re-evaluate
+ // the promise if the variable's value changes.
+
// need to unwrap as re-wrapping happens when the value is retrieved (otherwise ref count
// update happens twice)
if (wrapIndex != ArgumentStatePush.INVALID_INDEX && expr instanceof WrapArgumentNode) {
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 d638e4150b279cd06bc013971f512f79866b0351..d70d6fdcfedbd7f273b7c4c14fe71f3a9615c08d 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
@@ -75253,6 +75253,14 @@ integer(0)
#{ u <- function() sys.parents() ; f <- function(x) x ; g <- function(y) f(y) ; h <- function(z=u()) g(z) ; h() }
[1] 0 1 2 1
+##com.oracle.truffle.r.test.builtins.TestBuiltin_sysparents.testSysParents#Ignored.ImplementationError#
+#{ u <- function() sys.parents(); g <- function(y) y; h <- function(z) g(z); h(u()); }
+[1] 0 1 0
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_sysparents.testSysParents#Ignored.ImplementationError#
+#{ u <- function() sys.parents(); g <- function(y) y; h <- function(z=u()) g(z); h(); }
+[1] 0 1 1
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_t.testTranspose#
#t(1)
[,1]
@@ -83543,22 +83551,9 @@ Error in foo(xa = 4, xaa = 5) :
#{ x<-function(foo,bar){foo*bar} ; x(fo=10, bar=2) }
[1] 20
-##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#
-#foo <- function(a,b) { x<<-4; b; }; x <- 0; foo(2, x > 2);
-[1] TRUE
-
##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#Ignored.ImplementationError#
-#foo <- function(x,z) list(x,z); x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x > 5);
-[[1]]
-[1] 1
-
-[[2]]
-[1] TRUE
-
-
-##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#Ignored.ImplementationError#
-#foo <- function(x,z) x + z; x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x);
-[1] 11
+#{ bar <- function(x, y) { y; x; 42 }; foo <- function(a) bar(a, cat('side2')); foo(cat('side1')) }
+side2side1[1] 42
##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#
#{ f <- function(a) { g <- function(b) { a <<- 3; b } ; g(a) } ; x <- 1 ; f(x) }
@@ -83585,6 +83580,23 @@ Error in f() :
#{ f <- function(x) { function() {x} } ; a <- 1 ; b <- f(a) ; a <- 10 ; b() }
[1] 10
+##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#
+#{ foo <- function(a,b) { x<<-4; b; }; x <- 0; foo(2, x > 2); }
+[1] TRUE
+
+##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#Ignored.ImplementationError#
+#{ foo <- function(x,z) list(x,z); x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x > 5); }
+[[1]]
+[1] 1
+
+[[2]]
+[1] TRUE
+
+
+##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#Ignored.ImplementationError#
+#{ foo <- function(x,z) x + z; x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x); }
+[1] 11
+
##com.oracle.truffle.r.test.functions.TestFunctions.testPromises#
#{ z <- 1 ; f <- function(c = z) { z <- z + 1 ; c } ; f() }
[1] 2
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
index 1d0ce81d3adbe2b139d07ce181a3e3e271998673..e4ef942441105950c326f579a5ab1c438bab18b4 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
@@ -27,6 +27,12 @@ public class TestBuiltin_sysparents extends TestBase {
assertEval("{ f <- function(x) x ; g <- function(y) f(y) ; h <- function(z=sys.parents()) g(z) ; h() }");
assertEval("{ f4 <- function() sys.parents(); f3 <- function(y) y; f2 <- function(x) x; f1 <- function() f2(f3(f4())); f1(); }");
+
+ // FIXME OptForcedEagerPromiseNode causes the promise to be evaluated in different context
+ // than it should be, yielding different results when introspecting the stack
+ assertEval(Ignored.ImplementationError, "{ u <- function() sys.parents(); g <- function(y) y; h <- function(z=u()) g(z); h(); }");
+ assertEval(Ignored.ImplementationError, "{ u <- function() sys.parents(); g <- function(y) y; h <- function(z) g(z); h(u()); }");
+
assertEval(Ignored.ImplementationError, "{ u <- function() sys.parents() ; f <- function(x) x ; g <- function(y) f(y) ; h <- function(z=u()) g(z) ; h() }");
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/functions/TestFunctions.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/functions/TestFunctions.java
index 753308f58bab44b4d5610cdac02aae83f1ffce54..5613553038a141cd7bb2f1c367729716dabd1a2c 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/functions/TestFunctions.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/functions/TestFunctions.java
@@ -4,7 +4,7 @@
* http://www.gnu.org/licenses/gpl-2.0.html
*
* Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2017, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2018, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -213,14 +213,18 @@ public class TestFunctions extends TestBase {
assertEval("{ f <- function(a) { g <- function(b) { a <<- 3; b } ; g(a) } ; x <- 1 ; f(x) }");
assertEval("{ f <- function(x) { function() {x} } ; a <- 1 ; b <- f(a) ; a <- 10 ; b() }");
assertEval("{ f <- function(x = y, y = x) { y } ; f() }");
- assertEval("foo <- function(a,b) { x<<-4; b; }; x <- 0; foo(2, x > 2);");
+ assertEval("{ foo <- function(a,b) { x<<-4; b; }; x <- 0; foo(2, x > 2); }");
// FIXME eager promises bug
// Note: following test fails on the first invocation only, consequent invocations produce
// correct result. The problem is that OptForcedEagerPromiseNode is not creating assumptions
// that variables involved in the eagerly evaluated expression are no being updated in the
// meantime as side effect of evaluation of some other argument.
- assertEval(Ignored.ImplementationError, "foo <- function(x,z) x + z; x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x);");
- assertEval(Ignored.ImplementationError, "foo <- function(x,z) list(x,z); x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x > 5);");
+ assertEval(Ignored.ImplementationError, "{ foo <- function(x,z) x + z; x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x); }");
+ assertEval(Ignored.ImplementationError, "{ foo <- function(x,z) list(x,z); x <- 4; bar <- function() { x <<- 10; 1; }; foo(bar(), x > 5); }");
+ // FIXME eager promises bug2
+ // If eager promise evaluates to another promise, that promise should only be evaluated if
+ // it is again a simple expression without any side effects.
+ assertEval(Ignored.ImplementationError, "{ bar <- function(x, y) { y; x; 42 }; foo <- function(a) bar(a, cat('side2')); foo(cat('side1')) }");
}
@Test