[GR-3140] Support for rJava-style interoperability in FastR.

com.oracle.truffle.r.pkgs/rJava/DESCRIPTION

+Package: rJava
+Type: Package
+Title: FastR rJava compatibility layer
+Version: 1.0
+Date: 2017-05-18
+Author: Tomas Stupka
+Maintainer: Tomas Stupka <tomas.stupka@oracle.com>
+Description: Provides rJava R interface backed by FastR interoperability builtins.
+License: GPL-2
+Suggests: testthat
+RoxygenNote: 6.0.1

com.oracle.truffle.r.pkgs/rJava/NAMESPACE

+# Generated by roxygen2: do not edit by hand
+
+export(.jarray)
+export(.jbyte)
+export(.jcall)
+export(.jchar)
+export(.jcheck)
+export(.jevalArray)
+export(.jfield)
+export(.jfloat)
+export(.jinit)
+export(.jlong)
+export(.jnew)
+export(.jnull)
+export(.jshort)
+export(.jsimplify)

com.oracle.truffle.r.pkgs/rJava/R/rj.R

+##
+ # This material is distributed under the GNU General Public License
+ # Version 2. You may review the terms of this license at
+ # http://www.gnu.org/licenses/gpl-2.0.html
+ #
+ # Copyright (c) 2006 Simon Urbanek <simon.urbanek@r-project.org>
+ # Copyright (c) 2017, Oracle and/or its affiliates
+ #
+ # All rights reserved.
+##
+
+#' @export
+.jnew <- function (class, ..., check = TRUE, silent = !check) 
+{
+    class <- gsub("/", ".", as.character(class))
+    co <- .fastr.java.class(class)
+    o <- .fastr.interop.new(co, ...)
+    invisible(o)
+}
+
+#' @export
+.jcall <- function (obj, returnSig = "V", method, ..., evalArray = TRUE, 
+    evalString = TRUE, check = TRUE, interface = "RcallMethod", 
+    simplify = FALSE, use.true.class = FALSE) 
+{
+    if(is.character(obj)) {
+        co <- .fastr.java.class(obj)
+        r <- co[method](...)
+    } else {
+        r <- obj[method](...)
+    }
+    r
+}
+
+#' @export
+.jfield <- function (obj, sig = NULL, name, true.class = is.null(sig), convert = TRUE) 
+{
+    if(is.character(obj)) {
+        co <- .fastr.java.class(obj)
+        r <- co[name]
+    } else {
+        r <- obj[name]
+    }
+    r    
+}
+
+#' @export
+.jarray <- function (x, contents.class = NULL, dispatch = FALSE) 
+{
+    .fastr.java.toArray(x, ,TRUE)
+}
+
+#' @export
+.jevalArray <- function (x, contents.class = NULL, dispatch = FALSE) 
+{
+    .fastr.java.fromArray(x)
+}
+
+#' @export
+.jbyte <- function (x) 
+{
+    x <- .fastr.interop.toByte(x)
+    invisible(x)
+}
+
+#' @export
+.jchar <- function (x) 
+{
+    x <- .fastr.interop.toChar(x)
+    invisible(x)
+}
+
+#' @export
+.jshort <- function (x) 
+{
+    x <- .fastr.interop.toShort(x)
+    invisible(x)
+}
+
+#' @export
+.jlong <- function (x) 
+{
+    x <- .fastr.interop.toLong(x)
+    invisible(x)
+}
+
+#' @export
+.jfloat <- function (x) 
+{    
+    x <- .fastr.interop.toFloat(x)
+    invisible(x)
+}
+
+#
+# noop stubs
+#
+
+#' @export
+.jinit <- function ()
+{    
+    # do nothing
+}
+
+#' @export
+.jsimplify <- function (x) 
+{    
+    x
+}
+
+#' @export
+.jcheck <- function(silent = FALSE) {
+    FALSE
+}
+
+#' @export
+.jnull <- function (class)
+{    
+    # do nothing
+}

com.oracle.truffle.r.pkgs/rJava/tests/testthat.R

+library(testthat)
+library(rjava)
+
+test_check("rjava")
+typeName
\ No newline at end of file

com.oracle.truffle.r.pkgs/rJava/tests/testthat/testArrays.R

