correct treatment for the names of dimnames in vector extract

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java

@@ -272,6 +272,7 @@ final class CachedExtractVectorNode extends CachedVectorNode {
     }
 
     private final ConditionProfile dimNamesNull = ConditionProfile.createBinaryProfile();
+    private final RAttributeProfiles dimnamesNamesProfile = RAttributeProfiles.create();
     private final ValueProfile foundDimNamesProfile = ValueProfile.createClassProfile();
     private final ConditionProfile selectPositionsProfile = ConditionProfile.createBinaryProfile();
     private final ConditionProfile originalDimNamesPRofile = ConditionProfile.createBinaryProfile();
@@ -284,7 +285,18 @@ final class CachedExtractVectorNode extends CachedVectorNode {
 
         int[] newDimensions = new int[dimCount];
         RList originalDimNames = originalTarget.getDimNames(null);
-        Object[] newDimNames = dimNamesNull.profile(originalDimNames == null) ? null : new Object[dimCount];
+        RStringVector originalDimNamesNames;
+        Object[] newDimNames;
+        String[] newDimNamesNames;
+        if (dimNamesNull.profile(originalDimNames == null)) {
+            newDimNames = null;
+            originalDimNamesNames = null;
+            newDimNamesNames = null;
+        } else {
+            newDimNames = new Object[dimCount];
+            originalDimNamesNames = originalDimNames.getNames(dimnamesNamesProfile);
+            newDimNamesNames = originalDimNamesNames == null ? null : new String[dimCount];
+        }
 
         int dimIndex = -1;
         for (int i = 0; i < numberOfDimensions; i++) {
@@ -303,6 +315,9 @@ final class CachedExtractVectorNode extends CachedVectorNode {
                         result = extract(i, (RAbstractStringVector) dataAt, positions[i], positionProfile[i]);
                     }
                     newDimNames[dimIndex] = result;
+                    if (newDimNamesNames != null) {
+                        newDimNamesNames[dimIndex] = originalDimNamesNames.getDataAt(i);
+                    }
                 }
             }
         }
@@ -311,7 +326,7 @@ final class CachedExtractVectorNode extends CachedVectorNode {
             metadataApplied.enter();
             extractedTarget.setDimensions(newDimensions);
             if (newDimNames != null) {
-                extractedTarget.setDimNames(RDataFactory.createList(newDimNames));
+                extractedTarget.setDimNames(RDataFactory.createList(newDimNames, newDimNamesNames == null ? null : RDataFactory.createStringVector(newDimNamesNames, originalDimNames.isComplete())));
             }
         } else if (newDimNames != null && originalDimNamesPRofile.profile(originalDimNames.getLength() > 0)) {
             RAbstractStringVector foundNames = translateDimNamesToNames(positionProfile, originalDimNames, extractedTargetLength, positions);

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

@@ -98481,6 +98481,30 @@ Error in x[[1 + (0+1i)]] <- c(1, 2, 3) : invalid subscript type 'complex'
 #{ x<-list(1,2,3,4); x[[1+1i]]<-integer() }
 Error in x[[1 + (0+1i)]] <- integer() : invalid subscript type 'complex'
+##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testDimnamesNames
+#v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,1,drop=TRUE]
+   bar
+foo x y
+  a 1 3
+  b 2 4
+
+##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testDimnamesNames
+#v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,1]
+   bar
+foo x y
+  a 1 3
+  b 2 4
+
+##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testDimnamesNames
+#v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,2,drop=FALSE]
+, , baz = v
+
+   bar
+foo x y
+  a 5 7
+  b 6 8
+
+
 ##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testDirectAccess
 #{ x<-c(7,42); `[[`(x); }
 Error in x[[]] : no index specified
@@ -107055,7 +107079,7 @@ $X
 [1]  TRUE FALSE  TRUE FALSE
 ##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testUpdateOther
-#{ f <- function(a, i1, i2) {a[i1, i2]}; a <- rep(c('1'),14); dim(a) <- c(2,7); dimnames(a) <- list(c('a','b'), rep('c',7)); temp <- f(a, ,1); dimnames(a) <- list(NULL, rep('c',7)); f(a,,1) }
+#{ f <- function(a, i1, i2) {a[i1, i2]}; a <- rep(c('1'),14); dim(a) <- c(2,7); dimnames(a) <- list(c('a','b'), rep('c',7)); temp <- f(a,,1); dimnames(a) <- list(NULL, rep('c',7)); f(a,,1) }
 [1] "1" "1"
 ##com.oracle.truffle.r.test.library.base.TestSimpleVectors.testUpdateOther

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestSimpleVectors.java

@@ -2355,17 +2355,23 @@ public class TestSimpleVectors extends TestBase {
         assertEval("{ e <- quote(x(y=z)); typeof(e[[2]]) }");
     }
 
-    // Checkstyle: stop
     @Test
     public void testUpdateOther() {
         assertEval("{ a <- c(TRUE, FALSE); b <- c(a=3, b=4); a[b] <- c(TRUE, FALSE); a }");
-        assertEval("{ f <- function(a, i1, i2) {a[i1, i2]}; a <- rep(c('1'),14); dim(a) <- c(2,7); dimnames(a) <- list(c('a','b'), rep('c',7)); temp <- f(a, ,1); dimnames(a) <- list(NULL, rep('c',7)); f(a,,1) }");
+        assertEval("{ f <- function(a, i1, i2) {a[i1, i2]}; a <- rep(c('1'),14); dim(a) <- c(2,7); dimnames(a) <- list(c('a','b'), rep('c',7)); temp <- f(a,,1); dimnames(a) <- list(NULL, rep('c',7)); f(a,,1) }");
         assertEval("{ x<-c(1,2); f<-function() { x<-c(100, 200); x[1]<-4; print(x) } ; f(); x }");
         assertEval("{ x<-c(1,2); f<-function() { x<-c(100, 200); x[1]<<-4; print(x) } ; f(); x }");
 
         assertEval("{ x<-quote(foo(42)); x[character(0)]<-list(); typeof(x) }");
         assertEval("{ x<-as.pairlist(list(7,42)); x[character(0)]<-list(); typeof(x) }");
         assertEval("{ x<-expression(y, z, 7 + 42); x[character(0)]<-list(); typeof(x) }");
+    }
 
+    @Test
+    public void testDimnamesNames() {
+        assertEval("v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,1]");
+        assertEval("v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,2,drop=FALSE]");
+        assertEval("v <- 1:8; dim(v) <- c(2,2,2); dimnames(v) <- list(foo=c('a','b'), bar=c('x','y'), baz=c('u','v')); v[,,1,drop=TRUE]");
     }
+
 }