names support for RPairList + correct error in UpdateNames

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/UpdateNames.java

@@ -31,6 +31,8 @@ import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
 import com.oracle.truffle.r.nodes.unary.CastStringNode;
 import com.oracle.truffle.r.nodes.unary.CastStringNodeGen;
 import com.oracle.truffle.r.runtime.RBuiltin;
+import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RError.Message;
 import com.oracle.truffle.r.runtime.data.RDataFactory;
 import com.oracle.truffle.r.runtime.data.RNull;
 import com.oracle.truffle.r.runtime.data.RStringVector;
@@ -71,6 +73,8 @@ public abstract class UpdateNames extends RBuiltinNode {
         RAbstractContainer result = (RAbstractContainer) container.getNonShared();
         if (stringVector.getLength() < result.getLength()) {
             stringVector = stringVector.copyResized(result.getLength(), true);
+        } else if (stringVector.getLength() > result.getLength()) {
+            throw RError.error(this, Message.NAMES_LONGER, stringVector.getLength(), result.getLength());
         } else if (stringVector == container) {
             stringVector = (RStringVector) stringVector.copy();
         }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RError.java

@@ -320,6 +320,7 @@ public final class RError extends RuntimeException {
         INVALID_UNNAMED_ARGUMENT("invalid argument"),
         INVALID_UNNAMED_VALUE("invalid value"),
         NAMES_NONVECTOR("names() applied to a non-vector"),
+        NAMES_LONGER("'names' attribute [%d] must be the same length as the vector [%d]"),
         ONLY_FIRST_VARIABLE_NAME("only the first element is used as variable name"),
         INVALID_FIRST_ARGUMENT("invalid first argument"),
         NO_ENCLOSING_ENVIRONMENT("no enclosing environment"),

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

@@ -39,7 +39,7 @@ import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
  *
  * {@code null} is never allowed as a value for the tag, car or cdr, only the type.
  */
-public class RPairList extends RAttributeStorage implements RAbstractContainer {
+public class RPairList extends RSharingAttributeStorage implements RAbstractContainer {
     private Object car = RNull.instance;
     private Object cdr = RNull.instance;
     /**
@@ -77,7 +77,7 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
      */
     @TruffleBoundary
     public static Object create(int size) {
-        assert size > 0 : "a pair list of size = 0 is NULLs";
+        assert size > 0 : "a pair list of size = 0 does not exist, it should be NULL";
         RPairList result = new RPairList();
         for (int i = 1; i < size; i++) {
             RPairList tmp = result;
@@ -125,10 +125,14 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
         for (int i = 0; i < len; i++) {
             data[i] = plt.car();
             if (named) {
-                if (plt.isNullTag()) {
+                Object tag = plt.tag;
+                if (isNull(tag)) {
                     names[i] = RRuntime.NAMES_ATTR_EMPTY_VALUE;
+                } else if (tag instanceof RSymbol) {
+                    names[i] = ((RSymbol) tag).getName();
                 } else {
-                    names[i] = ((RSymbol) plt.getTag()).getName();
+                    names[i] = RRuntime.asString(tag);
+                    assert names[i] != null : "unexpected type of tag in RPairList";
                 }
             }
             if (i < len - 1) {
@@ -251,7 +255,22 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
     }
 
     @Override
-    public RVector getNonShared() {
+    public RShareable copy() {
+        RPairList result = new RPairList();
+        Object original = this;
+        while (!isNull(original)) {
+            RPairList origList = (RPairList) original;
+            result.car = origList.car;
+            result.tag = origList.tag;
+            result.cdr = new RPairList();
+            result = (RPairList) result.cdr;
+            original = origList.cdr;
+        }
+        return result;
+    }
+
+    @Override
+    public RShareable deepCopy() {
         RInternalError.shouldNotReachHere();
         return null;
     }
@@ -300,27 +319,32 @@ public class RPairList extends RAttributeStorage implements RAbstractContainer {
 
     @Override
     public void setNames(RStringVector newNames) {
-        throw RInternalError.shouldNotReachHere();
+        Object p = this;
+        for (int i = 0; i < newNames.getLength() && !isNull(p); i++) {
+            RPairList pList = (RPairList) p;
+            pList.tag = newNames.getDataAt(i);
+            p = pList.cdr;
+        }
     }
 
     @Override
     public RList getDimNames(RAttributeProfiles attrProfiles) {
-        throw RInternalError.shouldNotReachHere();
+        return null;
     }
 
     @Override
     public void setDimNames(RList newDimNames) {
-        throw RInternalError.shouldNotReachHere();
+        throw RInternalError.unimplemented();
     }
 
     @Override
     public Object getRowNames(RAttributeProfiles attrProfiles) {
-        throw RInternalError.shouldNotReachHere();
+        throw RInternalError.unimplemented();
     }
 
     @Override
     public void setRowNames(RAbstractVector rowNames) {
-        throw RInternalError.shouldNotReachHere();
+        throw RInternalError.unimplemented();
     }
 
     @Override

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

@@ -30704,6 +30704,32 @@ NULL
 #argv <- list(structure(list(sec = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), min = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), hour = c(20L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 20L, 20L, 20L, 20L, 19L, 19L, 19L, 20L, 20L, 20L, 19L, 20L, 19L, 19L, 19L, 20L), mday = c(30L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 31L, 30L, 30L, 30L, 30L, 31L, 31L, 31L, 30L, 30L, 30L, 31L, 30L, 31L, 31L, 31L, 30L), mon = c(5L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 5L, 5L, 5L, 5L, 11L, 11L, 11L, 5L, 5L, 5L, 11L, 5L, 11L, 11L, 11L, 5L), year = c(72L, 72L, 73L, 74L, 75L, 76L, 77L, 78L, 79L, 81L, 82L, 83L, 85L, 87L, 89L, 90L, 92L, 93L, 94L, 95L, 97L, 98L, 105L, 108L, 112L), wday = c(5L, 0L, 1L, 2L, 3L, 5L, 6L, 0L, 1L, 2L, 3L, 4L, 0L, 4L, 0L, 1L, 2L, 3L, 4L, 0L, 1L, 4L, 6L, 3L, 6L), yday = c(181L, 365L, 364L, 364L, 364L, 365L, 364L, 364L, 364L, 180L, 180L, 180L, 180L, 364L, 364L, 364L, 181L, 180L, 180L, 364L, 180L, 364L, 364L, 365L, 181L), isdst = c(1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 1L)), .Names = c('sec', 'min', 'hour', 'mday', 'mon', 'year', 'wday', 'yday', 'isdst'), class = c('POSIXlt', 'POSIXt'), tzone = c('', 'EST', 'EDT')));names(argv[[1]]);
 NULL
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesDifferentSize
+#{ l <- list(1,2,3); names(l) <- list('a','b'); l }
+$a
+[1] 1
+
+$b
+[1] 2
+
+$<NA>
+[1] 3
+
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesDifferentSize
+#{ l <- list(1,2,3); names(l) <- list('a','b','c','d'); l }
+Error in names(l) <- list("a", "b", "c", "d") :
+  'names' attribute [4] must be the same length as the vector [3]
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateDimnamesPairlist
+#{ l <- vector('pairlist',2); names(l)<-c('a','b'); l; }
+$a
+NULL
+
+$b
+NULL
+
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_namesassign.testUpdateNames
 #{ x <- 1:2 ; names(x) <- c("hello"); names(x) }
 [1] "hello" NA

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

@@ -112,8 +112,8 @@ public class TestBuiltin_namesassign extends TestBase {
         assertEval("{ x<-c(1, 2); names(x)<-c(\"a\", \"b\"); attr(x, \"names\")<-NULL; x }");
         assertEval("{ x<-c(1, 2); names(x)<-42; x }");
         assertEval("{ x<-c(1, 2); names(x)<-c(TRUE, FALSE); x }");
-        assertEval(Output.IgnoreErrorContext, "{ x<-c(1,2); names(x) <- 42:44; x }");
-        assertEval(Output.IgnoreErrorContext, "{ x<-c(1,2); attr(x, \"names\") <- 42:45; x }");
+        assertEval("{ x<-c(1,2); names(x) <- 42:44; x }");
+        assertEval("{ x<-c(1,2); attr(x, \"names\") <- 42:45; x }");
         assertEval("{ x<-list(1,2); names(x)<-c(\"a\",NA); x }");
         assertEval("{ x<-list(1,2); names(x)<-c(\"a\",\"$\"); x }");
         assertEval("{ x<-list(1,2); names(x)<-c(\"a\",\"b\"); x }");
@@ -137,8 +137,19 @@ public class TestBuiltin_namesassign extends TestBase {
         assertEval("{ x <- c(1,2); names(x) <- c(\"A\", \"B\") ; x + 1 }");
         assertEval("{ x <- 1:2; names(x) <- c(\"A\", \"B\") ; y <- c(1,2,3,4) ; names(y) <- c(\"X\", \"Y\", \"Z\") ; x + y }");
 
-        assertEval(Output.IgnoreErrorContext, "{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\", \"d\")}");
+        assertEval("{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\", \"d\")}");
         assertEval("{ x <- quote(plot(x = age, y = weight)); names(x)<- c(\"\", \"a\", \"b\"); x}");
         assertEval("{ x <- quote(plot(x = age, y = weight)); x$x <- \"random\"; x}");
     }
+
+    @Test
+    public void testUpdateDimnamesDifferentSize() {
+        assertEval("{ l <- list(1,2,3); names(l) <- list('a','b','c','d'); l }"); // longer
+        assertEval("{ l <- list(1,2,3); names(l) <- list('a','b'); l }"); // shorter
+    }
+
+    @Test
+    public void testUpdateDimnamesPairlist() {
+        assertEval("{ l <- vector('pairlist',2); names(l)<-c('a','b'); l; }");
+    }
 }