Refactor database tests into individual test blocks (#725)

* Add `test_con()` helper and move individual database tests into own blocks
* Add `local_table()` helper

Fixes #634

R/utils.R

@@ -142,3 +142,9 @@ is_windows <- function() {
 }
 
 compact <- function(x) x[!vapply(x, is.null, logical(1))]
+
+random_name <- function(prefix = "") {
+  vals <- c(letters, LETTERS, 0:9)
+  name <- paste0(sample(vals, 10, replace = TRUE), collapse = "")
+  paste0(prefix, "odbc_", name)
+}

tests/testthat/_snaps/driver-sql-server.md

@@ -1,4 +1,23 @@
-# Create / write to temp table
+# dbWriteTable errors if field.types don't exist (#271)
+
+    Code
+      sqlCreateTable(con, "foo", iris, field.types = list(bar = "[int]"))
+    Condition
+      Warning:
+      Some columns in `field.types` not in the input, missing columns:
+        - 'bar'
+    Output
+      <SQL> CREATE TABLE "foo" (
+        "Sepal.Length" FLOAT,
+        "Sepal.Width" FLOAT,
+        "Petal.Length" FLOAT,
+        "Petal.Width" FLOAT,
+        "Species" varchar(255),
+        "bar" [int]
+      )
+      
+
+# can create / write to temp table
 
     Temporary flag is set to true, but table name doesn't use # prefix
 

tests/testthat/helper.R

@@ -9,6 +9,21 @@ test_connection_string <- function(db) {
   list(.connection_string = cs)
 }
 
+test_con <- function(db, ...) {
+  dbConnect(
+    odbc::odbc(),
+    .connection_string = test_connection_string(db),
+    ...
+  )
+}
+
+local_table <- function(con, name, df, ..., envir = parent.frame()) {
+  dbWriteTable(con, name, df, ...)
+  withr::defer(dbRemoveTable(con, name), envir = envir)
+
+  name
+}
+
 skip_if_no_drivers <- function() {
   if (nrow(odbcListDrivers()) == 0) {
     skip("No drivers installed")
@@ -44,7 +59,7 @@ skip_if_no_drivers <- function() {
 #' # Only test a specific column
 #' test_roundtrip(con, "integer", invert = FALSE)
 #' }
-test_roundtrip <- function(con = DBItest:::connect(DBItest::get_default_context()), columns = "", invert = TRUE, force_sorted = FALSE) {
+test_roundtrip <- function(con, columns = "", invert = TRUE, force_sorted = FALSE) {
   dbms <- dbGetInfo(con)$dbms.name
   res <- list()
   testthat::test_that(paste0("[", dbms, "] round tripping data.frames works"), {

tests/testthat/test-driver-mysql.R

@@ -81,33 +81,38 @@ test_that("MySQL", {
     "reexport",
     NULL
   ))
+})
+
+test_that("can roundtrip columns", {
+  test_roundtrip(test_con("MYSQL"), columns = c("logical", "binary"))
+})
 
-  test_roundtrip(columns = c("logical", "binary"))
-  test_that("odbcPreviewObject", {
-    tblName <- "test_preview"
-    con <- DBItest:::connect(DBItest:::get_default_context())
-    dbWriteTable(con, tblName, data.frame(a = 1:10L))
-    on.exit(dbRemoveTable(con, tblName))
-    # There should be no "Pending rows" warning
-    expect_no_warning({
-      res <- odbcPreviewObject(con, rowLimit = 3, table = tblName)
-    })
-    expect_equal(nrow(res), 3)
+test_that("odbcPreviewObject", {
+  con <- test_con("MYSQL")
+  tbl <- local_table(con, "test_preview", data.frame(a = 1:10L))
+
+  # There should be no "Pending rows" warning
+  expect_no_warning({
+    res <- odbcPreviewObject(con, rowLimit = 3, table = tbl)
   })
-  test_that("sproc result retrieval", {
-    sprocName <- "testSproc"
-    con <- DBItest:::connect(DBItest:::get_default_context())
-    DBI::dbExecute(
-      con,
-      paste0("CREATE PROCEDURE ", sprocName, "(IN arg INT) BEGIN SELECT 'abc' as TestCol; END")
-    )
-    on.exit(DBI::dbExecute(con, paste0("DROP PROCEDURE ", sprocName)))
-    expect_no_error({
-      res <- dbGetQuery(con, paste0("CALL ", sprocName, "(1)"))
-    })
-    expect_identical(
-      res,
-      data.frame("TestCol" = "abc", stringsAsFactors = FALSE)
-    )
+  expect_equal(nrow(res), 3)
+})
+
+test_that("sproc result retrieval", {
+  con <- test_con("MYSQL")
+
+  sprocName <- "testSproc"
+  DBI::dbExecute(
+    con,
+    paste0("CREATE PROCEDURE ", sprocName, "(IN arg INT) BEGIN SELECT 'abc' as TestCol; END")
+  )
+  on.exit(DBI::dbExecute(con, paste0("DROP PROCEDURE ", sprocName)))
+
+  expect_no_error({
+    res <- dbGetQuery(con, paste0("CALL ", sprocName, "(1)"))
   })
+  expect_identical(
+    res,
+    data.frame("TestCol" = "abc", stringsAsFactors = FALSE)
+  )
 })

tests/testthat/test-driver-oracle.R

@@ -1,24 +1,20 @@
-test_that("Oracle", {
-
-  con <- dbConnect(odbc::odbc(), .connection_string = test_connection_string("ORACLE"))
+test_that("can round columns", {
+  con <- test_con("ORACLE")
   # - Long/outstanding issue with batch inserting
   # date/datetime for Oracle.  See for example
   # #349, #350, #391
   # - There also looks like there are issues related
   # to binary elements of size zero.
   # - Finally, no boolean in Oracle prior to 23
   test_roundtrip(con, columns = c("time", "date", "datetime", "binary", "logical"))
+})
+
+test_that("can detect existence of table", {
+  con <- test_con("ORACLE")
+
+  tbl1 <- local_table(con, "mtcarstest", mtcars)
+  expect_true(dbExistsTable(con, tbl1))
 
-  local({
-    # Test custom dbExistsTable implementation for
-    # Oracle
-    dbWriteTable(con, "mtcarstest", mtcars)
-    expect_true(dbExistsTable(con, "mtcarstest"))
-    dbWriteTable(con, "mtcars_test", mtcars)
-    expect_true(dbExistsTable(con, "mtcars_test"))
-    on.exit({
-      dbRemoveTable(con, "mtcarstest")
-      dbRemoveTable(con, "mtcars_test")
-    })
-  })
+  tbl2 <- local_table(con, "mtcars_test", mtcars)
+  expect_true(dbExistsTable(con, tbl2))
 })

tests/testthat/test-driver-postgres.R

@@ -6,77 +6,6 @@ test_that("PostgreSQL", {
     name = "PostgreSQL"
   )
 
-  test_that("show method works as expected with real connection", {
-    skip_on_os("windows")
-    con <- DBItest:::connect(DBItest:::get_default_context())
-
-    expect_output(show(con), "@localhost")
-    expect_output(show(con), "Database: [a-z]+")
-    expect_output(show(con), "PostgreSQL Version: ")
-  })
-
-  test_that("64 bit integers work with alternate mappings", {
-    con_default <- DBItest:::connect(DBItest:::get_default_context())
-    con_integer64 <-
-      DBItest:::connect(DBItest:::get_default_context(), bigint = "integer64")
-    con_integer <-
-      DBItest:::connect(DBItest:::get_default_context(), bigint = "integer")
-    con_numeric <-
-      DBItest:::connect(DBItest:::get_default_context(), bigint = "numeric")
-    con_character <-
-      DBItest:::connect(DBItest:::get_default_context(), bigint = "character")
-
-    dbWriteTable(con_default, "test", data.frame(a = 1:10L), field.types = c(a = "BIGINT"))
-    on.exit(dbRemoveTable(con_default, "test"))
-
-    expect_s3_class(dbReadTable(con_default, "test")$a, "integer64")
-    expect_s3_class(dbReadTable(con_integer64, "test")$a, "integer64")
-
-    expect_type(dbReadTable(con_integer, "test")$a, "integer")
-
-    expect_type(dbReadTable(con_numeric, "test")$a, "double")
-
-    expect_type(dbReadTable(con_character, "test")$a, "character")
-  })
-
-  # This test checks whether when writing to a table and using
-  # result_describe_parameters to offer descriptions of the data
-  # we are attempting to write, our logic remains robust to the
-  # case when the data being written has columns ordered
-  # differently than the table we are targetting.
-  test_that("Writing data.frame with column ordering different than target table", {
-    tblName <- "test_order_write"
-    con <- DBItest:::connect(DBItest:::get_default_context())
-    values <- data.frame(
-      datetime = as.POSIXct(c(14, 15), origin = "2016-01-01", tz = "UTC"),
-      name = c("one", "two"),
-      num = 1:2,
-      stringsAsFactors = FALSE
-    )
-    sql <- sqlCreateTable(con, tblName, values)
-    dbExecute(con, sql)
-    on.exit(dbRemoveTable(con, tblName))
-    dbWriteTable(con, tblName, values[c(2, 3, 1)],
-      overwrite = FALSE, append = TRUE
-    )
-    received <- DBI::dbReadTable(con, tblName)
-    received <- received[order(received$num), ]
-    row.names(received) <- NULL
-    expect_equal(values, received)
-  })
-
-  test_that("odbcPreviewObject", {
-    tblName <- "test_preview"
-    con <- DBItest:::connect(DBItest:::get_default_context())
-    dbWriteTable(con, tblName, data.frame(a = 1:10L))
-    on.exit(dbRemoveTable(con, tblName))
-    # There should be no "Pending rows" warning
-    expect_no_warning({
-      res <- odbcPreviewObject(con, rowLimit = 3, table = tblName)
-    })
-    expect_equal(nrow(res), 3)
-  })
-
   DBItest::test_getting_started(c(
     "package_name", # Not an error
     NULL
@@ -163,6 +92,73 @@ test_that("PostgreSQL", {
     "reexport", # TODO
     NULL
   ))
+})
+
+test_that("can roundtrip columns", {
+  con <- test_con("POSTGRES")
+  test_roundtrip(con)
+})
+
+test_that("show method works as expected with real connection", {
+  skip_on_os("windows")
+  con <- test_con("POSTGRES")
+
+  expect_output(show(con), "@localhost")
+  expect_output(show(con), "Database: [a-z]+")
+  expect_output(show(con), "PostgreSQL Version: ")
+})
+
+test_that("64 bit integers work with alternate mappings", {
+  con_integer64 <- test_con("POSTGRES", bigint = "integer64")
+  con_integer <- test_con("POSTGRES", bigint = "integer")
+  con_numeric <- test_con("POSTGRES", bigint = "numeric")
+  con_character <- test_con("POSTGRES", bigint = "character")
+
+  tbl <- local_table(
+    con_integer64,
+    "test",
+    data.frame(a = 1:10L),
+    field.types = c(a = "BIGINT")
+  )
+
+  expect_s3_class(dbReadTable(con_integer64, tbl)$a, "integer64")
+  expect_type(dbReadTable(con_integer, tbl)$a, "integer")
+  expect_type(dbReadTable(con_numeric, tbl)$a, "double")
+  expect_type(dbReadTable(con_character, tbl)$a, "character")
+})
+
+# This test checks whether when writing to a table and using
+# result_describe_parameters to offer descriptions of the data
+# we are attempting to write, our logic remains robust to the
+# case when the data being written has columns ordered
+# differently than the table we are targetting.
+test_that("Writing data.frame with column ordering different than target table", {
+  con <- test_con("POSTGRES")
+  values <- data.frame(
+    datetime = as.POSIXct(c(14, 15), origin = "2016-01-01", tz = "UTC"),
+    name = c("one", "two"),
+    num = 1:2,
+    stringsAsFactors = FALSE
+  )
+  tbl <- "test_order_write"
+  dbCreateTable(con, tbl, values)
+  dbAppendTable(con, tbl, values[c(2, 3, 1)])
+  on.exit(dbRemoveTable(con, tbl))
+
+  received <- dbReadTable(con, tbl)
+  received <- received[order(received$num), ]
+  row.names(received) <- NULL
+  expect_equal(values, received)
+})
+
+test_that("odbcPreviewObject", {
+  con <- test_con("POSTGRES")
+  tbl <- local_table(con, "test_preview", data.frame(a = 1:10L))
 
-  test_roundtrip()
+  # There should be no "Pending rows" warning
+  expect_no_warning({
+    res <- odbcPreviewObject(con, rowLimit = 3, table = tbl)
+  })
+  expect_equal(nrow(res), 3)
 })
+