From 96dd6ac23c9a3eb116f6af880d504a5c6149954f Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Fri, 11 Aug 2017 16:45:25 +0200
Subject: [PATCH] JNI FFI fix: synchronize java and native both ways array
every time we cross boundary.
---
.../fficall/src/jni/Rinternals.c | 8 +-
.../fficall/src/jni/rffiutils.c | 243 +++++++++++++-----
.../fficall/src/jni/rffiutils.h | 13 +-
com.oracle.truffle.r.native/version.source | 2 +-
.../packages/testrffi/testrffi/R/testrffi.R | 4 +
.../packages/testrffi/testrffi/src/init.c | 1 +
.../packages/testrffi/testrffi/src/testrffi.c | 67 +++++
.../packages/testrffi/testrffi/src/testrffi.h | 2 +
.../testrffi/testrffi/tests/simpleTests.R | 19 +-
9 files changed, 284 insertions(+), 75 deletions(-)
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
index 6b96159ed9..87605b88e8 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/Rinternals.c
@@ -366,8 +366,9 @@ SEXP Rf_dimnamesgets(SEXP x, SEXP y) {
SEXP Rf_eval(SEXP expr, SEXP env) {
TRACE(TARGpp, expr, env);
JNIEnv *thisenv = getEnv();
- updateNativeArrays(thisenv);
+ updateJObjects(thisenv);
SEXP result = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, Rf_evalMethodID, expr, env);
+ updateNativeArrays(thisenv);
return checkRef(thisenv, result);
}
@@ -409,7 +410,7 @@ SEXP Rf_getAttrib(SEXP vec, SEXP name) {
SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val) {
TRACE(TARGppp, vec,name, val);
JNIEnv *thisenv = getEnv();
- updateNativeArray(thisenv, val);
+ updateJObject(thisenv, val);
(*thisenv)->CallVoidMethod(thisenv, UpCallsRFFIObject, Rf_setAttribMethodID, vec, name, val);
return val;
}
@@ -1402,12 +1403,13 @@ SEXP Rf_asS4(SEXP x, Rboolean b, int i) {
static SEXP R_tryEvalInternal(SEXP x, SEXP y, int *ErrorOccurred, jboolean silent) {
JNIEnv *thisenv = getEnv();
- updateNativeArrays(thisenv);
+ updateJObjects(thisenv);
jobject tryResult = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, R_tryEvalMethodID, x, y, (int) silent);
// If tryResult is NULL, an error occurred
if (ErrorOccurred) {
*ErrorOccurred = tryResult == NULL;
}
+ updateNativeArrays(thisenv);
return checkRef(thisenv, tryResult);
}
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
index e0de22345a..0049e90276 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.c
@@ -26,7 +26,6 @@
#include <errno.h>
#include <assert.h>
-
/*
* All calls pass through one of the call(N) methods in rfficall.c, which carry the JNIEnv value,
* that needs to be saved for reuse in the many R functions such as Rf_allocVector.
@@ -73,6 +72,8 @@ static int nativeArrayTableHwm;
static int nativeArrayTableLastIndex;
static int nativeArrayTableLength;
static void releaseNativeArray(JNIEnv *env, int index);
+static NativeArrayElem *findNativeArray(JNIEnv *env, SEXP x);
+static void updateNativeArray(JNIEnv *env, int index);
static jfieldID CharSXPWrapperContentsFieldID;
extern jmethodID logNotCharSXPWrapperMethodID;
@@ -215,7 +216,6 @@ void invalidateNativeArray(JNIEnv *env, SEXP oldObj) {
fprintf(traceFile, "invalidateNativeArray(%p): found\n", oldObj);
#endif
releaseNativeArray(env, i);
- nativeArrayTable[i].obj = NULL;
}
}
#if TRACE_NATIVE_ARRAYS
@@ -223,15 +223,52 @@ void invalidateNativeArray(JNIEnv *env, SEXP oldObj) {
#endif
}
-void updateNativeArrays(JNIEnv *env) {
- // We just release the arrays, the up call may change their contents in the R world,
- // so we cannot re-use the native buffers which may be out of sync
+void updateJObjects(JNIEnv *env) {
int oldHwm = nativeArrayTableHwmStack[callDepth - 1];
for (int i = oldHwm; i < nativeArrayTableHwm; i++) {
- releaseNativeArray(env, i);
+ NativeArrayElem cv = nativeArrayTable[i];
+ if (cv.obj != NULL) {
+ updateJObject(env, cv.obj);
+ }
}
}
+// Updates the data on the Java side from the data on the native side
+void updateJObject(JNIEnv *env, SEXP x) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "updateJObject(%p)\n", x);
+#endif
+ NativeArrayElem *cv = findNativeArray(env, x);
+ if (cv != NULL && cv->data != NULL && cv->type != CHARSXP) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "updateJObject(%p): updating\n", x);
+#endif
+ int len = (*env)->GetArrayLength(env, cv->jArray);
+ switch (cv->type) {
+ case INTSXP:
+ (*env)->SetIntArrayRegion(env, cv->jArray, 0, len, cv->data);
+ break;
+ case REALSXP:
+ (*env)->SetDoubleArrayRegion(env, cv->jArray, 0, len, cv->data);
+ break;
+ case RAWSXP:
+ (*env)->SetByteArrayRegion(env, cv->jArray, 0, len, cv->data);
+ break;
+ case LGLSXP: {
+ int *data = (int*) cv->data;
+ jbyte *byteData = malloc(len * sizeof(jbyte));
+ for (int i = 0; i < len; ++i) {
+ byteData[i] = data[i];
+ }
+ (*env)->SetByteArrayRegion(env, cv->jArray, 0, len, byteData);
+ free(byteData);
+ break;
+ }
+ default:
+ fatalError("updateJObject: unexpected type");
+ }
+ }
+}
static NativeArrayElem *findNativeArray(JNIEnv *env, SEXP x) {
if (nativeArrayTableLastIndex < nativeArrayTableHwm) {
@@ -266,22 +303,10 @@ static NativeArrayElem *findNativeArray(JNIEnv *env, SEXP x) {
return NULL;
}
-void updateNativeArray(JNIEnv *env, SEXP x) {
- NativeArrayElem *cv = findNativeArray(env, x);
- void *data = NULL;
- if (cv != NULL) {
- data = cv->data;
- }
-
- if (data != NULL) {
- int len = (*env)->GetArrayLength(env, cv->jArray);
- (*env)->SetByteArrayRegion(env, cv->jArray, 0, len, data);
- }
-}
static void addNativeArray(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, void *data) {
#if TRACE_NATIVE_ARRAYS
- fprintf(traceFile, "addNativeArray(x=%p, t=%p, ix=%d)\n", x, data, nativeArrayTableHwm);
+ fprintf(traceFile, "addNativeArray(x=%p, t=%p, ix=%d, type=%d)\n", x, data, nativeArrayTableHwm, type);
#endif
// check for overflow
if (nativeArrayTableHwm >= nativeArrayTableLength) {
@@ -302,44 +327,22 @@ static void addNativeArray(JNIEnv *env, SEXP x, SEXPTYPE type, void *jArray, voi
nativeArrayTableHwm++;
}
-void *getNativeArray(JNIEnv *thisenv, SEXP x, SEXPTYPE type) {
- NativeArrayElem *cv = findNativeArray(thisenv, x);
- void *data = NULL;
- if (cv != NULL) {
- data = cv->data;
- }
- if (data == NULL) {
- jarray jArray;
- jboolean isCopy;
- switch (type) {
- case INTSXP: {
- jintArray intArray = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, INTEGER_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, intArray);
- data = (*thisenv)->GetIntArrayElements(thisenv, intArray, &isCopy);
- jArray = intArray;
- break;
- }
+static void* extractVectorNativeArray(JNIEnv *thisenv, jarray jArray, SEXPTYPE type) {
+ jboolean isCopy;
+ int len = (*thisenv)->GetArrayLength(thisenv, jArray);
+ switch (type) {
+ case INTSXP:
+ return (*thisenv)->GetIntArrayElements(thisenv, (jintArray) jArray, &isCopy);
- case REALSXP: {
- jdoubleArray doubleArray = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, REAL_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, doubleArray);
- data = (*thisenv)->GetDoubleArrayElements(thisenv, doubleArray, &isCopy);
- jArray = doubleArray;
- break;
- }
+ case REALSXP:
+ return (*thisenv)->GetDoubleArrayElements(thisenv, (jdoubleArray) jArray, &isCopy);
- case RAWSXP: {
- jbyteArray byteArray = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, RAW_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
- data = (*thisenv)->GetByteArrayElements(thisenv, byteArray, &isCopy);
- jArray = byteArray;
- break;
- }
+ case RAWSXP:
+ return (*thisenv)->GetByteArrayElements(thisenv, (jbyteArray) jArray, &isCopy);
case LGLSXP: {
// Special treatment because R FFI wants int* and FastR represents using byte[]
- jbyteArray byteArray = (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, LOGICAL_MethodID, x);
- int len = (*thisenv)->GetArrayLength(thisenv, byteArray);
+ jbyteArray byteArray = (jbyteArray) jArray;
jbyte* internalData = (*thisenv)->GetByteArrayElements(thisenv, byteArray, &isCopy);
int* idata = malloc(len * sizeof(int));
for (int i = 0; i < len; i++) {
@@ -347,31 +350,133 @@ void *getNativeArray(JNIEnv *thisenv, SEXP x, SEXPTYPE type) {
idata[i] = value == 0 ? FALSE : value == 1 ? TRUE : NA_INTEGER;
}
(*thisenv)->ReleaseByteArrayElements(thisenv, byteArray, internalData, JNI_ABORT);
- jArray = byteArray;
- data = idata;
- break;
+ return idata;
}
+ }
+}
- case CHARSXP: {
- jstring string = stringFromCharSXP(thisenv, x);
- data = (void *) stringToChars(thisenv, string);
- jArray = string;
- break;
+static jarray getJArray(JNIEnv *thisenv, SEXP x, SEXPTYPE type) {
+ switch (type) {
+ case INTSXP:
+ return (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, INTEGER_MethodID, x);
+ case REALSXP:
+ return (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, REAL_MethodID, x);
+ case RAWSXP:
+ return (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, RAW_MethodID, x);
+ case LGLSXP:
+ return (*thisenv)->CallObjectMethod(thisenv, UpCallsRFFIObject, LOGICAL_MethodID, x);
+ default:
+ fatalError("getNativeArray: unexpected type");
+ }
+}
+
+void *getNativeArray(JNIEnv *thisenv, SEXP x, SEXPTYPE type) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "getNativeArray(%p)\n", x);
+#endif
+ NativeArrayElem *cv = findNativeArray(thisenv, x);
+ void *data = NULL;
+ if (cv != NULL) {
+ data = cv->data;
+ }
+ if (data == NULL) {
+ jarray jArray;
+ switch (type) {
+ case INTSXP:
+ case REALSXP:
+ case RAWSXP:
+ case LGLSXP: {
+ jArray = getJArray(thisenv, x, type);
+ data = extractVectorNativeArray(thisenv, jArray, type);
+ break;
+ }
+ case CHARSXP: {
+ jstring string = stringFromCharSXP(thisenv, x);
+ data = (void *) stringToChars(thisenv, string);
+ jArray = string;
+ break;
+ }
+ default:
+ fatalError("getNativeArray: unexpected type");
}
+ addNativeArray(thisenv, x, type, jArray, data);
+ }
+ return data;
+}
+
+void updateNativeArrays(JNIEnv *env) {
+ int oldHwm = nativeArrayTableHwmStack[callDepth - 1];
+ for (int i = oldHwm; i < nativeArrayTableHwm; i++) {
+ updateNativeArray(env, i);
+ }
+}
+int getTypeSize(SEXPTYPE type) {
+ switch (type) {
+ case INTSXP:
+ case LGLSXP:
+ return sizeof(jint);
+ case RAWSXP:
+ return sizeof(jbyte);
+ case REALSXP:
+ return sizeof(jdouble);
default:
- fatalError("getNativeArray: unexpected type");
+ fatalError("getNativeArray: unexpected type");
+ }
+}
+static void updateNativeArray(JNIEnv *env, int i) {
+ NativeArrayElem cv = nativeArrayTable[i];
+ if (cv.obj != NULL && cv.type != CHARSXP) {
+ jarray current = getJArray(env, cv.obj, cv.type);
+ if (fast_IsSameObject(current, cv.jArray)) {
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "updateNativeArray(x=%p, t=%p, ix=%d, type=%d): copying data from Java\n", cv.obj, cv.data, i, cv.type);
+#endif
+ // same array, copy back the contents
+ int len = (*env)->GetArrayLength(env, cv.jArray);
+ switch (cv.type) {
+ case INTSXP:
+ (*env)->GetIntArrayRegion(env, cv.jArray, 0, len, cv.data);
+ break;
+ case REALSXP:
+ (*env)->GetDoubleArrayRegion(env, cv.jArray, 0, len, cv.data);
+ break;
+ case RAWSXP:
+ (*env)->GetByteArrayRegion(env, cv.jArray, 0, len, cv.data);
+ break;
+ case LGLSXP: {
+ jbyte *byteData = malloc(len * sizeof(jbyte));
+ (*env)->GetByteArrayRegion(env, cv.jArray, 0, len, byteData);
+ for (int i = 0; i < len; ++i) {
+ ((int*) cv.data)[i] = byteData[i];
+ }
+ free(byteData);
+ break;
+ }
+ default:
+ fatalError("updateJObject: unexpected type");
+ }
+ } else {
+ // not the same array: this could happen if temporary vector got re-used for re-allocated copy.
+ // If the user now attempts at accessing a previously acquired data pointer, it's an error anyway,
+ // We invalidate the native "mirror", it's not reflecting the same jobject, anymore and if user now
+ // attempts to get the data pointer, she should get the right one -- for the new array, not the old one.
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "updateNativeArray(x=%p, t=%p, ix=%d, type=%d): data in Java have changed, invalidating the cached pointer.\n", cv.obj, cv.data, index, cv.type);
+#endif
+ nativeArrayTable[i].obj = NULL;
}
- addNativeArray(thisenv, x, type, jArray, data);
}
- return data;
}
+// Updates the Java counterpart object with the contents of the native array and
+// releases the native array. Use updateJObject to only update the java counterpart,
+// but do not release.
static void releaseNativeArray(JNIEnv *env, int i) {
NativeArrayElem cv = nativeArrayTable[i];
#if TRACE_NATIVE_ARRAYS
- fprintf(traceFile, "releaseNativeArray(x=%p, ix=%d)\n", cv.obj, i);
+ fprintf(traceFile, "releaseNativeArray(x=%p, ix=%d, type=%d)\n", cv.obj, i, cv.type);
#endif
if (cv.obj != NULL) {
assert(isValidJNIRef(env, cv.obj));
@@ -400,8 +505,9 @@ static void releaseNativeArray(JNIEnv *env, int i) {
}
}
+ // note: internalData is used only as temp array here, no need to honor "mode"
(*env)->ReleaseByteArrayElements(env, byteArray, internalData, 0);
- free(data); // was malloc'ed in addNativeArray
+ free(data); // was malloc'ed in addNativeArray
break;
}
@@ -426,14 +532,16 @@ static void releaseNativeArray(JNIEnv *env, int i) {
}
default:
- fatalError("releaseNativeArray type");
+ fatalError("updateManagedVector type");
}
// update complete status
(*env)->CallStaticVoidMethod(env, JNIUpCallsRFFIImplClass, setCompleteMethodID, cv.obj, complete);
- // free up the slot
nativeArrayTable[i].obj = NULL;
}
+#if TRACE_NATIVE_ARRAYS
+ fprintf(traceFile, "updateManagedVector(x=%p, ix=%d): DONE\n", cv.obj, i);
+#endif
}
static SEXP findCachedGlobalRef(JNIEnv *env, SEXP obj) {
@@ -541,6 +649,7 @@ void *unimplemented(char *msg) {
strcpy(buf, "unimplemented ");
strcat(buf, msg);
(*thisenv)->FatalError(thisenv, buf);
+ return NULL;
}
void fatalError(char *msg) {
diff --git a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
index c0942f8f76..077dad811e 100644
--- a/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
+++ b/com.oracle.truffle.r.native/fficall/src/jni/rffiutils.h
@@ -71,13 +71,20 @@ jmp_buf *getErrorJmpBuf();
// the data as a C array
void *getNativeArray(JNIEnv *env, SEXP x, SEXPTYPE type);
// Rare case where an operation changes the internal
-// data and thus the old C array should be invalidated
+// data and thus the old C array should be invalidated,
+// unlike updateJObjects this really frees the native array.
void invalidateNativeArray(JNIEnv *env, SEXP oldObj);
// Should be called before up calling to arbitrary code, e.g. Rf_eval,
-// to copy back the arrays into their Java counterparts
+// to copy back the arrays into their Java counterparts. The native arrays
+// are not freed and stay around.
+void updateJObjects(JNIEnv *env);
+// Should be called after up calling to arbitrary code, e.g. Rf_eval,
+// to copy back the java side arrays into their native counterparts.
void updateNativeArrays(JNIEnv *env);
+
+
// Copies back the array to the Java counterpart
-void updateNativeArray(JNIEnv *env, SEXP obj);
+void updateJObject(JNIEnv *env, SEXP obj);
SEXP addGlobalRef(JNIEnv *env, SEXP obj, int permanent);
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index a787364590..7facc89938 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-34
+36
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 35437998a3..3a42a04a22 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
@@ -172,3 +172,7 @@ rffi.getStringNA <- function() {
rffi.captureDotsWithSingleElement <- function(env) {
.Call('test_captureDotsWithSingleElement', env)
}
+
+rffi.evalAndNativeArrays <- function(vec, expr, env) {
+ .Call('test_evalAndNativeArrays', vec, expr, env)
+}
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 d2179c3af5..4323f77fb0 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
@@ -76,6 +76,7 @@ static const R_CallMethodDef CallEntries[] = {
CALLDEF(test_ATTRIB, 1),
CALLDEF(test_stringNA, 0),
CALLDEF(test_captureDotsWithSingleElement, 1),
+ CALLDEF(test_evalAndNativeArrays, 3),
{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 3c02ded719..9f92cbc5ad 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
@@ -364,3 +364,70 @@ SEXP test_captureDotsWithSingleElement(SEXP env) {
UNPROTECT(1);
return info;
}
+
+SEXP test_evalAndNativeArrays(SEXP vec, SEXP expr, SEXP env) {
+ SEXP symbolValue;
+ int *idata;
+ double *ddata;
+ unsigned char *bdata;
+ // note: we want to evaluate PROTECT(symbolValue = Rf_eval(expr, env)); after we take the pointer to data...
+ switch (TYPEOF(vec)) {
+ case INTSXP:
+ idata = INTEGER(vec);
+ PROTECT(symbolValue = Rf_eval(expr, env));
+ idata[0] = 42;
+ idata[1] = Rf_asInteger(symbolValue);
+ break;
+ case REALSXP:
+ ddata = REAL(vec);
+ PROTECT(symbolValue = Rf_eval(expr, env));
+ ddata[0] = 42;
+ ddata[1] = Rf_asReal(symbolValue);
+ break;
+ case RAWSXP:
+ bdata = RAW(vec);
+ PROTECT(symbolValue = Rf_eval(expr, env));
+ bdata[0] = 42;
+ bdata[1] = Rf_asInteger(symbolValue); // there is no asRaw, we expect to get symbol with integer value
+ break;
+ case LGLSXP:
+ idata = LOGICAL(vec);
+ PROTECT(symbolValue = Rf_eval(expr, env));
+ idata[0] = 1;
+ idata[1] = Rf_asLogical(symbolValue);
+ break;
+ default:
+ printf("Error: unexpected type");
+ }
+
+ // max of the vector could now be 42/TRUE or symbolValue
+ SEXP maxSymbol, call, maxVec;
+ int uprotectCount = 1;
+ if (TYPEOF(vec) != RAWSXP) {
+ // note: max does not support raws
+ PROTECT(maxSymbol = install("max"));
+ PROTECT(call = lang2(maxSymbol, vec));
+ PROTECT(maxVec = eval(call, R_GlobalEnv));
+ uprotectCount = 4;
+ }
+
+ switch (TYPEOF(vec)) {
+ case INTSXP:
+ idata[length(vec) - 1] = Rf_asInteger(maxVec);
+ break;
+ case REALSXP:
+ ddata[length(vec) - 1] = Rf_asReal(maxVec);
+ break;
+ case RAWSXP:
+ bdata[length(vec) - 1] = 42;
+ break;
+ case LGLSXP:
+ idata[length(vec) - 1] = Rf_asLogical(maxVec);
+ break;
+ default:
+ printf("Error: unexpected type");
+ }
+
+ UNPROTECT(uprotectCount);
+ return vec;
+}
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 3228612efb..6b55ae486c 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
@@ -95,3 +95,5 @@ extern SEXP test_ATTRIB(SEXP);
extern SEXP test_stringNA(void);
extern SEXP test_captureDotsWithSingleElement(SEXP env);
+
+extern SEXP test_evalAndNativeArrays(SEXP vec, SEXP expr, SEXP env);
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 8d8dceb5b0..3a8138ae62 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
@@ -43,6 +43,23 @@ promiseInfo <- foo(tmp)
stopifnot('some_unique_name' %in% ls(promiseInfo[[2]]))
eval(promiseInfo[[1]], promiseInfo[[2]])
+# fiddling the pointers to the native arrays: we get data pointer to the first SEXP argument (vec),
+# then put value 42/TRUE directly into it at index 0,
+# value of symbol 'myvar' through Rf_eval at index 1,
+# value of Rf_eval('max(vec)') at the last index (note that the upcall now should take max from the updated vector!)
+env <- new.env()
+env$myvar <- 44L;
+rffi.evalAndNativeArrays(c(1L, 2L, 3L, 4L, 5L), as.symbol('myvar'), env);
+
+env$myvar <- 3.14
+rffi.evalAndNativeArrays(c(1.1, 2.2, 3), as.symbol('myvar'), env);
+
+env$myvar <- T
+rffi.evalAndNativeArrays(c(F, F, F, F), as.symbol('myvar'), env);
+
+env$myvar <- 20L
+rffi.evalAndNativeArrays(as.raw(c(1, 3, 2)), as.symbol('myvar'), env);
+
# legth tests
env <- new.env(); env$a <- 42; env$b <- 44;
rffi.inlined_length(env)
@@ -54,7 +71,7 @@ rffi.inlined_length(expr)
rffi.inlined_length(expr[[1]])
# fails in FastR because DotCall class cannot recognize that the RArgsValuesAndNames
-# are not meant to be extracted into individual arguments, but instead send as is
+# are not meant to be extracted into individual arguments, but instead send as is
# to the native function as SEXP
#
# foo <-function(...) rffi.inlined_length(get('...'))
--
GitLab