diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/methods/MethodsListDispatch.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/methods/MethodsListDispatch.java index 15024aa6274a18607b024c96010739fb926e2c38..24ccf148b3164dbc2e6d0e8843534e1e951abfd3 100644 --- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/methods/MethodsListDispatch.java +++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/methods/MethodsListDispatch.java @@ -44,6 +44,7 @@ import com.oracle.truffle.r.runtime.ArgumentsSignature; import com.oracle.truffle.r.runtime.PrimitiveMethodsInfo; import com.oracle.truffle.r.runtime.PrimitiveMethodsInfo.MethodCode; import com.oracle.truffle.r.runtime.RError; +import com.oracle.truffle.r.runtime.RError.Message; import com.oracle.truffle.r.runtime.RInternalError; import com.oracle.truffle.r.runtime.RRuntime; import com.oracle.truffle.r.runtime.context.RContext; @@ -189,10 +190,13 @@ public class MethodsListDispatch { return RRuntime.asLogical(prev); } boolean value = RRuntime.fromLogical(onOff); - RContext.getInstance().setMethodTableDispatchOn(value); - if (value != prev) { - // TODO + if (!value) { + warning(Message.GENERIC, "FastR does not support R_set_method_dispatch(FALSE) yet. S4 dispatch may not work correctly."); } + // StandardGeneric, the default one (true case) is currently implemented in FastR, + // the other one is in GnuR implemented by R_standardGeneric and is not implemented + // in FastR yet. + RContext.getInstance().setMethodTableDispatchOn(value); return RRuntime.asLogical(prev); } } diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/DispatchGeneric.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/DispatchGeneric.java index 4098d1e5d501124ac77f8186066ce82ecb77dcb9..7b425b9f8fac56ae5a24ce3e17564e472dd0e378 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/DispatchGeneric.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/objects/DispatchGeneric.java @@ -23,7 +23,9 @@ import com.oracle.truffle.api.profiles.ValueProfile; import com.oracle.truffle.r.nodes.RASTUtils; import com.oracle.truffle.r.nodes.access.variables.LocalReadVariableNode; import com.oracle.truffle.r.nodes.access.variables.ReadVariableNode; +import com.oracle.truffle.r.nodes.helpers.InheritsCheckNode; import com.oracle.truffle.r.runtime.RCaller; +import com.oracle.truffle.r.runtime.RRuntime; import com.oracle.truffle.r.runtime.context.RContext; import com.oracle.truffle.r.runtime.data.RFunction; import com.oracle.truffle.r.runtime.data.RStringVector; @@ -39,6 +41,7 @@ public abstract class DispatchGeneric extends RBaseNode { private final BranchProfile equalsMethodRequired = BranchProfile.create(); @Child private LoadMethod loadMethod = LoadMethodNodeGen.create(); @Child private ExecuteMethod executeMethod = new ExecuteMethod(); + @Child private InheritsCheckNode inheritsInternalDispatchCheckNode; @TruffleBoundary private static String createMultiDispatchString(RStringVector classes) { @@ -75,9 +78,11 @@ public abstract class DispatchGeneric extends RBaseNode { RFunction currentFunction = ReadVariableNode.lookupFunction(".InheritForDispatch", methodsEnv.getFrame(), true, true); method = (RFunction) RContext.getEngine().evalFunction(currentFunction, frame.materialize(), RCaller.create(frame, RASTUtils.getOriginalCall(this)), true, null, classes, fdef, mtable); } + if (method.isBuiltin() || getInheritsInternalDispatchCheckNode().execute(method)) { + return RRuntime.DEFERRED_DEFAULT_MARKER; + } method = loadMethod.executeRFunction(frame, method, fname); - Object ret = executeMethod.executeObject(frame, method, fname); - return ret; + return executeMethod.executeObject(frame, method, fname); } @SuppressWarnings("unused") @@ -116,4 +121,12 @@ public abstract class DispatchGeneric extends RBaseNode { } return false; } + + private InheritsCheckNode getInheritsInternalDispatchCheckNode() { + if (inheritsInternalDispatchCheckNode == null) { + CompilerDirectives.transferToInterpreterAndInvalidate(); + inheritsInternalDispatchCheckNode = insert(new InheritsCheckNode("internalDispatchMethod")); + } + return inheritsInternalDispatchCheckNode; + } } 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 53c9acfb6a5dc21413f496e478e766e3f0eabc54..74a999b0e6421c67c4d4b553ab79d6446de14898 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 @@ -467,6 +467,10 @@ Class "optionalMethod", by class "standardGeneric", distance 5 #{ x<-42; y<-asS4(x); isS4(y) } [1] TRUE +##com.oracle.truffle.r.test.S4.TestS4.testDispatchToS3ForBuiltins# +#{ setClass('TestS4S31', representation(f = 'numeric')); p <- new('TestS4S31', f = 2); `$.TestS4S31` <- function(...) 42; p$field } +[1] 42 + ##com.oracle.truffle.r.test.S4.TestS4.testInternalDispatch# #setClass('foo', representation(d='numeric')); setMethod(`$`, signature('foo'), function(x, name) 'FOO'); obj <- new('foo'); obj$asdf [1] "$" @@ -159462,10 +159466,6 @@ Error: 'R_get_primname' called on a non-primitive #.Call(methods:::C_R_set_method_dispatch, TRUE) [1] TRUE -##com.oracle.truffle.r.test.library.stats.TestExternal_R_set_method_dispatch.testSetMethodDispatch# -#.Call(methods:::C_R_set_method_dispatch, c(FALSE,TRUE)) -[1] TRUE - ##com.oracle.truffle.r.test.library.stats.TestExternal_Rmd5.testRmd5# #.Call(tools:::Rmd5, "abc") Error in get(name, envir = asNamespace(pkg), inherits = FALSE) : diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java index ea788cf63789d1295563395836e4c9f96acee6d6..d660c79947e21c355d7ccf9d95220e8a66c8e9a9 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java @@ -195,4 +195,9 @@ public class TestS4 extends TestRBase { assertEval("{ setClass('TestS4CornerCases', representation(fld = 'character')); obj <- new('TestS4CornerCases', fld = 'xyz'); attr(obj, '.Data') <- new.env(); obj$fld2 <- 'value'; list(obj, as.list(attr(obj, '.Data')), obj$fld2); }"); assertEval("{ setClass('TestS4CornerCases', representation(fld = 'character')); obj <- new('TestS4CornerCases', fld = 'xyz'); attr(obj, '.xData') <- new.env(); obj$fld2 <- 'value'; list(obj, as.list(attr(obj, '.xData')), obj$fld2); }"); } + + @Test + public void testDispatchToS3ForBuiltins() { + assertEval("{ setClass('TestS4S31', representation(f = 'numeric')); p <- new('TestS4S31', f = 2); `$.TestS4S31` <- function(...) 42; p$field }"); + } } diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestExternal_R_set_method_dispatch.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestExternal_R_set_method_dispatch.java index 732977bf7c1cd8b4c5e3368bb8ef3bac2f24d356..79019189b1d23941a26563dc2ac428395ecc4412 100644 --- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestExternal_R_set_method_dispatch.java +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestExternal_R_set_method_dispatch.java @@ -31,7 +31,6 @@ public class TestExternal_R_set_method_dispatch extends TestBase { @Test public void testSetMethodDispatch() { assertEval(".Call(methods:::C_R_set_method_dispatch, TRUE)"); - assertEval(".Call(methods:::C_R_set_method_dispatch, c(FALSE,TRUE))"); assertEval(".Call(methods:::C_R_set_method_dispatch, NULL)"); assertEval(".Call(methods:::C_R_set_method_dispatch, 1)"); }