From 0d69d09d74ba9a4a8980a5e1658b7abe40731862 Mon Sep 17 00:00:00 2001
From: Florian Angerer <florian.angerer@oracle.com>
Date: Wed, 4 Oct 2017 12:08:36 +0200
Subject: [PATCH] Removed 'test_isNull' because it caused a crash on GnuR.
---
.../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 | 10 ++++------
5 files changed, 16 insertions(+), 21 deletions(-)
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 2f5a00e578..b4e7c16b80 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
@@ -98,8 +98,8 @@ rffi.iterate_iptr <- function(x) {
.Call("iterate_iptr", x, PACKAGE = "testrffi")
}
-rffi.preserve_object <- function() {
- .Call("preserve_object", PACKAGE = "testrffi")
+rffi.preserve_object <- function(v) {
+ .Call("preserve_object", v, PACKAGE = "testrffi")
}
rffi.release_object <- function(x) {
@@ -192,7 +192,3 @@ rffi.createNativeConnection <- function() {
rffi.parseVector <- function(x) {
.Call('test_ParseVector', x);
}
-
-rffi.isNull <- function(x) {
- .Call('test_isNull', 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 9daac422f9..51107ad6a2 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
@@ -61,7 +61,7 @@ static const R_CallMethodDef CallEntries[] = {
CALLDEF(null, 0),
CALLDEF(iterate_iarray, 1),
CALLDEF(iterate_iptr, 1),
- CALLDEF(preserve_object, 0),
+ CALLDEF(preserve_object, 1),
CALLDEF(release_object, 1),
CALLDEF(findvar, 2),
CALLDEF(test_asReal, 1),
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 a8adfd05dc..3a2abf0fd5 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
@@ -278,9 +278,16 @@ SEXP iterate_iptr(SEXP x) {
return v;
}
-SEXP preserve_object(void) {
+SEXP preserve_object(SEXP val) {
SEXP v;
v = allocVector(INTSXP, 1);
+ int *iv = INTEGER(v);
+ if(LENGTH(val) > 0) {
+ int *ival = INTEGER(val);
+ iv[0] = ival[1];
+ } else {
+ iv[0] = 1234;
+ }
R_PreserveObject(v);
return v;
}
@@ -533,7 +540,3 @@ SEXP test_ParseVector(SEXP src) {
UNPROTECT(2);
return result;
}
-
-Rboolean test_isNull(SEXP x) {
- return Rf_isNull(x);
-}
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 c21517de65..48b2e53621 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
@@ -66,7 +66,7 @@ extern SEXP iterate_iarray(SEXP x);
extern SEXP iterate_iptr(SEXP x);
-extern SEXP preserve_object(void);
+extern SEXP preserve_object(SEXP val);
extern SEXP release_object(SEXP x);
@@ -105,5 +105,3 @@ extern SEXP test_readConnection(SEXP conn);
extern SEXP test_createNativeConnection(void);
extern SEXP test_ParseVector(SEXP src);
-
-extern Rboolean test_isNUll(SEXP x);
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 e889ccad45..c01e673ea3 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
@@ -83,14 +83,12 @@ rffi.parseVector('1+')
# preserve and release object
# using loop to trigger compilation
+preserved_objects <- list()
for(i in seq(5000)) {
- rffi.preserve_object()
+ preserved_objects[[i]] <- rffi.preserve_object(i)
}
for(i in seq(5000)) {
- rffi.release_object()
+ obj <- preserved_objects[[i]]
+ rffi.release_object(obj)
}
-
-# test isNull
-rffi.isNull(NULL)
-
--
GitLab