tests/testthat/test-database-explorer.R

In termr: Modern Reactive Terminal Applications with Data Workflows

test_that("db_metadata exposes portable metadata and SQLite views", {
  skip_if_not_installed("DBI")
  skip_if_not_installed("RSQLite")
  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  on.exit(DBI::dbDisconnect(con), add = TRUE)
  DBI::dbWriteTable(con, "items", data.frame(id = 1:3, name = letters[1:3]))
  DBI::dbExecute(con, "CREATE VIEW item_names AS SELECT name FROM items")
  metadata <- db_metadata(con)
  expect_identical(metadata$schemas(), character())
  expect_true("items" %in% metadata$tables())
  expect_true("item_names" %in% metadata$views())
  expect_identical(metadata$columns("items"), c("id", "name"))
  expect_match(metadata$quote("odd name"), "odd name")
})

test_that("database explorer loads metadata lazily and previews SQLite tables", {
  skip_if_not_installed("DBI")
  skip_if_not_installed("RSQLite")
  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  on.exit(if (DBI::dbIsValid(con)) DBI::dbDisconnect(con), add = TRUE)
  DBI::dbWriteTable(con, "mtcars", mtcars)
  DBI::dbWriteTable(con, "iris", iris)
  explorer <- db_explorer(db_connection(con, name = "test SQLite"))
  groups <- explorer$objects$root$children
  expect_length(groups, 2L)
  expect_false(groups[[1L]]$loaded)
  expect_false(groups[[2L]]$loaded)
  expect_no_error(render_widget(explorer, 100, 30))
  expect_false(groups[[1L]]$loaded)

  pilot <- test_app(app(explorer), width = 100, height = 30)
  on.exit(pilot$stop(), add = TRUE)
  groups[[1L]]$expand()
  expect_setequal(vapply(groups[[1L]]$children, `[[`, "", "label"), c("iris", "mtcars"))
  mtcars_node <- explorer$objects$root$find("db_table_mtcars")
  explorer$objects$select(mtcars_node)
  pilot$step()
  expect_equal(explorer$preview$row_count, nrow(mtcars))
  expect_equal(explorer$preview$row_data(1L)$mpg, mtcars$mpg[[1L]])
  expect_match(explorer$details$text, "Rows: 32")
  expect_true(explorer$preview$source_stats()$fetch_calls > 0L)
  explorer$object_search$value <- "mtc"
  pilot$step()
  filtered <- explorer$objects$root$find("db_tables")
  expect_true(filtered$expanded)
  expect_identical(vapply(filtered$children, `[[`, "", "label"), "mtcars")
  # The object filter ignores case.
  explorer$object_search$value <- "MTC"
  expect_no_warning(pilot$step())
  filtered <- explorer$objects$root$find("db_tables")
  expect_identical(vapply(filtered$children, `[[`, "", "label"), "mtcars")
  explorer$object_search$value <- ""
  pilot$step()

  DBI::dbWriteTable(con, "new table", data.frame(value = 1), overwrite = TRUE)
  expect_true(explorer$refresh())
  refreshed <- explorer$objects$root$children[[1L]]
  expect_false(refreshed$loaded)
  refreshed$expand()
  expect_true("new table" %in% vapply(refreshed$children, `[[`, "", "label"))
})

test_that("database explorer runs SQL, keeps history, reports errors and preserves ownership", {
  skip_if_not_installed("DBI")
  skip_if_not_installed("RSQLite")
  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  on.exit(if (DBI::dbIsValid(con)) DBI::dbDisconnect(con), add = TRUE)
  DBI::dbWriteTable(con, "items", data.frame(id = 1:3, name = letters[1:3]))
  external <- db_connection(con, name = "external")
  explorer <- db_explorer(external)
  pilot <- test_app(app(explorer), width = 100, height = 30)
  expect_false(explorer$open_table("missing table"))
  expect_match(explorer$status$text, "Unable to list fields")
  expect_gt(length(pilot$app$notifications()), 0L)
  explorer$sql$set_text("SELECT * FROM items ORDER BY id")
  result <- explorer$run_query()
  pilot$step()
  expect_true(result$ok)
  expect_identical(explorer$query_results$row_count, 3L)
  expect_equal(explorer$query_results$row_data(2L)$name, "b")
  explorer$tabs$activate("db_sql_tab")
  expect_identical(explorer$tabs$active_tab$id, "db_sql_tab")
  expect_length(explorer$query_history(), 1L)
  expect_true(explorer$query_history()[[1L]]$ok)
  expect_match(explorer$status$text, "3 rows")

  explorer$sql$set_text("SELECT * FROM missing_table")
  failed <- explorer$run_query()
  pilot$step()
  expect_false(failed$ok)
  expect_length(explorer$query_history(), 2L)
  expect_false(explorer$query_history()[[2L]]$ok)
  expect_match(explorer$status$text, "Query failed")
  expect_true(any(vapply(explorer$query_history(), function(x) !x$ok && nzchar(x$error), logical(1))))
  pilot$stop()
  expect_true(external$is_valid())
  DBI::dbDisconnect(con)
  expect_false(explorer$refresh())
  expect_match(explorer$status$text, "Disconnected")

  owned_con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  on.exit(if (DBI::dbIsValid(owned_con)) DBI::dbDisconnect(owned_con), add = TRUE)
  owned <- db_connection(owned_con, owned = TRUE)
  owned_explorer <- db_explorer(owned)
  owned_pilot <- test_app(app(owned_explorer), width = 50, height = 15)
  owned_pilot$stop()
  expect_false(owned$is_valid())
})

test_that("SQLite preview and generated SQL quote unusual identifiers", {
  skip_if_not_installed("DBI")
  skip_if_not_installed("RSQLite")
  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  on.exit(DBI::dbDisconnect(con), add = TRUE)
  table <- paste0("select \" caf", "\u00e9")
  DBI::dbWriteTable(con, table, data.frame("select value" = 42, check.names = FALSE))
  explorer <- db_explorer(con)
  expect_true(explorer$open_table(table))
  expect_equal(explorer$preview$row_data(1L)[["select value"]], 42)
  expect_true(explorer$action_open_table_in_sql())
  expect_true(grepl("SELECT *", explorer$sql$value, fixed = TRUE))
  expect_true(grepl("caf\u00e9", explorer$sql$value, fixed = TRUE))
})

test_that("database-explorer is registered and its example handles optional packages", {
  expect_true("database-explorer" %in% run_example())
  if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) {
    explorer_app <- load_example("database-explorer")
    expect_s3_class(explorer_app, "App")
    # Starting and stopping the app closes the example's own connection.
    test_app(explorer_app)$stop()
  } else {
    expect_message(load_example("database-explorer"), "DBI and RSQLite")
  }
})