From 0da13657ab8642f2e15ad0a6901cd32a6e4ece11 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Thu, 8 Feb 2018 15:51:43 +0100
Subject: [PATCH] Contents of NA CharSXPWrapper always return
RRuntime.STRING_NA even when its native contents have been allocated
---
.../truffle/r/runtime/data/CharSXPWrapper.java | 6 ++++++
.../packages/testrffi/testrffi/R/testrffi.R | 8 ++++++++
.../packages/testrffi/testrffi/src/init.c | 2 ++
.../packages/testrffi/testrffi/src/testrffi.c | 13 +++++++++++++
.../packages/testrffi/testrffi/src/testrffi.h | 4 ++++
.../packages/testrffi/testrffi/tests/simpleTests.R | 8 ++++++++
6 files changed, 41 insertions(+)
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/CharSXPWrapper.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/CharSXPWrapper.java
index 63927cd2d1..b7291cb6a3 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/CharSXPWrapper.java
+++ b/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);
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
index 00e256bf93..2eef27c513 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
+++ b/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
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c
index 8e711c3bbd..d73d58a523 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c
+++ b/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}
};
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
index 04839457c1..d4be694519 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
+++ b/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.
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h
index 2fda956452..9dddb807ee 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h
+++ b/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
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
index edd4098bf3..03204306df 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+++ b/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';
--
GitLab