test_that("Simple S4 serialization", { setClass("myClass", slots = list(name = "character")) obj <- new("myClass", name = "myName") out <- jsonlite::unserializeJSON(jsonlite::serializeJSON(obj)) expect_identical(obj, out) removeClass("myClass") }) test_that("Serialize optional S4 fields", { setClass( Class = "Trajectories", representation = representation( times = "numeric", traj = "matrix" ) ) t1 <- new(Class = "Trajectories") t2 <- new(Class = "Trajectories", times = c(1, 3, 4)) t3 <- new(Class = "Trajectories", times = c(1, 3), traj = matrix(1:4, ncol = 2)) expect_identical(t1, unserializeJSON(serializeJSON(t1))) expect_identical(t2, unserializeJSON(serializeJSON(t2))) expect_identical(t3, unserializeJSON(serializeJSON(t3))) removeClass("Trajectories") }) test_that("Serialize pseudo-null (empty slot)", { track <- setClass("track", slots = c(x = "numeric", y = "ANY")) t1 <- new("track", x = 1:3) t2 <- unserializeJSON(serializeJSON(t1)) expect_identical(t1, t2) }) test_that("Class loading errors", { expect_error(unserializeJSON('{"type":"S4","attributes":{},"value":{"class":"nonExitingClass","package":".GlobalEnv"}}'), "defined") # Testthat seems to not catch this output text #expect_error(expect_warning(unserializeJSON('{"type":"S4","attributes":{},"value":{"class":"nonExitingClass","package":"nopackage"}}')), "nopackage") }) # S4 extending various SEXP types test_that("Serializing S4 extending SEXPTYPE", { objects <- list( NULL, readBin(system.file(package = "base", "Meta/package.rds"), "raw", 999), c(TRUE, FALSE, NA, FALSE), c(1L, NA, 9999999), c(round(pi, 4), NA, NaN, Inf, -Inf), c("foo", NA, "bar"), complex(real = 1:10, imaginary = 1001:1010), expression("to be or not to be"), expression(foo), parse(text = "rnorm(10);"), list("1", "2", "3"), mtcars, base::matrix(nrow = 100, ncol = 100) ) lapply(objects, function(object) { setClass("Complexo", contains = c(class(object))) complex1 <- new("Complexo", object) c1 = serializeJSON(complex1) c2 = unserializeJSON(c1) expect_identical(complex1, c2) }) })