diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Identical.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Identical.java
index 16869c11263c6915809283bef51bf7a624670bdb..31f0ac35210691cbe97075186576185c06b82111 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Identical.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Identical.java
@@ -32,8 +32,8 @@ import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
-import com.oracle.truffle.api.object.DynamicObject;
import com.oracle.truffle.api.interop.TruffleObject;
+import com.oracle.truffle.api.object.DynamicObject;
import com.oracle.truffle.api.profiles.ConditionProfile;
import com.oracle.truffle.r.nodes.attributes.IterableAttributeNode;
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
@@ -46,14 +46,13 @@ import com.oracle.truffle.r.runtime.data.RAttributesLayout;
import com.oracle.truffle.r.runtime.data.RExternalPtr;
import com.oracle.truffle.r.runtime.data.RFunction;
import com.oracle.truffle.r.runtime.data.RInteropScalar;
-import com.oracle.truffle.r.runtime.data.RPairList;
import com.oracle.truffle.r.runtime.data.RListBase;
+import com.oracle.truffle.r.runtime.data.RPairList;
import com.oracle.truffle.r.runtime.data.RS4Object;
import com.oracle.truffle.r.runtime.data.RSymbol;
import com.oracle.truffle.r.runtime.data.model.RAbstractVector;
import com.oracle.truffle.r.runtime.env.REnvironment;
import com.oracle.truffle.r.runtime.nodes.IdenticalVisitor;
-import com.oracle.truffle.r.runtime.nodes.RSyntaxElement;
import com.oracle.truffle.r.runtime.nodes.RSyntaxNode;
/**
@@ -164,14 +163,45 @@ public abstract class Identical extends RBuiltinNode.Arg8 {
}
private byte identicalAttr(RAttributable x, RAttributable y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref) {
- // TODO interpret attribAsSet correctly
DynamicObject xAttributes = x.getAttributes();
DynamicObject yAttributes = y.getAttributes();
- if (xAttributes == null && yAttributes == null) {
+ int xSize = xAttributes == null ? 0 : xAttributes.size();
+ int ySize = yAttributes == null ? 0 : yAttributes.size();
+ if (xSize == 0 && ySize == 0) {
return RRuntime.LOGICAL_TRUE;
- } else if (xAttributes == null || yAttributes == null) {
+ } else if (xSize != ySize) {
return RRuntime.LOGICAL_FALSE;
- } else if (xAttributes.size() == yAttributes.size()) {
+ } else {
+ return identicalAttrInternal(numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref, xAttributes, yAttributes);
+ }
+ }
+
+ @TruffleBoundary
+ private byte identicalAttrInternal(boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref, DynamicObject xAttributes,
+ DynamicObject yAttributes) {
+ if (attribAsSet) {
+ // make sure all attributes from x are in y, with identical values
+ Iterator<RAttributesLayout.RAttribute> xIter = attrIterNodeX.execute(xAttributes).iterator();
+ while (xIter.hasNext()) {
+ RAttributesLayout.RAttribute xAttr = xIter.next();
+ Object yValue = yAttributes.get(xAttr.getName());
+ if (yValue == null) {
+ return RRuntime.LOGICAL_FALSE;
+ }
+ byte res = identicalRecursiveAttr(xAttr.getValue(), yValue, numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref);
+ if (res == RRuntime.LOGICAL_FALSE) {
+ return RRuntime.LOGICAL_FALSE;
+ }
+ }
+ // make sure all attributes from y are in x
+ Iterator<RAttributesLayout.RAttribute> yIter = attrIterNodeY.execute(yAttributes).iterator();
+ while (xIter.hasNext()) {
+ RAttributesLayout.RAttribute yAttr = yIter.next();
+ if (!xAttributes.containsKey(yAttr.getName())) {
+ return RRuntime.LOGICAL_FALSE;
+ }
+ }
+ } else {
Iterator<RAttributesLayout.RAttribute> xIter = attrIterNodeX.execute(xAttributes).iterator();
Iterator<RAttributesLayout.RAttribute> yIter = attrIterNodeY.execute(yAttributes).iterator();
while (xIter.hasNext()) {
@@ -185,9 +215,8 @@ public abstract class Identical extends RBuiltinNode.Arg8 {
return RRuntime.LOGICAL_FALSE;
}
}
- return RRuntime.LOGICAL_TRUE;
}
- return RRuntime.LOGICAL_FALSE;
+ return RRuntime.LOGICAL_TRUE;
}
@SuppressWarnings("unused")
@@ -204,20 +233,6 @@ public abstract class Identical extends RBuiltinNode.Arg8 {
return RRuntime.asLogical(x.getName() == y.getName());
}
- @Specialization(guards = {"x.isLanguage()", "y.isLanguage()"})
- @TruffleBoundary
- protected byte doInternalIdentical(RPairList x, RPairList y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref) {
- if (x == y) {
- return RRuntime.LOGICAL_TRUE;
- }
- RSyntaxElement xNode = x.getSyntaxElement();
- RSyntaxElement yNode = y.getSyntaxElement();
- if (!new IdenticalVisitor().accept(xNode, yNode)) {
- return RRuntime.LOGICAL_FALSE;
- }
- return identicalAttr(x, y, numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref);
- }
-
@Specialization
byte doInternalIdentical(RFunction x, RFunction y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref) {
if (x == y) {
@@ -299,49 +314,65 @@ public abstract class Identical extends RBuiltinNode.Arg8 {
return RRuntime.asLogical(x.getAddr() == y.getAddr());
}
- @Specialization(guards = {"!x.isLanguage()", "!y.isLanguage()"})
+ @Specialization
+ @TruffleBoundary
protected byte doInternalIdenticalGeneric(RPairList x, RPairList y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref) {
- if (identicalRecursive(x.car(), y.car(), numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref) == RRuntime.LOGICAL_FALSE) {
- return RRuntime.LOGICAL_FALSE;
+ if (x == y) {
+ return RRuntime.LOGICAL_TRUE;
}
- Object tmpXCdr = x.cdr();
- Object tmpYCdr = y.cdr();
- while (true) {
- if (RPairList.isNull(tmpXCdr) && RPairList.isNull(tmpYCdr)) {
- break;
- } else if (RPairList.isNull(tmpXCdr) || RPairList.isNull(tmpYCdr)) {
+ boolean xHasClosure = x.hasClosure();
+ boolean yHasClosure = y.hasClosure();
+ try {
+ if (identicalRecursive(x.car(), y.car(), numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref) == RRuntime.LOGICAL_FALSE) {
return RRuntime.LOGICAL_FALSE;
- } else {
- RPairList xSubList = (RPairList) tmpXCdr;
- RPairList ySubList = (RPairList) tmpYCdr;
-
- if (RPairList.isNull(xSubList.getTag()) && RPairList.isNull(ySubList.getTag())) {
+ }
+ Object tmpXCdr = x.cdr();
+ Object tmpYCdr = y.cdr();
+ while (true) {
+ if (RPairList.isNull(tmpXCdr) && RPairList.isNull(tmpYCdr)) {
break;
- } else if (RPairList.isNull(xSubList.getTag()) || RPairList.isNull(ySubList.getTag())) {
+ } else if (RPairList.isNull(tmpXCdr) || RPairList.isNull(tmpYCdr)) {
return RRuntime.LOGICAL_FALSE;
} else {
- if (xSubList.getTag() instanceof RSymbol && ySubList.getTag() instanceof RSymbol) {
- String xTagName = ((RSymbol) xSubList.getTag()).getName();
- String yTagName = ((RSymbol) ySubList.getTag()).getName();
- assert Utils.isInterned(xTagName) && Utils.isInterned(yTagName);
- if (xTagName != yTagName) {
- return RRuntime.LOGICAL_FALSE;
- }
+ RPairList xSubList = (RPairList) tmpXCdr;
+ RPairList ySubList = (RPairList) tmpYCdr;
+
+ if (RPairList.isNull(xSubList.getTag()) && RPairList.isNull(ySubList.getTag())) {
+ // continue
+ } else if (RPairList.isNull(xSubList.getTag()) || RPairList.isNull(ySubList.getTag())) {
+ return RRuntime.LOGICAL_FALSE;
} else {
- RInternalError.unimplemented("non-RNull and non-RSymbol pairlist tags are not currently supported");
+ if (xSubList.getTag() instanceof RSymbol && ySubList.getTag() instanceof RSymbol) {
+ String xTagName = ((RSymbol) xSubList.getTag()).getName();
+ String yTagName = ((RSymbol) ySubList.getTag()).getName();
+ assert Utils.isInterned(xTagName) && Utils.isInterned(yTagName);
+ if (xTagName != yTagName) {
+ return RRuntime.LOGICAL_FALSE;
+ }
+ } else {
+ throw RInternalError.unimplemented("non-RNull and non-RSymbol pairlist tags are not currently supported");
+ }
}
+ if (identicalRecursive(xSubList.car(), ySubList.car(), numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref) == RRuntime.LOGICAL_FALSE) {
+ return RRuntime.LOGICAL_FALSE;
+ }
+ if (xSubList.getAttributes() != null || ySubList.getAttributes() != null) {
+ throw RInternalError.unimplemented("attributes of internal pairlists are not currently supported");
+ }
+ tmpXCdr = ((RPairList) tmpXCdr).cdr();
+ tmpYCdr = ((RPairList) tmpYCdr).cdr();
}
- if (identicalRecursive(xSubList.car(), ySubList.car(), numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref) == RRuntime.LOGICAL_FALSE) {
- return RRuntime.LOGICAL_FALSE;
- }
- if (xSubList.getAttributes() != null || ySubList.getAttributes() != null) {
- RInternalError.unimplemented("attributes of internal pairlists are not currently supported");
- }
- tmpXCdr = ((RPairList) tmpXCdr).cdr();
- tmpYCdr = ((RPairList) tmpYCdr).cdr();
+ }
+ return identicalAttr(x, y, numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref);
+ } finally {
+ // if they were closures before, they can still be afterwards
+ if (xHasClosure) {
+ x.allowClosure();
+ }
+ if (yHasClosure) {
+ y.allowClosure();
}
}
- return identicalAttr(x, y, numEq, singleNA, attribAsSet, ignoreBytecode, ignoreEnvironment, ignoreSrcref);
}
@SuppressWarnings("unused")
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 fe40de84ebfa5c2d5ca4bec3f994027848833778..e43dafd831ed72459b3cdb1aed5adeab6dbcc832 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
@@ -528,7 +528,7 @@ Use showMethods("gen") for currently available ones.
[1] 42
[1] 42
-##com.oracle.truffle.r.test.S4.TestS4.testMethods#Ignored.OutputFormatting#
+##com.oracle.truffle.r.test.S4.TestS4.testMethods#
#{ setClass("foo"); setMethod("diag<-", "foo", function(x, value) 42); removeMethod("diag<-", "foo"); removeGeneric("diag<-"); removeClass("foo") }
Creating a generic function for ‘diag<-’ from package ‘base’ in the global environment
[1] TRUE
@@ -549,7 +549,7 @@ Note: method with signature ‘A2#A1’ chosen for function ‘foo’,
#{ setClass('A1', representation(a='numeric')); setMethod('length', 'A1', function(x) x@a); obj <- new('A1'); obj@a <- 10; length(obj) }
[1] 10
-##com.oracle.truffle.r.test.S4.TestS4.testMethods#Ignored.OutputFormatting#
+##com.oracle.truffle.r.test.S4.TestS4.testMethods#
#{ setClass('A2', representation(a = 'numeric')); setMethod('rep', 'A2', function(x, a, b, c) { c(x@a, a, b, c) }); setMethod('ifelse', c(yes = 'A2'), function(test, yes, no) print(test)) }
Creating a generic function for ‘ifelse’ from package ‘base’ in the global environment
[1] "ifelse"
@@ -28269,7 +28269,7 @@ Error: atomic vector arguments only
function (x = 4)
x + 1
-##com.oracle.truffle.r.test.builtins.TestBuiltin_function.testFunctionFunction#Output.IgnoreErrorContext#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_function.testFunctionFunction#
#eval(call('function', 1, expression(x + 1)[[1]]))
Error in eval(call("function", 1, expression(x + 1)[[1]])) :
invalid formal argument list for "function"
@@ -29823,7 +29823,7 @@ attr(,"Rd_tag")
##com.oracle.truffle.r.test.builtins.TestBuiltin_icuSetCollate.testicuSetCollate1#Ignored.Unimplemented#
# .Internal(icuSetCollate())
-##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testAttrOrder#Ignored.ImplementationError#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testAttrOrder#
#x <- 1; y <- 1; attr(x, "f") <- 2; attr(x, "g") <- 1; attr(y, "g") <- 1; attr(y, "f") <- 2; identical(x, y)
[1] TRUE
@@ -29891,6 +29891,34 @@ attr(,"Rd_tag")
#identical(NaN, NaN, num.eq=T, single.NA=T)
[1] TRUE
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(100)); attr(a[[2]], 'foo') <- 'bar'; b[[2]] <- a[[2]]; identical(a,b)
+[1] TRUE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(100)); attr(a[[2]], 'foo') <- 'bar'; identical(a,b)
+[1] FALSE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(100)); attr(b[[2]], 'foo') <- 'bar'; attr(a[[2]], 'foo') <- 'bar'; identical(a,b)
+[1] TRUE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(100)); attr(b[[2]], 'foo') <- 'baz'; attr(a[[2]], 'foo') <- 'bar'; identical(a,b)
+[1] FALSE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(100)); identical(a,b)
+[1] TRUE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#a <- quote(a(100)); b <- quote(a(101)); identical(a,b)
+[1] FALSE
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
+#identical(pairlist(1, pairlist('foo')), pairlist(1, pairlist('bar')))
+[1] FALSE
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical#
#{ f1 <- function() {}; f2 <- function() {}; identical(f1, f2) }
[1] TRUE
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 99ca8f66137a0c410811a662e369da7c56e20b15..5653770c6af61e4610411b9ae957cc356f42a7cc 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
@@ -121,8 +121,7 @@ public class TestS4 extends TestRBase {
assertEval("{ setGeneric(\"gen\", function(o) standardGeneric(\"gen\")); res<-print(setGeneric(\"gen\", function(o) standardGeneric(\"gen\"))); removeGeneric(\"gen\"); res }");
- assertEval(Ignored.OutputFormatting,
- "{ setClass(\"foo\"); setMethod(\"diag<-\", \"foo\", function(x, value) 42); removeMethod(\"diag<-\", \"foo\"); removeGeneric(\"diag<-\"); removeClass(\"foo\") }");
+ assertEval("{ setClass(\"foo\"); setMethod(\"diag<-\", \"foo\", function(x, value) 42); removeMethod(\"diag<-\", \"foo\"); removeGeneric(\"diag<-\"); removeClass(\"foo\") }");
assertEval("{ setClass('A'); setClass('A1', contains = 'A'); setClass('A2', contains = 'A1'); setGeneric('foo', function(a, b) standardGeneric('foo')); setMethod('foo', signature('A1', 'A2'), function(a, b) '1-2'); setMethod('foo', signature('A2', 'A1'), function(a, b) '2-1'); foo(new('A2'), new('A2')) }");
@@ -130,8 +129,7 @@ public class TestS4 extends TestRBase {
assertEval("{ setClass('A1', representation(a='numeric')); setMethod('length', 'A1', function(x) x@a); obj <- new('A1'); obj@a <- 10; length(obj) }");
- assertEval(Ignored.OutputFormatting,
- "{ setClass('A2', representation(a = 'numeric')); setMethod('rep', 'A2', function(x, a, b, c) { c(x@a, a, b, c) }); setMethod('ifelse', c(yes = 'A2'), function(test, yes, no) print(test)) }");
+ assertEval("{ setClass('A2', representation(a = 'numeric')); setMethod('rep', 'A2', function(x, a, b, c) { c(x@a, a, b, c) }); setMethod('ifelse', c(yes = 'A2'), function(test, yes, no) print(test)) }");
}
@Test
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_identical.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_identical.java
index ecb854a29ac5e63c7d73d1ea071155f655d4ab3c..91b0ccc8659fd288fba783476c689ea9c72d6c30 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_identical.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_identical.java
@@ -202,7 +202,7 @@ public class TestBuiltin_identical extends TestBase {
@Test
public void testAttrOrder() {
- assertEval(Ignored.ImplementationError, "x <- 1; y <- 1; attr(x, \"f\") <- 2; attr(x, \"g\") <- 1; attr(y, \"g\") <- 1; attr(y, \"f\") <- 2; identical(x, y)");
+ assertEval("x <- 1; y <- 1; attr(x, \"f\") <- 2; attr(x, \"g\") <- 1; attr(y, \"g\") <- 1; attr(y, \"f\") <- 2; identical(x, y)");
}
@Test
@@ -258,6 +258,19 @@ public class TestBuiltin_identical extends TestBase {
assertEval("{ f1 <- function() {}; f2 <- function() {}; identical(f1, f2) }");
assertEval("{ identical(function() 42, function() 42) }");
+
+ // pairlists
+
+ assertEval("identical(pairlist(1, pairlist('foo')), pairlist(1, pairlist('bar')))");
+
+ // language
+
+ assertEval("a <- quote(a(100)); b <- quote(a(101)); identical(a,b)");
+ assertEval("a <- quote(a(100)); b <- quote(a(100)); identical(a,b)");
+ assertEval("a <- quote(a(100)); b <- quote(a(100)); attr(a[[2]], 'foo') <- 'bar'; identical(a,b)");
+ assertEval("a <- quote(a(100)); b <- quote(a(100)); attr(a[[2]], 'foo') <- 'bar'; b[[2]] <- a[[2]]; identical(a,b)");
+ assertEval("a <- quote(a(100)); b <- quote(a(100)); attr(b[[2]], 'foo') <- 'baz'; attr(a[[2]], 'foo') <- 'bar'; identical(a,b)");
+ assertEval("a <- quote(a(100)); b <- quote(a(100)); attr(b[[2]], 'foo') <- 'bar'; attr(a[[2]], 'foo') <- 'bar'; identical(a,b)");
}
@Test