From fb2b00791964bbcf6972745490f0011eabacc5c8 Mon Sep 17 00:00:00 2001
From: Lukas Stadler <lukas.stadler@oracle.com>
Date: Wed, 21 Mar 2018 17:36:00 +0100
Subject: [PATCH] some fixes and additional tests for identical

---
 .../r/nodes/builtin/base/Identical.java       | 141 +++++++++++-------
 .../truffle/r/test/ExpectedTestOutput.test    |  36 ++++-
 .../com/oracle/truffle/r/test/S4/TestS4.java  |   6 +-
 .../test/builtins/TestBuiltin_identical.java  |  15 +-
 4 files changed, 134 insertions(+), 64 deletions(-)

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 16869c1126..31f0ac3521 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 fe40de84eb..e43dafd831 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 99ca8f6613..5653770c6a 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 ecb854a29a..91b0ccc865 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
-- 
GitLab