Add support for tuples and better round tripping of named tuples (#515)

* Add support for tuples and better round tripping of named tuples * minor version bump The changes here should not be breaking for most users, but may potentially cause problems for JuliaCall , so we do a breaking version bump.
JuliaInterop · Jan 8, 2024 · 5d0ddeb · 5d0ddeb · palday · Jan 8, 2024
1 parent 69c22dd
commit 5d0ddeb
Show file tree

Hide file tree

Showing 8 changed files with 115 additions and 48 deletions.
diff --git a/.gitignore b/.gitignore
@@ -4,3 +4,4 @@ docs/build
 docs/gh-pages
 docs/site
 deps/build.log
+lcov.info
diff --git a/Project.toml b/Project.toml
@@ -1,7 +1,7 @@
 name = "RCall"
 uuid = "6f49c342-dc21-5d91-9882-a32aef131414"
 authors = ["Douglas Bates <[email protected]>", "Randy Lai <[email protected]>", "Simon Byrne <[email protected]>"]
-version = "0.13.18"
+version = "0.14.0"
 
 [deps]
 CategoricalArrays = "324d7699-5711-5eae-9e2f-1d82baa6b597"

diff --git a/src/RCall.jl b/src/RCall.jl
@@ -46,6 +46,7 @@ include("convert/datetime.jl")
 include("convert/dataframe.jl")
 include("convert/formula.jl")
 include("convert/namedtuple.jl")
+include("convert/tuple.jl")
 
 include("convert/default.jl")
 include("eventloop.jl")

diff --git a/src/convert/namedtuple.jl b/src/convert/namedtuple.jl
@@ -1,3 +1,15 @@
+function sexp(::Type{RClass{:JuliaNamedTuple}}, nt::NamedTuple)
+    vs = sexp(RClass{:list}, nt)
+    # mark this as originating from a tuple
+    # for roundtrippping, which downstream JuliaCall
+    # relies on
+    # because of the way S3 classes work, this doesn't break anything on the R side
+    # and strictly adds more information that we can take advantage of
+    setattrib!(vs, :class, sexp("JuliaNamedTuple"))
+    vs
+end
+
+# keep this as a separate method to allow for conversion without the attribute
 function sexp(::Type{RClass{:list}}, nt::NamedTuple)
     n = length(nt)
     vs = protect(allocArray(VecSxp,n))
@@ -14,20 +26,16 @@ function sexp(::Type{RClass{:list}}, nt::NamedTuple)
     vs
 end
 
-sexpclass(::NamedTuple) = RClass{:list}
+sexpclass(::NamedTuple) = RClass{:JuliaNamedTuple}
+
+rcopytype(::Type{RClass{:JuliaNamedTuple}}, x::Ptr{VecSxp}) = NamedTuple
 
 function rcopy(::Type{NamedTuple}, s::Ptr{VecSxp})
     protect(s)
-    try
-        names = Symbol[]
-        vals = Any[]
-
-        for k in rcopy(Array{Symbol}, getnames(s))
-            push!(names, k)
-            push!(vals, rcopy(s[k]))
-        end
-
-        NamedTuple{(names...,)}(vals)
+    try 
+        names = Tuple(Symbol(rcopy(n)) for n in getnames(s))
+        values = rcopy(Tuple, s)
+        NamedTuple{names}(values)
     finally
         unprotect(1)
     end
@@ -36,13 +44,12 @@ end
 function rcopy(::Type{NamedTuple{names}}, s::Ptr{VecSxp}) where names
     protect(s)
     try
-        vals = Any[]
-        n = rcopy(Array{Symbol}, getnames(s))
+        n = Tuple(Symbol(rcopy(n)) for n in getnames(s))
         if length(intersect(n, names)) != length(names)
             throw(ArgumentError("cannot convert to NamedTuple: wrong names"))
         end
 
-        vals = rcopy(Array, s)
+        vals = rcopy(Tuple, s)
         NamedTuple{names}(vals)
     finally
         unprotect(1)
@@ -52,13 +59,12 @@ end
 function rcopy(::Type{NamedTuple{names, types}}, s::Ptr{VecSxp}) where {names, types}
     protect(s)
     try
-        vals = Any[]
-        n = rcopy(Array{Symbol}, getnames(s))
+        n = Tuple(Symbol(rcopy(n)) for n in getnames(s))
         if length(intersect(n, names)) != length(names)
             throw(ArgumentError("cannot convert to NamedTuple: wrong names"))
         end
 
-        vals = rcopy(Array, s)
+        vals = rcopy(Tuple, s)
         NamedTuple{names, types}(vals)
     finally
         unprotect(1)

diff --git a/src/convert/tuple.jl b/src/convert/tuple.jl
@@ -0,0 +1,36 @@
+function sexp(::Type{RClass{:JuliaTuple}}, t::Tuple)
+    vs = sexp(RClass{:list}, t)
+    # mark this as originating from a tuple
+    # for roundtrippping, which downstream JuliaCall
+    # relies on
+    # because of the way S3 classes work, this doesn't break anything on the R side
+    # and strictly adds more information that we can take advantage of
+    setattrib!(vs, :class, sexp("JuliaTuple"))
+    vs
+end
+
+function sexp(::Type{RClass{:list}}, t::Tuple)
+    n = length(t)
+    vs = protect(allocArray(VecSxp,n))
+    try
+        for (i, v) in enumerate(t)
+            vs[i] = v
+        end
+    finally
+        unprotect(1)
+    end
+    vs
+end
+
+sexpclass(::Tuple) = RClass{:JuliaTuple}  
+
+rcopytype(::Type{RClass{:JuliaTuple}}, x::Ptr{VecSxp}) = Tuple
+
+function rcopy(::Type{T}, s::Ptr{VecSxp}) where {T <: Tuple}
+    protect(s)
+    try
+        T(rcopy(el) for el in s)
+    finally
+        unprotect(1)
+    end
+end
diff --git a/test/convert/namedtuple.jl b/test/convert/namedtuple.jl
@@ -11,3 +11,6 @@ r = RObject((a="a", d=1))
 @test_throws ArgumentError rcopy(typeof(nt), r)
 @test_throws ArgumentError rcopy(NamedTuple{(:a,:b,:c)}, r)
 @test (rcopy(NamedTuple{(:a,:d)}, r); true)
+
+@test rcopy(RObject(sexp(RClass{:list}, nt))) isa OrderedDict
+@test rcopy(RObject(nt)) isa typeof(nt) 
diff --git a/test/convert/tuple.jl b/test/convert/tuple.jl
@@ -0,0 +1,15 @@
+t = ("a", 1, [1,2])
+r = RObject(t)
+@test r isa RObject{VecSxp}
+@test length(r) == length(t)
+@test rcopy(Tuple, r) == t
+@test rcopy(typeof(t), r) == t
+@test rcopy(r) == t
+@test rcopy(Array, r) == collect(t)
+r[3] = 2.5
+me_test = @test_throws MethodError rcopy(typeof(t), r)
+@test me_test.value.f === convert
+@test me_test.value.args == (Vector{Int64}, 2.5)
+
+@test rcopy(RObject(sexp(RClass{:list}, t))) isa Vector{Any}
+@test rcopy(RObject(t)) isa typeof(t)
diff --git a/test/runtests.jl b/test/runtests.jl
@@ -1,6 +1,9 @@
 using RCall
 using Test
 
+using DataStructures: OrderedDict
+using RCall: RClass
+
 # before RCall does anything
 const R_PPSTACKTOP_INITIAL = unsafe_load(cglobal((:R_PPStackTop, RCall.libR), Int))
 @info "" R_PPSTACKTOP_INITIAL
@@ -33,37 +36,39 @@ println(R"sessionInfo()")
 
 println(R"l10n_info()")
 
-# https://github.com/JuliaStats/RCall.jl/issues/68
-@test hd == homedir()
+@testset "RCall" begin
 
-# https://github.com/JuliaInterop/RCall.jl/issues/206
-if (Sys.which("R") !== nothing) && (strip(read(`R RHOME`, String)) == RCall.Rhome)
-    @test rcopy(Vector{String}, reval(".libPaths()")) == libpaths
-end
+    # https://github.com/JuliaStats/RCall.jl/issues/68
+    @test hd == homedir()
 
-tests = ["basic",
-         "convert/base",
-         "convert/missing",
-         "convert/datetime",
-         "convert/dataframe",
-         "convert/categorical",
-         "convert/formula",
-         "convert/namedtuple",
-         # "convert/axisarray",
-         "macros",
-         "namespaces",
-         "repl",
-         ]
-
-println("Running tests:")
-
-for t in tests
-    println(t)
-    tfile = string(t, ".jl")
-    include(tfile)
-end
+    # https://github.com/JuliaInterop/RCall.jl/issues/206
+    if (Sys.which("R") !== nothing) && (strip(read(`R RHOME`, String)) == RCall.Rhome)
+        @test rcopy(Vector{String}, reval(".libPaths()")) == libpaths
+    end
 
-@info "" RCall.conda_provided_r
+    tests = ["basic",
+             "convert/base",
+             "convert/missing",
+             "convert/datetime",
+             "convert/dataframe",
+             "convert/categorical",
+             "convert/formula",
+             "convert/namedtuple",
+             "convert/tuple",
+             # "convert/axisarray",
+             "macros",
+             "namespaces",
+             "repl",
+             ]
 
-# make sure we're back where we started
-@test unsafe_load(cglobal((:R_PPStackTop, RCall.libR), Int)) == R_PPSTACKTOP_INITIAL
+    for t in tests
+        @eval @testset $t begin
+            include(string($t, ".jl"))
+        end
+    end
+
+    @info "" RCall.conda_provided_r
+
+    # make sure we're back where we started
+    @test unsafe_load(cglobal((:R_PPStackTop, RCall.libR), Int)) == R_PPSTACKTOP_INITIAL
+end