add live warehouse test helpers

DESCRIPTION

@@ -43,6 +43,7 @@ Suggests:
     dbplyr,
     dplyr,
     htmltools,
+    odbc,
     otel (>= 0.2.0),
     otelsdk (>= 0.2.0),
     pins,

tests/testthat/README.md

@@ -0,0 +1,30 @@
+# Live warehouse tests
+
+The Snowflake and Databricks smoke tests are opt in. The ordinary test suite
+skips them before connecting, so contributors do not need warehouse credentials
+or ODBC drivers.
+
+To run the Snowflake test, configure `odbc::snowflake()` with a default
+warehouse and set:
+
+```r
+options(commons.test.snowflake = DBI::Id(
+  catalog = "...",
+  schema = "...",
+  table = "..."
+))
+```
+
+To run the Databricks test, configure an ODBC DSN named `Databricks` and set:
+
+```r
+options(commons.test.databricks = DBI::Id(
+  catalog = "...",
+  schema = "...",
+  table = "..."
+))
+```
+
+Each test queries the current identity and namespace, then reads at most one row
+from the configured table. If a backend's option is absent, its test skips. Once
+enabled, connection and query failures fail the test.

tests/testthat/helper-live-warehouses.R

@@ -0,0 +1,44 @@
+local_warehouse_connection <- function(backend, env = parent.frame()) {
+  backend <- match.arg(backend, c("snowflake", "databricks"))
+  warehouse_test_table(backend)
+  skip_if_not_installed("odbc")
+
+  con <- switch(
+    backend,
+    snowflake = DBI::dbConnect(odbc::snowflake()),
+    databricks = DBI::dbConnect(
+      odbc::odbc(),
+      "Databricks"
+    )
+  )
+  withr::defer(DBI::dbDisconnect(con), envir = env)
+  con
+}
+
+warehouse_test_table <- function(backend, call = rlang::caller_env()) {
+  backend <- match.arg(backend, c("snowflake", "databricks"))
+  option <- paste0("commons.test.", backend)
+  table <- getOption(option)
+  skip_if(
+    is.null(table),
+    paste0(
+      "Set options(", option, " = DBI::Id(...)) to run live warehouse tests"
+    )
+  )
+  if (!inherits(table, "Id")) {
+    cli::cli_abort(
+      "The {.option {option}} option must be a {.cls DBI::Id} object.",
+      call = call
+    )
+  }
+  table
+}
+
+warehouse_read_one <- function(con, id) {
+  sql <- paste(
+    "SELECT * FROM",
+    DBI::dbQuoteIdentifier(con, id),
+    "LIMIT 1"
+  )
+  DBI::dbGetQuery(con, sql)
+}

tests/testthat/test-live-warehouses.R

@@ -0,0 +1,44 @@
+test_that("live Snowflake connection reads a configured table", {
+  table <- warehouse_test_table("snowflake")
+  con <- local_warehouse_connection("snowflake")
+
+  session <- DBI::dbGetQuery(
+    con,
+    paste(
+      "SELECT CURRENT_USER() AS principal,",
+      "CURRENT_ROLE() AS role,",
+      "CURRENT_DATABASE() AS catalog,",
+      "CURRENT_SCHEMA() AS schema"
+    )
+  )
+  rows <- warehouse_read_one(con, table)
+  names(session) <- tolower(names(session))
+
+  expect_equal(nrow(session), 1)
+  expect_named(session, c("principal", "role", "catalog", "schema"))
+  expect_true(nzchar(session$principal[[1]]))
+  expect_s3_class(rows, "data.frame")
+  expect_true(nrow(rows) <= 1)
+})
+
+test_that("live Databricks connection reads a configured table", {
+  table <- warehouse_test_table("databricks")
+  con <- local_warehouse_connection("databricks")
+
+  session <- DBI::dbGetQuery(
+    con,
+    paste(
+      "SELECT CURRENT_USER() AS principal,",
+      "CURRENT_CATALOG() AS catalog,",
+      "CURRENT_SCHEMA() AS schema"
+    )
+  )
+  rows <- warehouse_read_one(con, table)
+  names(session) <- tolower(names(session))
+
+  expect_equal(nrow(session), 1)
+  expect_named(session, c("principal", "catalog", "schema"))
+  expect_true(nzchar(session$principal[[1]]))
+  expect_s3_class(rows, "data.frame")
+  expect_true(nrow(rows) <= 1)
+})