[GR-15185] Descending sequences were not properly handled in match.

PullRequest: fastr/2001

Author: steve-s

CHANGELOG.md

@@ -1,3 +1,9 @@
+# 1.0 RC 16
+
+Bug fixes:
+
+* `match` worked incorrectly with descending sequences (e.g., `3:1`)
+
 # 1.0 RC 15
 
 * `ActiveBinding` objects do not support the `UNBOX` message anymore

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/fastpaths/IsElementFastPath.java

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2015, 2018, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2019, 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
@@ -85,7 +85,7 @@ protected Byte iselementOne(RAbstractDoubleVector el, RAbstractDoubleVector set,
         return RRuntime.LOGICAL_FALSE;
     }
 
-    @Specialization(guards = "el.getLength() == 1")
+    @Specialization(guards = {"el.getLength() == 1", "set.getStride() >= 0"})
     protected Byte isElementOneSequence(RAbstractDoubleVector el, RIntSequence set,
                     @Cached("createBinaryProfile()") ConditionProfile profile) {
         double element = el.getDataAt(0);

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RDoubleSequence.java

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2013, 2018, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2013, 2019, 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
@@ -69,7 +69,8 @@ public Object getStrideObject() {
         return getStride();
     }
 
-    public double getEnd() {
+    // NOTE: it does not hold that getStart() <= getEnd()!
+    private double getEnd() {
         return start + (getLength() - 1) * stride;
     }
 

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RIntSequence.java

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2013, 2018, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2013, 2019, 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
@@ -88,7 +88,9 @@ public int getStride() {
     }
 
     public int getIndexFor(int element) {
-        if (element < getStart() || element > getEnd()) {
+        int first = Math.min(getStart(), getEnd());
+        int last = Math.max(getStart(), getEnd());
+        if (element < first || element > last) {
             return -1;
         }
         if ((element - getStart()) % getStride() == 0) {
@@ -117,6 +119,7 @@ public String toString() {
         return "[" + start + " - " + getEnd() + "]";
     }
 
+    // NOTE: it does not hold that getStart() <= getEnd()!
     public int getEnd() {
         return start + (getLength() - 1) * stride;
     }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/RStringSequence.java

@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2017, 2018, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, 2019, 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
@@ -127,7 +127,9 @@ public int getIndexFor(String element) {
         String c = element.substring(prefix.length(), element.length() - suffix.length());
         try {
             int current = Integer.parseInt(c);
-            if (current < getStart() || current > getEnd()) {
+            int first = Math.min(getStart(), getEnd());
+            int last = Math.max(getStart(), getEnd());
+            if (current < first || current > last) {
                 return -1;
             }
             if ((current - getStart()) % getStride() == 0) {

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test

@@ -43791,6 +43791,18 @@ integer(0)
 #{ match(c(T,F), c('TRUE', 'FALSE')) }
 [1] 1 2
 
+##com.oracle.truffle.r.test.builtins.TestBuiltin_match.testMatchInSequence#
+#match(1:3, 3:1)
+[1] 3 2 1
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_match.testMatchInSequence#
+#match(1:3, numeric(0))
+[1] NA NA NA
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_match.testMatchInSequence#
+#match(as.character(1:3), as.character(3:1))
+[1] 3 2 1
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_match.testMatchInSequence#
 #{ match(c( 1L, 2L, 3L), seq.int(from=1L, to=10L, by=2L)) }
 [1]  1 NA  2
@@ -78708,6 +78720,9 @@ Warning messages:
 #{z <- 1 ; f <- function(d) { b <- matrix(1:4,nrow=2,ncol=2) ; invisible(b[{z<<-z+1;1},{z<<-z*2;2},drop=z<<-z*10]) }; f(0) ; z; f(1L) ; z}
 [1] 820
 
+##com.oracle.truffle.r.test.builtins.TestBuiltin_subset.testSubsetAssign#
+#{z <- c(3,4,2); z[3:1] <- 3:1;}
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_subset.testSubsetMissing#
 #l <- as.pairlist(list(x='a', y='b')); l[[]]
 NULL

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_match.java

@@ -14,7 +14,7 @@
  * Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  *
  * Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2018, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2019, Oracle and/or its affiliates
  *
  * All rights reserved.
  */
@@ -421,6 +421,10 @@ public void testMatchInSequence() {
         testMatchStringSequence("a", "b");
         testMatchStringSequence("", "b");
         testMatchStringSequence("", "");
+
+        assertEval("match(1:3, 3:1)");
+        assertEval("match(as.character(1:3), as.character(3:1))");
+        assertEval("match(1:3, numeric(0))");
     }
 
     private void testMatchStringSequence(String preffix, String suffix) {

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_subset.java

@@ -210,6 +210,8 @@ public void testSubsetAssign() {
 
         assertEval("{z <- 1 ; f <- function(d) { b <- matrix(1:4,nrow=2,ncol=2) ; invisible(b[[{z<<-z+1;1},{z<<-z*2;2},drop=z<<-z*10]]) }; f(0) ; z; f(1L) ; z}");
         assertEval(Output.IgnoreWarningContext, "{z <- 1 ; f <- function(d) { b <- data.frame(x='a', y='b') ; invisible(b[[{z<<-z+1;1},{z<<-z*2;2},drop=z<<-z*10]]) }; f(0) ; z; f(1L) ; z}");
+
+        assertEval("{z <- c(3,4,2); z[3:1] <- 3:1;}");
     }
 
     @Test