Add a test for nested FFI calls

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

@@ -58,3 +58,16 @@ rffi.rhome_dir <- function() {
 	.Call("rHomeDir", PACKAGE = "testrffi")
 }
 
+rffi.upcalled <- function(v) {
+	gc()
+	.Call("nestedCall2", PACKAGE = "testrffi", v)
+}
+
+rffi.nested.call1 <- function() {
+	upcall <- quote(rffi.upcalled(v))
+	v <- c(10L, 20L, 30L)
+	env <- new.env()
+	assign("v", v, env)
+	.Call("nestedCall1", PACKAGE = "testrffi", upcall, env)
+}
+

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

@@ -150,7 +150,7 @@ SEXP tryEval(SEXP expr, SEXP env) {
 	}
 	SET_VECTOR_ELT(v, 0, r);
 	SET_VECTOR_ELT(v, 1, ScalarLogical(error));
-	UNPROTECT(v);
+	UNPROTECT(1);
 	return v;
 }
 
@@ -159,3 +159,42 @@ SEXP rHomeDir() {
 	return ScalarString(mkChar(dir));
 }
 
+SEXP nestedCall1(SEXP upcall, SEXP env) {
+	SEXP vec;
+	PROTECT(vec = allocVector(INTSXP, 10));
+	int *vecstar = INTEGER(vec);
+	for (int i = 0; i < 10; i++) {
+		vecstar[i] = i + 1;
+	}
+	SEXP upcallResult = tryEval(upcall, env);
+	int *vecstar2 = INTEGER(vec);
+	int ok = vecstar == vecstar2;
+	if (ok) {
+		for (int i = 0; i < 10; i++) {
+			if (vecstar[i] != i + 1) {
+				ok = 0;
+				break;
+			}
+		}
+	}
+	SEXP result;
+	PROTECT(result = allocVector(VECSXP, 2));
+	SET_VECTOR_ELT(result, 0, upcallResult);
+	SET_VECTOR_ELT(result, 1, ScalarLogical(ok));
+	UNPROTECT(2);
+	return result;
+}
+
+SEXP nestedCall2(SEXP v) {
+	SEXP sumVec;
+	PROTECT(sumVec = allocVector(INTSXP, 1));
+	int len = Rf_length(v);
+	int sum = 0;
+	for (int i = 0; i < len; i++) {
+		sum += INTEGER(v)[i];
+	}
+	INTEGER(sumVec)[0] = sum;
+	UNPROTECT(1);
+	return sumVec;
+}
+