Repository: single-cell-data/TileDB-SOMA (language: python)

Issue:
[r] Fix context-propagation issue #3164
https://github.com/chanzuckerberg/cellxgene-census/issues/1261

#3164

[[sc-56531]](https://app.shortcut.com/tiledb-inc/story/56531/fix-cloud-region-issue-in-tiledb-soma-r)


Discussion / hints:

Fix patch:
diff --git a/apis/r/DESCRIPTION b/apis/r/DESCRIPTION
index d55dfddc84..ddbc2324ff 100644
--- a/apis/r/DESCRIPTION
+++ b/apis/r/DESCRIPTION
@@ -6,7 +6,7 @@ Description: Interface for working with 'TileDB'-based Stack of Matrices,
     like those commonly used for single cell data analysis. It is documented at
     <https://github.com/single-cell-data>; a formal specification available is at
     <https://github.com/single-cell-data/SOMA/blob/main/abstract_specification.md>.
-Version: 1.15.99.12
+Version: 1.15.99.13
 Authors@R: c(
     person(given = "Aaron", family = "Wolen",
            role = c("cre", "aut"), email = "aaron@tiledb.com",
diff --git a/apis/r/NEWS.md b/apis/r/NEWS.md
index e4e8335adf..9d728b0ab4 100644
--- a/apis/r/NEWS.md
+++ b/apis/r/NEWS.md
@@ -20,6 +20,7 @@
 * Proper prefixing for shape-related methods [#3237](https://github.com/single-cell-data/TileDB-SOMA/pull/3237)
 * Bindings for `upgrade_domain` [#3238](https://github.com/single-cell-data/TileDB-SOMA/pull/3238)
 * Apply `styler::style_pkg()` [#3239](https://github.com/single-cell-data/TileDB-SOMA/pull/3239)
+* Plumb old-style `SOMATileDBContext` into new-style `soma_context()`
 
 # tiledbsoma 1.14.5
 
diff --git a/apis/r/R/TileDBObject.R b/apis/r/R/TileDBObject.R
index 084ecc0576..f66badf06e 100644
--- a/apis/r/R/TileDBObject.R
+++ b/apis/r/R/TileDBObject.R
@@ -39,12 +39,35 @@ TileDBObject <- R6::R6Class(
       private$.tiledb_platform_config <- platform_config
 
       # Set context
-      tiledbsoma_ctx <- tiledbsoma_ctx %||% SOMATileDBContext$new()
-      if (!inherits(x = tiledbsoma_ctx, what = "SOMATileDBContext")) {
-        stop("'tiledbsoma_ctx' must be a SOMATileDBContext object", call. = FALSE)
+      if (!is.null(x = tiledbsoma_ctx)) {
+        if (!inherits(x = tiledbsoma_ctx, what = 'SOMATileDBContext')) {
+          stop(
+            "'tiledbsoma_ctx' must be a SOMATileDBContext object",
+            call. = FALSE
+          )
+        }
+        # TODO: Deprecate tiledbsoma_ctx in favor of soma_context
+        # warning("'tiledbsoma_ctx' is deprecated, use 'soma_context' instead")
+        # Set the old context
+        private$.tiledbsoma_ctx <- tiledbsoma_ctx
+        private$.tiledb_ctx <- self$tiledbsoma_ctx$context()
+        # Also plumb through to the new context
+        if (!is.null(soma_context)) {
+          warning(
+            "Both 'soma_context' and 'tiledbsoma_ctx' were provided,",
+            "using 'soma_context' only"
+          )
+        } else {
+          # why we named the parameter and function the same thing is beyond me
+          soma_context <- tiledbsoma::soma_context(
+            config = unlist(tiledbsoma_ctx$to_list())
+          )
+        }
+      } else {
+        tiledbsoma_ctx <- SOMATileDBContext$new()
+        private$.tiledbsoma_ctx <- tiledbsoma_ctx
+        private$.tiledb_ctx <- self$tiledbsoma_ctx$context()
       }
-      private$.tiledbsoma_ctx <- tiledbsoma_ctx
-      private$.tiledb_ctx <- self$tiledbsoma_ctx$context()
 
       # TODO: re-enable once new UX is worked out
       # soma_context <- soma_context %||% soma_context()


Test patch:
diff --git a/apis/r/tests/testthat/test-contexts.R b/apis/r/tests/testthat/test-contexts.R
new file mode 100644
index 0000000000..31fcf90d43
--- /dev/null
+++ b/apis/r/tests/testthat/test-contexts.R
@@ -0,0 +1,216 @@
+test_that("context-create", {
+  skip_if(!extended_tests() || covr_tests())
+
+  uri <- tempfile("new-group")
+  ctx <- soma_context()
+  group <- TileDBGroup$new(
+    uri,
+    internal_use_only = "allowed_use",
+    soma_context = ctx
+  )
+  group$create(internal_use_only = "allowed_use")
+  group$close()
+
+  # Create array and subgroup in isolation but do not yet add them to the group
+  a1 <- TileDBArray$new(
+    uri = create_empty_test_array(file.path(uri, "a1")),
+    internal_use_only = "allowed_use",
+    soma_context = ctx
+  )
+  g1 <- TileDBGroup$new(
+    uri = tiledb::tiledb_group_create(file.path(uri, "g1")),
+    internal_use_only = "allowed_use",
+    soma_context = ctx
+  )
+
+  # Objects are present but not yet members
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_true(a1$exists())
+  expect_true(g1$exists())
+  expect_equal(group$length(), 0)
+  group$close()
+
+  # Add array and subgroup as members
+  group$open(mode = "WRITE", internal_use_only = "allowed_use")
+  group$set(a1, name = "a1")
+  expect_equal(group$length(), 1)
+  expect_equal(group$to_data_frame()$type, "ARRAY")
+
+  group$set(g1, name = "g1")
+  expect_equal(group$length(), 2)
+  expect_setequal(group$to_data_frame()$type, c("ARRAY", "GROUP"))
+  group$close()
+
+  # Read back the members
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_equal(group$length(), 2)
+  expect_setequal(group$names(), c("a1", "g1"))
+
+  # Retrieve
+  o <- group$get("a1")
+
+  expect_is(group$get("a1"), "TileDBArray")
+  expect_is(group$get("g1"), "TileDBGroup")
+  group$close()
+
+  # Remove
+  group$open(mode = "WRITE", internal_use_only = "allowed_use")
+  group$remove("a1")
+  expect_equal(group$length(), 1)
+  group$remove("g1")
+  expect_equal(group$length(), 0)
+  group$close()
+
+  # Remove
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_equal(group$length(), 0)
+  group$close()
+})
+
+test_that("context-fly", {
+  skip_if(!extended_tests() || covr_tests())
+
+  uri <- tempfile("new-group")
+  group <- TileDBGroup$new(
+    uri,
+    internal_use_only = "allowed_use",
+    soma_context = soma_context()
+  )
+  group$create(internal_use_only = "allowed_use")
+  group$close()
+
+  # Create array and subgroup in isolation but do not yet add them to the group
+  a1 <- TileDBArray$new(
+    uri = create_empty_test_array(file.path(uri, "a1")),
+    internal_use_only = "allowed_use",
+    soma_context = soma_context()
+  )
+  g1 <- TileDBGroup$new(
+    uri = tiledb::tiledb_group_create(file.path(uri, "g1")),
+    internal_use_only = "allowed_use",
+    soma_context = soma_context()
+  )
+
+  # Objects are present but not yet members
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_true(a1$exists())
+  expect_true(g1$exists())
+  expect_equal(group$length(), 0)
+  group$close()
+
+  # Add array and subgroup as members
+  group$open(mode = "WRITE", internal_use_only = "allowed_use")
+  group$set(a1, name = "a1")
+  expect_equal(group$length(), 1)
+  expect_equal(group$to_data_frame()$type, "ARRAY")
+
+  group$set(g1, name = "g1")
+  expect_equal(group$length(), 2)
+  expect_setequal(group$to_data_frame()$type, c("ARRAY", "GROUP"))
+  group$close()
+
+  # Read back the members
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_equal(group$length(), 2)
+  expect_setequal(group$names(), c("a1", "g1"))
+
+  # Retrieve
+  o <- group$get("a1")
+
+  expect_is(group$get("a1"), "TileDBArray")
+  expect_is(group$get("g1"), "TileDBGroup")
+  group$close()
+
+  # Remove
+  group$open(mode = "WRITE", internal_use_only = "allowed_use")
+  group$remove("a1")
+  expect_equal(group$length(), 1)
+  group$remove("g1")
+  expect_equal(group$length(), 0)
+  group$close()
+
+  # Remove
+  group$open(mode = "READ", internal_use_only = "allowed_use")
+  expect_equal(group$length(), 0)
+  group$close()
+})
+
+test_that("SOMATileDBContext plumb-through", {
+  skip_if(!extended_tests())
+
+  uri <- tempfile("new-group")
+  ctx <- SOMATileDBContext$new()
+
+  expect_no_condition(group <- TileDBGroup$new(
+    uri,
+    internal_use_only = "allowed_use",
+    tiledbsoma_ctx = ctx
+  ))
+  group$create(internal_use_only = "allowed_use")
+  group$close()
+
+  uri <- tempfile("new-group")
+  expect_warning(group <- TileDBGroup$new(
+    uri,
+    internal_use_only = "allowed_use",
+    tiledbsoma_ctx = ctx,
+    soma_context = soma_context()
+  ))
+  group$create(internal_use_only = "allowed_use")
+  group$close()
+})
+
+test_that("Existence proof: soma_context()", {
+  skip_if(!extended_tests() || covr_tests())
+  skip_on_ci()
+
+  uri <- "s3://cellxgene-census-public-us-west-2/cell-census/2024-07-01/soma/"
+  expect_s3_class(
+    grp1 <- TileDBGroup$new(uri, internal_use_only = "allowed_use"),
+    class = 'TileDBGroup'
+  )
+  on.exit(grp1$close(), add = TRUE, after = FALSE)
+  expect_error(grp1$names())
+  grp1$close()
+
+  expect_s3_class(
+    grp2 <- TileDBGroup$new(
+      uri,
+      internal_use_only = "allowed_use",
+      soma_context = soma_context(config = c(vfs.s3.region = "us-west-2", vfs.s3.no_sign_request = "true"))
+    ),
+    class = 'TileDBGroup'
+  )
+  on.exit(grp2$close(), add = TRUE, after = FALSE)
+  expect_identical(grp2$mode(), "CLOSED")
+  expect_no_condition(grp2$open(mode = "READ", internal_use_only = "allowed_use"))
+  expect_type(grp2$names(), "character")
+})
+
+test_that("Existence proof: SOMATileDBContext", {
+  skip_if(!extended_tests() || covr_tests())
+  skip_on_ci()
+
+  uri <- "s3://cellxgene-census-public-us-west-2/cell-census/2024-07-01/soma/"
+  expect_s3_class(
+    grp1 <- TileDBGroup$new(uri, internal_use_only = "allowed_use"),
+    class = 'TileDBGroup'
+  )
+  on.exit(grp1$close(), add = TRUE, after = FALSE)
+  expect_error(grp1$names())
+  grp1$close()
+
+  ctx <- SOMATileDBContext$new(config = c(vfs.s3.region = "us-west-2", vfs.s3.no_sign_request = "true"))
+  expect_s3_class(
+    grp2 <- TileDBGroup$new(
+      uri,
+      internal_use_only = "allowed_use",
+      tiledbsoma_ctx = ctx
+    ),
+    class = 'TileDBGroup'
+  )
+  on.exit(grp2$close(), add = TRUE, after = FALSE)
+  expect_identical(grp2$mode(), "CLOSED")
+  expect_no_condition(grp2$open(mode = "READ", internal_use_only = "allowed_use"))
+  expect_type(grp2$names(), "character")
+})