diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DoCall.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DoCall.java
index 26ccfa8d3e2b0da508933df384fa89ca3e2ca392..b9cc5811661cdbfc597b6b5e5208ba8f4ec7d4c8 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DoCall.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/DoCall.java
@@ -168,7 +168,7 @@ public abstract class DoCall extends RBuiltinNode.Arg4 implements InternalRSynta
shareObjectNode.execute(argValues[i]);
}
ArgumentsSignature signature = getArgsNames(argsAsList);
- RCaller caller = RCaller.create(virtualFrame, RCallerHelper.createFromArguments(func, new RArgsValuesAndNames(argValues, signature)));
+ RCaller caller = RCaller.createWithInternalParent(virtualFrame, RCallerHelper.createFromArguments(func, new RArgsValuesAndNames(argValues, signature)));
try {
Object resultValue = RContext.getEngine().evalFunction(func, envFrame, caller, false, signature, argValues);
setVisibilityNode.execute(virtualFrame, getVisibility(envFrame));
@@ -246,7 +246,7 @@ public abstract class DoCall extends RBuiltinNode.Arg4 implements InternalRSynta
}
RLanguage lang = RDataFactory.createLanguage(RASTUtils.createCall(ConstantNode.create(function), true, argsSignature, argsConstants).asRNode());
try {
- Object resultValue = RContext.getEngine().eval(lang, env, call);
+ Object resultValue = RContext.getEngine().eval(lang, env, call.withInternalParent());
MaterializedFrame envFrame = env.getFrame();
FrameSlot envVisibilitySlot = FrameSlotChangeMonitor.findOrAddFrameSlot(envFrame.getFrameDescriptor(), RFrameSlot.Visibility, FrameSlotKind.Boolean);
boolean resultVisibility = false;
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
index e7015136cf9bc346213560e8dfd47a03e42c52c3..58e4c4165aee44cee54bf31444e9b3e0ce80dbc0 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
@@ -650,6 +650,8 @@ public class FrameFunctions {
@Specialization(guards = "n == 1")
protected REnvironment parentFrameDirect(VirtualFrame frame, @SuppressWarnings("unused") int n,
@Cached("new()") GetCallerFrameNode getCaller) {
+ // Note: this works even without checking the call#hasInternalParent()
+ // The environment in the arguments array is the right one even after 'do.call'.
return REnvironment.frameToEnvironment(getCaller.execute(frame));
}
@@ -663,7 +665,8 @@ public class FrameFunctions {
promiseProfile.enter();
call = call.getParent();
}
- for (int i = 0; i < n; i++) {
+ int i = 0;
+ while (i < n) {
call = call.getParent();
if (call == null) {
nullCallerProfile.enter();
@@ -673,6 +676,9 @@ public class FrameFunctions {
promiseProfile.enter();
call = call.getParent();
}
+ if (!call.hasInternalParent()) {
+ i++;
+ }
}
nonNullCallerProfile.enter();
// if (RArguments.getDispatchArgs(f) != null && RArguments.getDispatchArgs(f) instanceof
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
index 6771af91b7f7403faed55595e3efe24138cdbb9f..646850b0d719b8394561ccbe10b773bab4f374b1 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2014, 2017, Oracle and/or its affiliates. All rights reserved.
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
*
* This code is free software; you can redistribute it and/or modify it
@@ -35,6 +35,13 @@ public final class RCaller {
public static final RCaller topLevel = RCaller.createInvalid(null);
+ /**
+ * Determines the actual position of the corresponding frame on the execution call stack. When
+ * one follows the {@link RCaller#parent} chain, then the depth is not always decreasing by only
+ * one, the reason are promises, which may be evaluated somewhere deep down the call stack, but
+ * their parent call frame from R prespective could be much higher up the actual execution call
+ * stack.
+ */
private final int depth;
private boolean visibility;
private final RCaller parent;
@@ -43,11 +50,20 @@ public final class RCaller {
* promise evaluation frames).
*/
private final Object payload;
+ /**
+ * Marks those callers whose parent should not be taken into account when iterating R level
+ * frames using e.g. {@code parent.frame()}. This is the case for function invoked through
+ * {@code do.call} -- R pretends that they were called by the caller of {@code do.call} so that
+ * code like {@code eval(formula, parent.frame(2))} gives the same results regardless of whether
+ * the function was invoked directly or through {@code do.call}.
+ */
+ private final boolean parentIsInternal;
- private RCaller(Frame callingFrame, Object nodeOrSupplier) {
+ private RCaller(Frame callingFrame, Object nodeOrSupplier, boolean parentIsInternal) {
this.depth = depthFromFrame(callingFrame);
this.parent = parentFromFrame(callingFrame);
this.payload = nodeOrSupplier;
+ this.parentIsInternal = parentIsInternal;
}
private static int depthFromFrame(Frame callingFrame) {
@@ -58,10 +74,15 @@ public final class RCaller {
return callingFrame == null ? null : RArguments.getCall(callingFrame);
}
- private RCaller(int depth, RCaller parent, Object nodeOrSupplier) {
+ private RCaller(int depth, RCaller parent, Object nodeOrSupplier, boolean parentIsInternal) {
this.depth = depth;
this.parent = parent;
this.payload = nodeOrSupplier;
+ this.parentIsInternal = parentIsInternal;
+ }
+
+ public RCaller withInternalParent() {
+ return new RCaller(depth, parent, payload, true);
}
public int getDepth() {
@@ -72,6 +93,10 @@ public final class RCaller {
return parent;
}
+ public boolean hasInternalParent() {
+ return parentIsInternal;
+ }
+
public RSyntaxElement getSyntaxNode() {
assert payload != null && !(payload instanceof RCaller) : payload == null ? "null RCaller" : "promise RCaller";
return payload instanceof RSyntaxElement ? (RSyntaxElement) payload : (RSyntaxElement) ((Supplier<?>) payload).get();
@@ -90,37 +115,42 @@ public final class RCaller {
}
public static RCaller createInvalid(Frame callingFrame) {
- return new RCaller(callingFrame, null);
+ return new RCaller(callingFrame, null, false);
}
public static RCaller createInvalid(Frame callingFrame, RCaller parent) {
- return new RCaller(depthFromFrame(callingFrame), parent, null);
+ return new RCaller(depthFromFrame(callingFrame), parent, null, false);
}
public static RCaller create(Frame callingFrame, RSyntaxElement node) {
assert node != null;
- return new RCaller(callingFrame, node);
+ return new RCaller(callingFrame, node, false);
}
public static RCaller create(Frame callingFrame, RCaller parent, RSyntaxElement node) {
assert node != null;
- return new RCaller(depthFromFrame(callingFrame), parent, node);
+ return new RCaller(depthFromFrame(callingFrame), parent, node, false);
+ }
+
+ public static RCaller createWithInternalParent(Frame callingFrame, Supplier<RSyntaxElement> supplier) {
+ assert supplier != null;
+ return new RCaller(callingFrame, supplier, true);
}
public static RCaller create(Frame callingFrame, Supplier<RSyntaxElement> supplier) {
assert supplier != null;
- return new RCaller(callingFrame, supplier);
+ return new RCaller(callingFrame, supplier, false);
}
public static RCaller create(Frame callingFrame, RCaller parent, Supplier<RSyntaxElement> supplier) {
assert supplier != null;
- return new RCaller(depthFromFrame(callingFrame), parent, supplier);
+ return new RCaller(depthFromFrame(callingFrame), parent, supplier, false);
}
public static RCaller createForPromise(RCaller originalCaller, Frame frame) {
int newDepth = frame == null ? 0 : RArguments.getDepth(frame);
RCaller originalCall = frame == null ? null : RArguments.getCall(frame);
- return new RCaller(newDepth, originalCaller, originalCall);
+ return new RCaller(newDepth, originalCaller, originalCall, false);
}
public boolean getVisibility() {
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 2e9161bfb56cc72ddf8ebd4b1cb4dd4dacda6e0f..bb19311e0bb716428d512ff0a3cdb108c94138cc 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
@@ -22328,6 +22328,18 @@ Error in (function (x) : object 'foo' not found
#v1 <- as.numeric_version('3.0.0'); v2 <- as.numeric_version('3.1.0'); do.call('<', list(v1, v2))
[1] TRUE
+##com.oracle.truffle.r.test.builtins.TestBuiltin_docall.testDoCall#
+#{ boo <- function(c) ls(parent.frame(2)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(1,2)); bar() }
+[1] "x" "z"
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_docall.testDoCall#
+#{ boo <- function(c) ls(parent.frame(2)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(parse(text='goo()'),2)); bar() }
+[1] "x" "z"
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_docall.testDoCall#
+#{ boo <- function(c) ls(parent.frame(3)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(parse(text='goo()'),2)); baz <- function(bazX) bar(bazX,1); baz(); }
+[1] "bazX"
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_docall.testDoCall#
#{ do.call("+", list(quote(1), 2))}
[1] 3
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_docall.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_docall.java
index c0003b48744895d87218edb6e67044f4c97b3992..e73f114185c995d4a98c52fafe70426c60912b5d 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_docall.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_docall.java
@@ -43,5 +43,9 @@ public class TestBuiltin_docall extends TestBase {
assertEval("{ e <- new.env(); assign('foo', function() 42, e); foo <- function(x) 1; do.call('foo', list(), envir=e); }");
assertEval("{ e <- new.env(); assign('foo', 42, e); foo <- function(x) 1; do.call('foo', list(), envir=e); }");
assertEval("{ do.call('+', list(data.frame(1), data.frame(2)), envir = new.env()); do.call('assign', list('a',2,new.env()), envir = new.env()); }");
+
+ assertEval("{ boo <- function(c) ls(parent.frame(2)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(1,2)); bar() }");
+ assertEval("{ boo <- function(c) ls(parent.frame(2)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(parse(text='goo()'),2)); bar() }");
+ assertEval("{ boo <- function(c) ls(parent.frame(3)); foo <- function(a,b) boo(a); bar <- function(x,z) do.call('foo', list(parse(text='goo()'),2)); baz <- function(bazX) bar(bazX,1); baz(); }");
}
}