Contents of NA CharSXPWrapper always return RRuntime.STRING_NA even when its...

Contents of NA CharSXPWrapper always return RRuntime.STRING_NA even when its native contents have been allocated

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

@@ -43,6 +43,12 @@ public final class CharSXPWrapper extends RObject implements RTruffleObject {
     }
 
     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);
     }
 

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,7 @@ rffi.parseVector <- function(x) {
 rffi.RfEvalWithPromiseInPairList <- function() {
     .Call('test_RfEvalWithPromiseInPairList')
 }
+
+rffi.isNAString <- function(x) {
+	.Call('test_isNAString', x)
+}
\ No newline at end of file

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

@@ -82,6 +82,8 @@ static const R_CallMethodDef CallEntries[] = {
         CALLDEF(test_createNativeConnection, 0),
         CALLDEF(test_ParseVector, 1),
         CALLDEF(test_RfEvalWithPromiseInPairList, 0),
+        CALLDEF(test_isNAString, 1),
+        CALLDEF(test_setStringElt, 2),
         {NULL, NULL, 0}
 };
 

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

@@ -357,6 +357,19 @@ 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);
+    }
+}
+
 // 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

@@ -109,3 +109,7 @@ 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);
\ No newline at end of file

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

@@ -25,6 +25,14 @@ 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)))
 
 x <- list(1)
 attr(x, 'myattr') <- 'hello';