tests/testthat/test-serializeJSON-S4.R

In jsonlite: A Simple and Robust JSON Parser and Generator for R

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)
  })
})