add stuffs

* testthat (jlvalue_capture_output)
* jl_set.seed
* is.variable

Author: rcqls

DESCRIPTION

@@ -1,7 +1,10 @@
 Package: jl4R
-Version: 0.0.2
+Version: 0.1.0
 Title: Julia Interface
 Author: Cqls Team
-Maintainer: Remy Drouilhet <remy.drouilhet@upmf-grenoble.fr>
+Maintainer: Remy Drouilhet <remy.drouilhet@univ-grenoble-alpes.fr>
 Description: Interface to julia
 License: GPL Version 2 or later.
+Suggests: 
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3

NAMESPACE

@@ -22,9 +22,11 @@ export(
   jlDict, jlTuple, jlNamedTuple, jlStruct,
   jlcolon, jlsymbol,
   jlshow, jldisplay,
-  rand,
-  ## 
-  rexpr2jlexpr
+  "%<:%", "%isa%",
+  rand, jl_set.seed,
+  ## extra
+  rexpr2jlexpr, 
+  jlvalue_capture_display # useful for testthat
 )
 
 S3method(print,jlvalue)

R/jl4R.R

@@ -4,18 +4,20 @@
 
 
 jl <- function(obj, ..., name_class = TRUE) {
-  if (name_class && !(deparse(substitute(obj)) %in% ls(parent.frame()))) {
+  name <- deparse(substitute(obj))
+  if( name_class && !is.variable(name, parent.frame())) {
     return(jl_rexpr(substitute(obj), obj, ...))
   }
-  jlvalue(obj, ...)
+  jlvalue_or_jlexception(name, jlvalue(obj, ...))
 }
 
 jlR <- function(obj, ..., name_class = TRUE) {
-  if (name_class && !(deparse(substitute(obj)) %in% ls(parent.frame()))) {
+  name <- deparse(substitute(obj))
+  if (name_class && !(is.variable(name, parent.frame()))) {
     res <- jl_rexpr(substitute(obj), ...)
     if (!is.null(res)) return(toR(res))
   }
-  toR(jlvalue(obj, ...))
+  toR(jlvalue_or_jlexception(name, jlvalue(obj, ...)))
 }
 
 jl2 <- function(obj, ..., name_class = TRUE) {

R/jl_exception.R

@@ -29,7 +29,7 @@ print.jlexception <- function(obj, ...) {
 
 summary.jlexception <- function(obj) {
     cat("Julia Exception:",class(obj)[[1]],"\n")
-    jl(showerror)(stdout, obj$err)
+    jlvalue_call("showerror", jlvalue_eval("stdout"), obj$err)
     invisible(cat("\n"))
     # cat(toR(jlstring(obj$err)),"\n")
 }

R/jl_generic.R

@@ -1,4 +1,8 @@
 # Put here generic function used in the julia side but not in the R side
 rand <- function(obj, ...) UseMethod("rand")
+jl_set.seed <- function(n) {
+    jlusing(Random)
+    invisible(jl(`Random.seed!`)(as.integer(n)))
+}
 rand.integer <- rand.double <- function(obj) jlvalue_call("rand", jlvalue(as.integer(obj)))
 rand.default <- function(obj, ...) jlvalue_call("rand")

R/jl_utils.R

@@ -52,4 +52,8 @@ jlfieldnamesR <- function(jlval) toR(jlfieldnames(jlval))
 jlgetfieldR <- function(jlval, field) toR(jlgetfield(jlval, field))
 
 jlshow <- function(jlval) invisible(jltrycall("show",jlval))
-jldisplay <- function(jlval) invisible(jltrycall("display",jlval))
+jldisplay <- function(jlval) invisible(jltrycall("display",jlval))
+
+"%<:%" <- function(a, b) {args <- jl4R:::jl_rexprs2(substitute(list(a,b)), parent_envir=parent.frame());jl(`<:`)(args[[1]],args[[2]])}
+
+"%isa%" <- function(a, b) {args <- jl4R:::jl_rexprs2(substitute(list(a,b)), parent_envir=parent.frame());jl(isa)(args[[1]],args[[2]])}

R/jl_utils_internals.R

@@ -5,7 +5,7 @@ jl_rexpr <- function(rexpr, obj, ...) { # rexpr is generally the result of subst
         if(is.jlfunction(jlval)) {
            jlfunction(jlval) 
         } else {
-            jlval
+            jlvalue_or_jlexception(rexpr, jlval)
         }
     } else {
         jlvalue(obj, ...)
@@ -30,7 +30,7 @@ jl_rexpr2 <- function(rexpr, parent_envir= parent.frame()) { # rexpr is generall
         # print(list(obj=obj, isjlf=is.jlfunction(jlval), robj = obj %in% ls(parent_envir), envir=ls(parent_envir)))
         if(is.jlfunction(jlval)) {
            jlfunction(jlval, parent_envir) 
-        } else if (obj %in% ls(parent_envir) ) {
+        } else if(is.variable(obj, parent_envir)) {# (obj %in% ls(parent_envir) ) {
             obj <- eval(rexpr, envir=parent_envir)
             jlvalue(obj)
         } else {

R/utils.R

@@ -0,0 +1,3 @@
+is.variable <- function(name, envir) {
+    exists(name,envir=envir) && !is.function(eval(parse(text = name), envir = envir))
+}

src/jl4R.c

@@ -68,7 +68,7 @@ jl_value_t* get_preserved_jlvalue_from_R_ExternalPtrAddr(SEXP ans) {
 
 SEXP jl4R_init(SEXP args)
 {
-  char *julia_home_dir;
+  // char *julia_home_dir;
 
   if(!jl4R_julia_running) {
     // if(!isValidString(CADR(args)))
@@ -90,8 +90,8 @@ void jl4R_exit()
 {
   if(jl4R_julia_running) {
     jl_atexit_hook(0);
-    jl4R_julia_running=0;
-    printf("julia finalize!!!\n");
+    jl4R_julia_running = 0;
+    printf("julia stopped!!!\n");
   }
 }
 

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(jl4R)
+
+test_check("jl4R")

tests/testthat/test-eval.R

@@ -0,0 +1,11 @@
+test_that("jl eval int64", {
+  expect_equal(jlvalue_capture_display(jl(`2 * 2`)), "4\n")
+})
+
+test_that("jl eval string", {
+  expect_equal(jlvalue_capture_display(jl(`"2 * 2"`)), '"2 * 2"\n')
+})
+
+test_that("jl eval symbol", {
+  expect_equal(jlvalue_capture_display(jlsymbol("toto")), ":toto\n")
+})

tests/testthat/test-jl2r.R

@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})

tests/testthat/test-r2jl.R

@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})