+# prerequisites:
+# - 'testthat' package has to be installed: install.packages("testthat")
+# - FastR`s rJava package has to be installed: bin/r CMD INSTALL com.oracle.truffle.r.pkgs/rjava
+# - mxbuild/dists/fastr-unit-tests.jar has to be on FastR classpath
+
+library(testthat)
+library(rJava)
+
+testName <- "test .jarray"
+test_that(testName, {
+    cat(paste0(testName, "\n"))
+	
+    a <- .jarray(c(1.1, 2.1, 3.1))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 3)
+    expect_equal(a[1], c(1.1))
+    expect_equal(a[2], c(2.1))
+    expect_equal(a[3], c(3.1))
+
+    a <- .jarray(c(1L, 2L, 3L))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 3)
+    expect_equal(a[1], c(1))
+    expect_equal(a[2], c(2))
+    expect_equal(a[3], c(3))
+
+    a <- .jarray(c(TRUE, FALSE))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 2)
+    expect_equal(a[1], TRUE)
+    expect_equal(a[2], FALSE)
+
+    a <- .jarray(c(.jbyte(1), .jchar("a"), .jfloat(1.1), .jlong(2), .jshort(123)))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 5)
+    expect_equal(a[1], 1)
+    expect_equal(a[2], "a")
+    expect_true((a[3] - 1.1)^2 < 1e-8)
+    expect_equal(a[4], 2)
+    expect_equal(a[5], 123)
+
+    to <- .jnew('java.util.ArrayList')
+    a <- .jarray(to)
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 1)
+    # fails at the moment
+    # expect_equal(a[1], to)
+
+    to <- .jnew('java.util.ArrayList')
+    a <- .jarray(c(to, to))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 2)
+    # fails at the moment    
+    # expect_equal(a[1], to)
+    # expect_equal(a[2], to)
+
+    a <- .jarray(list(1, 2, 3))
+    expect_true(.fastr.java.isArray(a))
+    expect_equal(length(a), 3)
+    expect_equal(a[1], 1)
+    expect_equal(a[2], 2)
+    expect_equal(a[3], 3)
+})
+
+testName <- "test .jevalArray"
+test_that(testName, {
+    cat(paste0(testName, "\n"))
+
+    expectedValues <- list(
+        Boolean=list("logical", TRUE, FALSE, TRUE), 
+        Byte=list("integer", 1,2,3), 
+        Char=list("character", "a", "b", "c"), 
+        Double=list("double",1.1, 2.1, 3.1), 
+        Float=list("double", 1.1, 2.1, 3.1), 
+        Int=list("integer",1,2,3), 
+        Long=list("double", 1,2,3), 
+        Short=list("integer",1,2,3), 
+        String=list("character", "a", "b", "c"))
+    testClassName <- "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass"
+    t<-.jnew(class=testClassName)
+
+    for(expectedName in names(expectedValues)) {                
+        fieldName <- paste0("fieldStatic", expectedName, "Array")
+        ev<-expectedValues[expectedName][[1]]
+        arrayType <- ev[[1]]
+        arrayLength <- length(ev) - 1
+        a<-t[fieldName]
+        expect_true(.fastr.java.isArray(a), info=paste0("the array was returned for ", fieldName), label=".fastr.java.isArray")
+        ae<-.jevalArray(a)
+        expect_true(is.vector(ae), info=paste0("the array was returned for ", fieldName), label="is.vector")
+        expect_equal(typeof(ae), arrayType, info=paste0("the array was returned for ", fieldName), label="typeof")
+        expect_equal(length(ae), arrayLength, info=paste0("the array was returned for ", fieldName), label="array length")
+        for(i in 1:arrayLength) {
+            if(expectedName != "Float") {
+                expect_equal(a[i], ev[[i+1]], info=paste0("the array was returned for ", fieldName), label=paste0("value at", i))
+            } else {
+                expect_true((ev[[i+1]] - a[i])^2 < 1e-8, info=paste0("the array was returned for ", fieldName), label=paste0("value at", i))
+            }
+        }
+    }
+
+})
\ No newline at end of file

com.oracle.truffle.r.pkgs/rJava/tests/testthat/testBasic.R

