diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/nodes/IdenticalVisitor.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/nodes/IdenticalVisitor.java index 90cafa94aaac3d440f351bf0a8a81d448c5536b9..a01368e3aea1a0679a4a4098e810d25734a65169 100644 --- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/nodes/IdenticalVisitor.java +++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/nodes/IdenticalVisitor.java @@ -22,6 +22,16 @@ */ package com.oracle.truffle.r.runtime.nodes; +import com.oracle.truffle.api.object.DynamicObject; +import com.oracle.truffle.r.runtime.data.RAttributable; +import com.oracle.truffle.r.runtime.data.RPairList; +import com.oracle.truffle.r.runtime.data.model.RAbstractVector; +import com.oracle.truffle.r.runtime.env.REnvironment; + +/** + * Currently, this visitor is only necessary because we don't treat the body of an RFunction as a + * pairlist. It's slightly inaccurate in how it treats constants, attributes, etc. + */ public final class IdenticalVisitor extends RSyntaxArgVisitor<Boolean, RSyntaxElement> { @Override @@ -41,7 +51,65 @@ public final class IdenticalVisitor extends RSyntaxArgVisitor<Boolean, RSyntaxEl if (!(arg instanceof RSyntaxConstant)) { return false; } - return element.getValue().equals(((RSyntaxConstant) arg).getValue()); + return identicalValue(element.getValue(), ((RSyntaxConstant) arg).getValue()); + } + + private Boolean identicalValue(Object value, Object otherValue) { + if (value instanceof Number || value instanceof String) { + return value.equals(otherValue); + } + if (value instanceof RAttributable) { + if (!(otherValue instanceof RAttributable)) { + return false; + } + if (!identicalAttributes((RAttributable) value, (RAttributable) otherValue)) { + return false; + } + if (!identicalAttributes((RAttributable) otherValue, (RAttributable) value)) { + return false; + } + } + if (value instanceof RAbstractVector) { + RAbstractVector vector = (RAbstractVector) value; + if (!(otherValue instanceof RAbstractVector)) { + return false; + } + RAbstractVector otherVector = (RAbstractVector) otherValue; + if (vector.getLength() != otherVector.getLength() || vector.getRType() != otherVector.getRType()) { + return false; + } + for (int i = 0; i < vector.getLength(); i++) { + if (!identicalValue(vector.getDataAtAsObject(i), otherVector.getDataAtAsObject(i))) { + return false; + } + } + return true; + } + if (value instanceof RPairList && ((RPairList) value).isLanguage()) { + if (!(otherValue instanceof RPairList && ((RPairList) otherValue).isLanguage())) { + return false; + } + return accept(((RPairList) value).getSyntaxElement(), ((RPairList) otherValue).getSyntaxElement()); + } + if (value instanceof REnvironment) { + return value == otherValue; + } + return value == otherValue; + } + + private boolean identicalAttributes(RAttributable attributable, RAttributable otherAttributable) { + DynamicObject attributes = attributable.getAttributes(); + if (attributes != null) { + DynamicObject otherAttributes = otherAttributable.getAttributes(); + for (Object key : attributes.getShape().getKeys()) { + Object attributeValue = attributes.get(key); + Object otherAttributeValue = otherAttributes == null ? null : otherAttributes.get(key); + if ((attributeValue == null) != (otherAttributeValue == null) || !identicalValue(attributeValue, otherAttributeValue)) { + return false; + } + } + } + return true; } @Override 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 28e719055c235dd5c8ca7d1063e7c0edaeee97f6..963736621e0a6dc556d5a01aad82615d703a87df 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 @@ -29927,6 +29927,13 @@ attr(,"Rd_tag") #a <- quote(a(100)); b <- quote(a(101)); identical(a,b) [1] FALSE +##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical# +#e1 <- quote(a+1); e2 <- quote(a+2); identical(e1, e2); e2[[3]] <- c(1,2,3); identical(e1, e2); e1[[3]] <- c(1,2,3); identical(e1, e2); attr(e2[[3]], 'foo') <- 'bar'; identical(e1, e2) +[1] FALSE +[1] FALSE +[1] TRUE +[1] FALSE + ##com.oracle.truffle.r.test.builtins.TestBuiltin_identical.testIdentical# #identical(pairlist(1, pairlist('foo')), pairlist(1, pairlist('bar'))) [1] FALSE 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 d9e8d9df8e8cf413e2485220111a7a477c76ab2a..9aa604764d5d92769baab83b8004a012fb2ccdef 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 @@ -271,6 +271,7 @@ public class TestBuiltin_identical extends TestBase { 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)"); + assertEval("e1 <- quote(a+1); e2 <- quote(a+2); identical(e1, e2); e2[[3]] <- c(1,2,3); identical(e1, e2); e1[[3]] <- c(1,2,3); identical(e1, e2); attr(e2[[3]], 'foo') <- 'bar'; identical(e1, e2)"); } @Test