[GR-2798] Fix issues with CharSXPWrapper.

PullRequest: fastr/1389

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/interop/CharSXPWrapperMR.java

@@ -71,10 +71,9 @@ public class CharSXPWrapperMR {
 
         protected Object access(CharSXPWrapper receiver, Number indexNum) {
             int index = indexNum.intValue();
-            String contents = receiver.getContents();
-            int len = contents.length();
+            int len = receiver.getLength();
             if (prof1.profile(index < len)) {
-                return contents.charAt(index);
+                return receiver.getByteAt(index);
             } else if (prof2.profile(index == len)) {
                 return 0;
             } else {

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java

 /*
- * Copyright (c) 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, 2018, 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
@@ -91,7 +91,7 @@ public final class MiscNodes {
 
         @Specialization
         protected int length(CharSXPWrapper obj) {
-            return obj.getContents().length();
+            return obj.getLength();
         }
 
         @Specialization

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

@@ -22,6 +22,8 @@
  */
 package com.oracle.truffle.r.runtime.data;
 
+import java.nio.charset.StandardCharsets;
+
 import com.oracle.truffle.r.runtime.RRuntime;
 
 /**
@@ -31,23 +33,37 @@ import com.oracle.truffle.r.runtime.RRuntime;
  * FastR already uses {@code String} to denote a length-1 string vector, it cannot be used to
  * represent a {@code CHARSXP}, so this class exists to do so.
  *
+ * As opposed to Strings on the Java side, the native side "Strings" should be treated as array of
+ * bytes. {@link CharSXPWrapper} wraps the byte array, but does not add the '\0' at the end of it.
+ *
  * N.B. Use limited to RFFI implementations.
  */
 public final class CharSXPWrapper extends RObject implements RTruffleObject {
     private static final CharSXPWrapper NA = new CharSXPWrapper(RRuntime.STRING_NA);
 
     private String contents;
+    private byte[] bytes;
 
     private CharSXPWrapper(String contents) {
         this.contents = contents;
     }
 
     public String getContents() {
+        if (this == NA) {
+            // The NA string may have been moved to the native space if someone called R_CHAR on it,
+            // but on the Java side, it should still look like NA string, i.e. RRuntime.isNA should
+            // be true for its contents
+            return RRuntime.STRING_NA;
+        }
         return NativeDataAccess.getData(this, contents);
     }
 
+    public byte getByteAt(int index) {
+        return NativeDataAccess.getDataAt(this, getBytes(), index);
+    }
+
     public int getLength() {
-        return NativeDataAccess.getDataLength(this, contents);
+        return NativeDataAccess.getDataLength(this, getBytes());
     }
 
     @Override
@@ -65,9 +81,17 @@ public final class CharSXPWrapper extends RObject implements RTruffleObject {
 
     public long allocateNativeContents() {
         try {
-            return NativeDataAccess.allocateNativeContents(this, contents);
+            return NativeDataAccess.allocateNativeContents(this, getBytes());
         } finally {
             contents = null;
+            bytes = null;
+        }
+    }
+
+    private byte[] getBytes() {
+        if (bytes == null && contents != null) {
+            bytes = contents.getBytes(StandardCharsets.UTF_8);
         }
+        return bytes;
     }
 }

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

@@ -147,9 +147,8 @@ public final class NativeDataAccess {
         }
 
         @TruffleBoundary
-        void allocateNative(String source) {
+        void allocateNativeString(byte[] bytes) {
             assert dataAddress == 0;
-            byte[] bytes = source.getBytes(StandardCharsets.US_ASCII);
             dataAddress = UnsafeAdapter.UNSAFE.allocateMemory(bytes.length + 1);
             UnsafeAdapter.UNSAFE.copyMemory(bytes, Unsafe.ARRAY_BYTE_BASE_OFFSET, null, dataAddress, bytes.length);
             UnsafeAdapter.UNSAFE.putByte(dataAddress + bytes.length, (byte) 0); // C strings
@@ -570,9 +569,21 @@ public final class NativeDataAccess {
         }
     }
 
-    static int getDataLength(CharSXPWrapper vector, String data) {
+    static byte getDataAt(CharSXPWrapper vector, byte[] data, int index) {
         if (noCharSXPNative.isValid() || data != null) {
-            return data.length();
+            return data[index];
+        } else {
+            NativeMirror mirror = (NativeMirror) vector.getNativeMirror();
+            long address = mirror.dataAddress;
+            assert address != 0;
+            assert index < mirror.length;
+            return UnsafeAdapter.UNSAFE.getByte(address + index);
+        }
+    }
+
+    static int getDataLength(CharSXPWrapper vector, byte[] data) {
+        if (noCharSXPNative.isValid() || data != null) {
+            return data.length;
         } else {
             NativeMirror mirror = (NativeMirror) vector.getNativeMirror();
             long address = mirror.dataAddress;
@@ -644,13 +655,13 @@ public final class NativeDataAccess {
         return mirror.dataAddress;
     }
 
-    static long allocateNativeContents(CharSXPWrapper vector, String contents) {
+    static long allocateNativeContents(CharSXPWrapper vector, byte[] data) {
         NativeMirror mirror = (NativeMirror) vector.getNativeMirror();
         assert mirror != null;
-        assert mirror.dataAddress == 0 ^ contents == null;
+        assert mirror.dataAddress == 0 ^ data == null;
         if (mirror.dataAddress == 0) {
             noCharSXPNative.invalidate();
-            mirror.allocateNative(contents);
+            mirror.allocateNativeString(data);
         }
         return mirror.dataAddress;
     }

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R

@@ -173,6 +173,10 @@ rffi.getStringNA <- function() {
     .Call("test_stringNA")
 }
 
+rffi.setStringElt <- function(x,y) {
+	.Call("test_setStringElt", x, y)
+}
+
 rffi.captureDotsWithSingleElement <- function(env) {
     .Call('test_captureDotsWithSingleElement', env)
 }
@@ -200,3 +204,11 @@ rffi.parseVector <- function(x) {
 rffi.RfEvalWithPromiseInPairList <- function() {
     .Call('test_RfEvalWithPromiseInPairList')
 }
+
+rffi.isNAString <- function(x) {
+	.Call('test_isNAString', x)
+}
+
+rffi.getBytes <- function(x) {
+	.Call('test_getBytes', x)
+}
\ No newline at end of file

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c

 /*
- * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2018, 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
@@ -82,6 +82,9 @@ static const R_CallMethodDef CallEntries[] = {
         CALLDEF(test_createNativeConnection, 0),
         CALLDEF(test_ParseVector, 1),
         CALLDEF(test_RfEvalWithPromiseInPairList, 0),
+        CALLDEF(test_isNAString, 1),
+        CALLDEF(test_getBytes, 1),
+        CALLDEF(test_setStringElt, 2),
         {NULL, NULL, 0}
 };
 

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c

 /*
- * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2015, 2018, 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
@@ -357,6 +357,33 @@ SEXP test_stringNA(void) {
     return x;
 }
 
+SEXP test_setStringElt(SEXP vec, SEXP elt) {
+    SET_STRING_ELT(vec, 0, STRING_ELT(elt, 0));
+    return vec;
+}
+
+SEXP test_isNAString(SEXP vec) {
+    if (STRING_ELT(vec, 0) == NA_STRING) {
+        return ScalarLogical(1);
+    } else {
+        return ScalarLogical(0);
+    }
+}
+
+SEXP test_getBytes(SEXP vec) {
+    char* bytes = R_CHAR(STRING_ELT(vec, 0));
+    SEXP result;
+    PROTECT(result = allocVector(RAWSXP, Rf_length(STRING_ELT(vec, 0))));
+    unsigned char* resData = RAW(result);
+    int i = 0;
+    while (*bytes != '\0') {
+        resData[i++] = (unsigned char) *bytes;
+        bytes++;
+    }
+    UNPROTECT(1);
+    return result;
+}
+
 // This function is expected to be called only with environment that has single
 // promise value in the '...' variable and this is asserted inside this function.
 // The return value is list with the promises' expression and environment.

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h

@@ -20,6 +20,7 @@
  * or visit www.oracle.com if you need additional information or have any
  * questions.
  */
+
 extern void dotCModifiedArguments(int* len, int* idata, double* rdata, int* ldata, char** cdata);
 
 extern SEXP addInt(SEXP a, SEXP b);
@@ -109,3 +110,9 @@ extern SEXP test_createNativeConnection(void);
 extern SEXP test_ParseVector(SEXP src);
 
 extern SEXP test_RfEvalWithPromiseInPairList(void);
+
+extern SEXP test_isNAString(SEXP vec);
+
+extern SEXP test_setStringElt(SEXP vec, SEXP elt);
+
+extern SEXP test_getBytes(SEXP vec);

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R

@@ -25,6 +25,21 @@ x <- "12345"; rffi.char_length(x)
 
 strVec <- rffi.getStringNA();
 stopifnot(anyNA(strVec))
+stopifnot(rffi.isNAString(strVec))
+rffi.LENGTH(strVec)
+# this will call CHAR(x) on the NA string, which materializes it to native pointer...
+rffi.char_length(strVec)
+strVec <- rffi.setStringElt(c('hello'), as.character(NA))
+stopifnot(anyNA(strVec))
+stopifnot(rffi.isNAString(as.character(NA)))
+
+# Encoding tests
+rffi.getBytes('\u1F602\n')
+# ignored: FastR does not support explicit encoding yet
+# latinEncStr <- '\xFD\xDD\xD6\xF0\n'
+# Encoding(latinEncStr) <- "latin1"
+# rffi.getBytes(latinEncStr)
+rffi.getBytes('hello ascii')
 
 x <- list(1)
 attr(x, 'myattr') <- 'hello';

mx.fastr/copyrights/overrides

@@ -950,6 +950,5 @@ com.oracle.truffle.r.native/gnur/patch/src/main/sort.c,no.copyright
 com.oracle.truffle.r.native/gnur/patch/src/main/xspline.c,no.copyright
 com.oracle.truffle.r.native/gnur/patch/src/nmath/nmath.h,no.copyright
 com.oracle.truffle.r.native/fficall/src/common/rffi_upcalls.h,no.copyright
-com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c,no.copyright
 com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/engine/interop/REnvironmentMRTest.java,no.copyright
 com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/engine/interop/VectorMRTest.java,no.copyright