[GR-9027] DATAPTR supports complex, charsxp and shows informative error for character vectors.

PullRequest: fastr/1457

com.oracle.truffle.r.native/fficall/src/common/Rinternals_common.c

 /*
- * 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;
 	}
 }

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

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}
 };

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;
+}
+

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);

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.