+# prerequisites:
+# - 'testthat' package has to be installed: install.packages("testthat")
+# - FastR`s rJava package has to be installed: bin/r CMD INSTALL com.oracle.truffle.r.pkgs/rjava
+# - mxbuild/dists/fastr-unit-tests.jar has to be on FastR classpath
+
+library(testthat)
+library(rJava)
+
+bo <- TRUE
+bt <- 123
+ch <- 'a'
+d  <- 1.123456
+f  <- 1.123
+i  <- 12345L
+l  <- 123456
+sh <- 1234
+st <- "a test string"
+
+jbt <- .jbyte(bt)
+jch <- .jchar(ch)
+jf  <- .jfloat(f)
+jl  <- .jlong(l)
+jsh <- .jshort(sh)
+
+primitiveTypeNames <- c("Boolean", "Byte", "Char", "Double", "Float", "Integer", "Long", "Short")
+expectedValues <- list(bo, bt, ch, d, f, i, l, sh, st)
+
+testClassName <- "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass"
+t<-.jnew(class=testClassName, bo, jbt, jch, d, jf, i, jl, jsh, st)
+
+testForMember <- function(valueProvider, memberNameProvider, typeNames) {
+	for(idx in 1:length(typeNames)) {	
+		typeName <- typeNames[idx]
+		member <- memberNameProvider(typeName)
+		expectedValue <- expectedValues[[idx]]
+		value <- valueProvider(t, member)
+		testValue(member, typeName, expectedValue, value)
+	}
+}
+
+testValue <- function(memberName, typeName, expectedValue, value) {
+	cat(paste0("  ", memberName, " returned value [", value, "] and is expected to be [", expectedValue, "]"), "\n")
+	if(typeName != "Float") {
+		expect_that(expectedValue, equals(value), info=memberName, label=memberName)
+	} else {
+		expect_true((expectedValue - value)^2 < 1e-8, info=memberName, label=memberName)
+	}
+}
+
+testName <- "test if primitive field access works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jfield(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("field", typeName) },
+                   primitiveTypeNames )
+})
+
+testName <- "test if primitive static field access works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jfield(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("fieldStatic", typeName) },
+                   primitiveTypeNames )
+})
+
+testName <- "test if static field access works"
+test_that("test if static field access works", {
+	testForMember( valueProvider = function(t, member) { .jfield(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("fieldStatic", typeName, "Object") },
+                   c(primitiveTypeNames, "String") )
+})
+
+testName <- "test if field access works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jfield(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("field", typeName, "Object")},
+                   c(primitiveTypeNames, "String") )
+})
+
+testName <- "test if calling static method returning primitive values works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jcall(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("methodStatic", typeName) },
+                   primitiveTypeNames )
+})
+
+testName <- "test if calling method returning primitive values works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jcall(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("method", typeName) },
+                   primitiveTypeNames )
+})
+
+testName <- "test if calling static method returning object values works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jcall(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("methodStatic", typeName, "Object") },
+                   c(primitiveTypeNames, "String") )
+})
+
+testName <- "test if calling method returning object values works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	testForMember( valueProvider = function(t, member) { .jcall(t, , member) },
+                   memberNameProvider = function(typeName) { paste0("method", typeName, "Object") },
+                   c(primitiveTypeNames, "String") )
+})
+
+testName <- "test if static access via class name works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	value <- .jfield(testClassName, , "fieldStaticInteger")
+	testValue("fieldStaticInteger", "Integer", i, value)
+
+	value <- .jcall(testClassName, , "methodStaticInteger")
+	testValue("methodStaticInteger", "Integer", i, value)
+})
+
+testName <- "test if calling method with all primitive type parameters + string works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	value <- .jcall(t, , "allTypesMethod", bo, jbt, jch, d, jf, i, jl, jsh, st)
+	expect_false(is.null(value))
+})
+
+testName <- "test if calling method with all primitive type parameters + string works"
+test_that(testName, {
+	cat(paste0(testName, "\n"))
+	value <- .jcall(t, , "allTypesStaticMethod", bo, jbt, jch, d, jf, i, jl, jsh, st)
+	expect_false(is.null(value))
+})
\ No newline at end of file