Last version before migrating on Rulia package

Author: rcqls

R/jl4R.R

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

R/jlValue.R

@@ -5,16 +5,15 @@ jlvalue.default <- function(expr, ...) {
   NULL
 }
 
-## Used to eval `<julia expression>` in jl function
-jlvalue_eval <- function(obj, ...) {
-    if (length(obj) == 1 && is.character(obj)) {
-        .jlvalue_eval_addclass(obj)
-    } else {
-        warning("Bad input for .jlvalue_eval function!")
-        NULL
-    }
+########################
+## eval functions
+## 1) jlvalue mode 
+## IMPORTANT: the user knows that the argument is a character and the content is a valid julia code
+jlvalue_eval <- function(expr) {
+    .jlvalue_eval_addclass(expr)
 }
 
+## 2) jl mode: test on length on obj and jlexception 
 jleval <- function(obj, ...) {
     if (length(obj) == 1 && is.character(obj)) {
         jlval <- .jlvalue_eval_addclass(obj)
@@ -25,10 +24,6 @@ jleval <- function(obj, ...) {
     }
 }
 
-jlvalue_eval_unsafe <- function(expr) {
-    .jlvalue_eval_addclass(expr)
-}
-
 jlvalue_invisible <- function(jlval) {
     if(jlvalue_callR("isnothing", jlval)) {
         invisible(jlval)

R/jl_utils.R

@@ -9,7 +9,7 @@ jlsymbol <- function(field) {
     res
 }
 
-jlcolon <- function() jlvalue_eval_unsafe(":")
+jlcolon <- function() jlvalue_eval(":")
 
 jlisstructtype <- function(jlval) {
     jltrycall("isstructtype", jlval)

tests/testthat/test-func.R

@@ -0,0 +1,11 @@
+test_that("jl(typeof)(1.0) %<:% Number works", {
+  expect_jlequal(jl(typeof)(1.0) %<:% Number, "true")
+})
+
+test_that("1.0 %isa% Number works", {
+  expect_jlequal(1.0 %isa% Number, "true")
+})
+
+test_that('"1.0" %isa% Number works', {
+  expect_jlequal("1.0" %isa% Number, "false")
+})

tests/testthat/test-stat.R

@@ -0,0 +1,7 @@
+test_that("data.frame works", {
+  expect_jlequal(jl(data.frame(a=1:2, b=c(TRUE,FALSE))), "2×2 DataFrame\n Row │ a      b\n     │ Int64  Bool\n─────┼──────────────\n   1 │     1   true\n   2 │     2  false")
+})
+
+test_that("factor works", {
+  expect_jlequal(jl(factor(c("titi","toto","titi"))),"3-element CategoricalArray{String,1,UInt32}:\n \"titi\"\n \"toto\"\n \"titi\"")
+})