tests/testthat/test-check.R

test_that("check_sqlite_connection", {
  expect_error(
    check_sqlite_connection(1),
    class = "chk_error"
  )
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")

  expect_identical(check_sqlite_connection(conn), NULL)
  expect_identical(check_sqlite_connection(conn, connected = TRUE), NULL)
  expect_error(
    check_sqlite_connection(conn, connected = FALSE),
    class = "chk_error"
  )
  DBI::dbDisconnect(conn)

  expect_identical(check_sqlite_connection(conn), NULL)
  expect_error(
    check_sqlite_connection(conn, connected = TRUE),
    class = "chk_error"
  )
  expect_identical(check_sqlite_connection(conn, connected = FALSE), NULL)
})

test_that("check_table_name", {
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  withr::defer(DBI::dbDisconnect(conn))

  local <- data.frame(x = 1:2)
  expect_true(DBI::dbCreateTable(conn, "local", local))

  expect_error(
    check_table_name(1, conn),
    class = "chk_error"
  )
  expect_error(
    check_table_name("e", conn),
    class = "chk_error"
  )
  expect_identical(check_table_name("local", conn), "local")
})

test_that("check_column_name", {
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  withr::defer(DBI::dbDisconnect(conn))

  local <- data.frame(test = 1:2)
  expect_true(DBI::dbCreateTable(conn, "local", local))

  expect_error(
    check_column_name("test", table_name = 1, exists = TRUE, conn),
    class = "chk_error"
  )
  expect_error(
    check_column_name("test", table_name = "e", exists = TRUE, conn),
    class = "chk_error"
  )
  expect_error(
    check_column_name(1, table_name = "local", exists = TRUE, conn),
    class = "chk_error"
  )
  expect_error(
    check_column_name("e", table_name = "local", exists = TRUE, conn),
    class = "chk_error"
  )
  expect_identical(check_column_name("test", table_name = "local", exists = TRUE, conn), "test")
  expect_identical(check_column_name("e", table_name = "local", exists = FALSE, conn), "e")
})

test_that("check_column_blob", {
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  withr::defer(DBI::dbDisconnect(conn))

  local <- data.frame(test = 1:2)
  expect_true(DBI::dbCreateTable(conn, "local", local))
  expect_true(add_blob_column("blob", table_name = "local", conn = conn))

  expect_error(
    check_column_blob("test", table_name = "local", conn)
  )
  expect_error(
    check_column_blob("x", table_name = "local", conn)
  )
  expect_identical(check_column_blob("blob", table_name = "local", conn), "blob")
})

test_that("check_key", {
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  withr::defer(DBI::dbDisconnect(conn))

  df <- data.frame(
    char = c("a", "b", "b"),
    num = c(1.1, 2.2, 2.2),
    key = c(1, 2, 3),
    stringsAsFactors = FALSE
  )
  expect_true(DBI::dbWriteTable(conn, "df", df))
  key <- df[1, ]
  key2 <- "a"
  key3 <- data.frame(num = 1.1, key = 2)

  expect_error(
    check_key(table_name = "df", key = key2, conn)
  )
  expect_error(
    check_key(table_name = "df", key = key3, conn)
  )
  expect_identical(check_key(table_name = "df", key = key, conn), key)
})

test_that("check_flob_query", {
  x <- list(NULL)
  expect_error(check_flob_query(x))
  expect_error(check_flob_query(x))

  flob_obj <- flobr::flob_obj
  slob_obj <- flobr:::slob_obj

  blobbed_flob <- flob_obj
  class(blobbed_flob) <- "blob"
  flobr::chk_slob(blobbed_flob)
  class(blobbed_flob) <- "list"
  blobbed_flob <- blob::as_blob(blobbed_flob)
  names(blobbed_flob) <- NULL

  expect_identical(check_flob_query(flob_obj, slob = FALSE), flob_obj)
  expect_identical(check_flob_query(flob_obj, slob = NA), flob_obj)
  expect_identical(check_flob_query(flob_obj, slob = TRUE), blobbed_flob)

  expect_identical(check_flob_query(slob_obj, slob = TRUE), slob_obj)
  expect_identical(check_flob_query(slob_obj, slob = NA), slob_obj)

  expect_error(check_flob_query("non-blob", slob = TRUE), "`x` must be a blob of a serialized object.")
  # this is not ideal behavior
  expect_error(check_flob_query(slob_obj, slob = FALSE), "Serialized element of `x` must inherit from S3 class 'exint'.")
})
poissonconsulting/dbflobr documentation built on Jan. 17, 2025, 10:59 a.m.