diff --git a/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c index db517f214df9efa9a74ba59adb4ef0b0d1d134d1..d24ede22e8ff59f781ec40d4ed4c801834f32593 100644 --- a/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c +++ b/com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c @@ -1,5 +1,5 @@ /* - * Copyright (c) 2015, 2017, Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015, 2018, Oracle and/or its affiliates. All rights reserved. * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. * * This code is free software; you can redistribute it and/or modify it @@ -113,9 +113,16 @@ void *DATAPTR(SEXP x) { return LOGICAL(x); } else if (type == RAWSXP) { return RAW(x); - } else { - printf("DATAPTR %d\n", type); - unimplemented("R_DATAPTR"); + } else if (type == CPLXSXP) { + return COMPLEX(x); + } else if (type == CHARSXP) { + return R_CHAR(x); + } else if (type == STRSXP) { + printf("FastR does not support DATAPTR macro with character vectors, please use SET_STRING_ELT or STRING_ELT.\n"); + exit(1); + } else { + printf("DATAPTR macro with SEXPTYPE %d is not supported.\n", type); + exit(1); return NULL; } } 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 54ea96bf5f5a82e7093176791cf6ca7e3a22ae1b..0d07fac889f420d4143ffa794425bbf00b407b76 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 @@ -224,3 +224,7 @@ rffi.RfRMultinom <- function() { rffi.RfFunctions <- function() { .Call('test_RfFunctions') } + +rffi.testDATAPTR <- function(strings, testSingleString) { + .Call('test_DATAPTR', strings, testSingleString) +} \ 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 38516b5c985d12622de2a71410fc211ce1cfe1bc..58ee3bacce70c154af7728843113ad25b044eb36 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 @@ -90,6 +90,7 @@ static const R_CallMethodDef CallEntries[] = { CALLDEF(test_RfRandomFunctions, 0), CALLDEF(test_RfRMultinom, 0), CALLDEF(test_RfFunctions, 0), + CALLDEF(test_DATAPTR, 2), #include "init_api.h" {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 0229801217f7e7e634efaa177983756a83f279de..1fb610c2ae7ed3e8a90f1fa6f6c7213249b5e132 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 @@ -23,11 +23,11 @@ // A very simple test of the R FFI interface +#define USE_RINTERNALS #include <R.h> #include <Rdefines.h> #include <Rinterface.h> #include <Rinternals.h> -#include <Rinterface.h> #include <Rmath.h> #include <R_ext/Connections.h> #include <R_ext/Parse.h> @@ -718,3 +718,18 @@ SEXP test_RfFunctions() { return v; } +SEXP test_DATAPTR(SEXP strings, SEXP testSingleChar) { + if (asLogical(testSingleChar)) { + void* data = DATAPTR(STRING_ELT(strings, 0)); + printf("DATAPTR(STRING_ELT(strings, 0)) == '%s'\n", (char *)data); + } else { + // pointer to CHARSXP array + void* data = DATAPTR(strings); + for (int i = 0; i < LENGTH(strings); ++i) { + printf("DATAPTR(strings)[%d] == '%s'\n", i, R_CHAR(((SEXP*)data)[i])); + } + } + fflush(stdout); + return R_NilValue; +} + 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 eac32181f622ef057d201fd6774f77ca07455f2e..56b758f24ada124ca59102f4b322caa27e275b1e 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 @@ -122,3 +122,5 @@ extern SEXP test_RfRandomFunctions(); extern SEXP test_RfRMultinom(); extern SEXP test_RfFunctions(); + +extern SEXP test_DATAPTR(SEXP,SEXP); 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 dfd740c94c209f2a740e1b7aae211b4c96a1c5f2..91f4ba3cd90782875ed9863502d36dfe2cc74da6 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 @@ -150,6 +150,10 @@ setAttrTarget typeof(api.ATTRIB(mtcars)) api.ATTRIB(structure(c(1,2,3), myattr3 = 33)) +invisible(rffi.testDATAPTR('hello', testSingleString = T)); +# Ignored: FastR does not support DATAPTR for character vectors +# rffi.testDATAPTR(c('hello', 'world'), testSingleString = F); + # SET_OBJECT # FastR does not fully support the SET_OBJECT fully, # the test is left here in case there is a need to actually implement it.