Only check for nested matrices in a DF when column is atomic.

This avoids invoking dim() on unknown objects, where anything could
happen. In particular, the DataFrameList will raise deprecation warnings
as dim() was replaced by dims() in the latest release.

Also migrated tests for correct saving of nested arrays inside DFs from
alabaster.matrix; it's more appropriate to test it here.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: alabaster.base
 Title: Save Bioconductor Objects To File
-Version: 1.5.6
-Date: 2024-08-27
+Version: 1.5.7
+Date: 2024-09-10
 Authors@R: person("Aaron", "Lun", role=c("aut", "cre"), email="[email protected]")
 License: MIT + file LICENSE
 Description: 
@@ -24,7 +24,8 @@ Suggests:
     knitr,
     testthat,
     digest,
-    Matrix
+    Matrix,
+    alabaster.matrix
 LinkingTo:
     Rcpp,
     Rhdf5lib

R/saveDataFrame.R

@@ -70,10 +70,7 @@ setMethod("saveObject", "DataFrame", function(x, path, ...) {
         coltype <- NULL
         colformat <- NULL
 
-        if (length(dim(col)) > 1) {
-            is.other <- TRUE
-
-        } else if (is.factor(col)) {
+        if (is.factor(col)) {
             local({
                 colhandle <- H5Gcreate(gdhandle, data.name)
                 on.exit(H5Gclose(colhandle), add=TRUE, after=FALSE)
@@ -96,9 +93,13 @@ setMethod("saveObject", "DataFrame", function(x, path, ...) {
             sanitized <- .sanitize_date(col)
 
         } else if (is.atomic(col)) {
-            coerced <- .remap_atomic_type(col)
-            coltype <- coerced$type
-            sanitized <- coerced$values
+            if (length(dim(col)) > 1) {
+                is.other <- TRUE
+            } else {
+                coerced <- .remap_atomic_type(col)
+                coltype <- coerced$type
+                sanitized <- coerced$values
+            }
 
         } else {
             is.other <- TRUE

tests/testthat/test-DataFrame.R

@@ -625,3 +625,55 @@ test_that("DFs handle POSIX times correctly", {
     saveObject(round2, tmp3)
     expect_identical(readDataFrame(tmp3), round2)
 })
+
+test_that("staging of arrays within DFs works correctly", {
+    skip_if_not_installed("alabaster.matrix")
+    tmp <- tempfile()
+    dir.create(tmp)
+
+    input <- DataFrame(A=1:3, X=0, Y=0)
+    input$X <- array(runif(3)) # 1D array
+    input$Y <- cbind(runif(3)) # matrix with 1 column 
+    input$Z <- cbind(V=runif(3), Z=rnorm(3)) # matrix with 2 columns.
+    info <- stageObject(input, tmp, path="WHEE")
+
+    suppressWarnings(roundtrip <- loadDataFrame(info, project=tmp))
+    input$X <- as.numeric(input$X) # strip 1D arrays as these are rarely desirable.
+    roundtrip$Y <- as.matrix(roundtrip$Y)
+    roundtrip$Z <- as.matrix(roundtrip$Z)
+    expect_equal(roundtrip, input)
+
+    # Works in the new world.
+    tmp <- tempfile()
+    saveObject(input, tmp)
+    roundtrip <- readObject(tmp)
+    roundtrip$Y <- as.matrix(roundtrip$Y)
+    roundtrip$Z <- as.matrix(roundtrip$Z)
+    expect_identical(roundtrip, input)
+})
+
+test_that("staging of arrays continues to work with character matrices", {
+    skip_if_not_installed("alabaster.matrix")
+    tmp <- tempfile()
+    dir.create(tmp)
+
+    input <- DataFrame(A=1:3, X=0, Y=0)
+    input$X <- array(letters[1:3]) # 1D array
+    input$Y <- cbind(LETTERS[1:3]) # matrix with 1 column 
+    input$Z <- cbind(V=letters[4:6], Z=LETTERS[4:6]) # matrix with 2 columns.
+    info <- stageObject(input, tmp, path="WHEE")
+
+    suppressWarnings(roundtrip <- loadDataFrame(info, project=tmp))
+    input$X <- as.character(input$X) # strip 1D arrays as these are rarely desirable.
+    roundtrip$Y <- as.matrix(roundtrip$Y)
+    roundtrip$Z <- as.matrix(roundtrip$Z)
+    expect_equal(roundtrip, input)
+
+    # Works in the new world.
+    tmp <- tempfile()
+    saveObject(input, tmp)
+    roundtrip <- readObject(tmp)
+    roundtrip$Y <- as.matrix(roundtrip$Y)
+    roundtrip$Z <- as.matrix(roundtrip$Z)
+    expect_identical(roundtrip, input)
+})