From 888bd421f74cd06000074266d55134bd7269adf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Wed, 26 Feb 2025 12:56:39 +0100 Subject: [PATCH 001/129] chore(DESCRIPTION): Add RJDBC to Suggests --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index d00dc101..e351ba0e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,6 +63,7 @@ Suggests: microbenchmark, odbc, pak, + RJDBC, rmarkdown, roxygen2, pkgdown, From ba32d0e551f5539e45335d3a38fc45b1e8490356 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 9 Oct 2025 22:22:57 +0200 Subject: [PATCH 002/129] docs(connection): Restructure the Roxygen docs --- R/connection.R | 26 +++++++++++++------------- man/get_connection.Rd | 8 ++++---- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/R/connection.R b/R/connection.R index 804f94f3..e9991b98 100644 --- a/R/connection.R +++ b/R/connection.R @@ -7,15 +7,6 @@ #' Certain drivers may use credentials stored in a file, such as ~/.pgpass (PostgreSQL). #' @param drv (`DBIDriver(1)` or `DBIConnection(1)`)\cr #' The driver for the connection (defaults to `SQLiteDriver`). -#' @param dbname (`character(1)`)\cr -#' Name of the database located at the host. -#' @param bigint (`character(1)`)\cr -#' The datatype to convert integers to. -#' Support depends on the database backend. -#' @param timezone (`character(1)`)\cr -#' Sets the timezone of DBI::dbConnect(). Must be in [OlsonNames()]. -#' @param timezone_out (`character(1)`)\cr -#' Sets the timezone_out of DBI::dbConnect(). Must be in [OlsonNames()]. #' @param ... #' Additional parameters sent to DBI::dbConnect(). #' @return @@ -38,6 +29,11 @@ get_connection <- function(drv, ...) { } #' @rdname get_connection +#' @param dbname (`character(1)`)\cr +#' Name of the database located at the host. +#' @param bigint (`character(1)`)\cr +#' The datatype to convert integers to. +#' Support depends on the database backend. #' @seealso [RSQLite::SQLite] #' @export get_connection.SQLiteDriver <- function( @@ -74,12 +70,16 @@ get_connection.SQLiteDriver <- function( #' The ip of the host to connect to. #' @param port (`numeric(1)` or `character(1)`)\cr #' Host port to connect to. -#' @param password (`character(1)`)\cr -#' Password to login with. #' @param user (`character(1)`)\cr #' Username to login with. +#' @param password (`character(1)`)\cr +#' Password to login with. #' @param check_interrupts (`logical(1)`)\cr #' Should user interrupts be checked during the query execution? +#' @param timezone (`character(1)`)\cr +#' Sets the timezone of DBI::dbConnect(). Must be in [OlsonNames()]. +#' @param timezone_out (`character(1)`)\cr +#' Sets the timezone_out of DBI::dbConnect(). Must be in [OlsonNames()]. #' @seealso [RPostgres::Postgres] #' @export get_connection.PqDriver <- function( @@ -87,8 +87,8 @@ get_connection.PqDriver <- function( dbname = NULL, host = NULL, port = NULL, - password = NULL, user = NULL, + password = NULL, ..., bigint = c("integer", "bigint64", "numeric", "character"), check_interrupts = TRUE, @@ -113,8 +113,8 @@ get_connection.PqDriver <- function( port <- as.numeric(port) } checkmate::assert_numeric(port, null.ok = TRUE, add = coll) - checkmate::assert_character(password, null.ok = TRUE, add = coll) checkmate::assert_character(user, null.ok = TRUE, add = coll) + checkmate::assert_character(password, null.ok = TRUE, add = coll) checkmate::assert_logical(check_interrupts, add = coll) checkmate::assert_choice(timezone, OlsonNames(), null.ok = TRUE, add = coll) checkmate::assert_choice(timezone_out, OlsonNames(), null.ok = TRUE, add = coll) diff --git a/man/get_connection.Rd b/man/get_connection.Rd index 4c474332..d3115bda 100644 --- a/man/get_connection.Rd +++ b/man/get_connection.Rd @@ -23,8 +23,8 @@ get_connection(drv, ...) dbname = NULL, host = NULL, port = NULL, - password = NULL, user = NULL, + password = NULL, ..., bigint = c("integer", "bigint64", "numeric", "character"), check_interrupts = TRUE, @@ -70,12 +70,12 @@ The ip of the host to connect to.} \item{port}{(\code{numeric(1)} or \code{character(1)})\cr Host port to connect to.} -\item{password}{(\code{character(1)})\cr -Password to login with.} - \item{user}{(\code{character(1)})\cr Username to login with.} +\item{password}{(\code{character(1)})\cr +Password to login with.} + \item{check_interrupts}{(\code{logical(1)})\cr Should user interrupts be checked during the query execution?} From ba54b5795d42778b921c7cf3ca1acb9a901a4236 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 9 Oct 2025 22:38:42 +0200 Subject: [PATCH 003/129] feat(get_connection): Add JDBCDriver method --- NAMESPACE | 1 + R/connection.R | 40 ++++++++++++++++++++++++++++++++++++++++ inst/WORDLIST | 2 ++ man/get_connection.Rd | 22 ++++++++++++++++++++++ 4 files changed, 65 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 42f4d565..56e386c1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ S3method(get_catalog,Id) S3method(get_catalog,default) S3method(get_catalog,duckdb_connection) S3method(get_catalog,tbl_dbi) +S3method(get_connection,JDBCDriver) S3method(get_connection,OdbcDriver) S3method(get_connection,PqDriver) S3method(get_connection,SQLiteDriver) diff --git a/R/connection.R b/R/connection.R index e9991b98..072ca86e 100644 --- a/R/connection.R +++ b/R/connection.R @@ -207,6 +207,46 @@ get_connection.duckdb_driver <- function( return(do.call(DBI::dbConnect, args = args)) } +#' @rdname get_connection +#' @param driverClass (`character(1)`)\cr +#' The name of the JDBC driver to load. +#' @param classPath (`character(1)`)\cr +#' The path to the JDBC driver. +#' @param url (`character(1)`)\cr +#' The source to connect to. +#' @seealso [RJDBC::JDBC] +#' @export +get_connection.JDBCDriver <- function( + drv, + driverClass = NULL, # nolint: object_name_linter + classPath = NULL, # nolint: object_name_linter + url = NULL, + user = NULL, + password = NULL, + ...) { + + # Store the given arguments + args <- as.list(rlang::current_env()) %>% + utils::modifyList(list(...)) %>% + unlist() + args <- args[match(unique(names(args)), names(args))] + + # Check arguments + coll <- checkmate::makeAssertCollection() + checkmate::assert_character(driverClass, null.ok = TRUE, add = coll) + checkmate::assert_character(classPath, null.ok = TRUE, add = coll) + checkmate::assert_character(url, null.ok = TRUE, add = coll) + checkmate::assert_character(user, null.ok = TRUE, add = coll) + checkmate::assert_character(password, null.ok = TRUE, add = coll) + checkmate::reportAssertions(coll) + + # Check if connection can be established given these settings + status <- do.call(DBI::dbCanConnect, args = args) + if (!status) stop(attr(status, "reason"), call. = FALSE) + + return(do.call(DBI::dbConnect, args = args)) +} + #' @rdname get_connection #' @export #' @importFrom magrittr %>% diff --git a/inst/WORDLIST b/inst/WORDLIST index 740f2ec9..8fdc9a2d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -37,6 +37,8 @@ IANA Institut ip +JDBC + Kimball Lasse diff --git a/man/get_connection.Rd b/man/get_connection.Rd index d3115bda..27d354c1 100644 --- a/man/get_connection.Rd +++ b/man/get_connection.Rd @@ -6,6 +6,7 @@ \alias{get_connection.PqDriver} \alias{get_connection.OdbcDriver} \alias{get_connection.duckdb_driver} +\alias{get_connection.JDBCDriver} \alias{get_connection.default} \title{Opens connection to the database} \usage{ @@ -49,6 +50,16 @@ get_connection(drv, ...) timezone_out = Sys.timezone() ) +\method{get_connection}{JDBCDriver}( + drv, + driverClass = NULL, + classPath = NULL, + url = NULL, + user = NULL, + password = NULL, + ... +) + \method{get_connection}{default}(drv, ...) } \arguments{ @@ -90,6 +101,15 @@ The data source name to connect to.} \item{dbdir}{(\code{character(1)})\cr The directory where the database is located.} + +\item{driverClass}{(\code{character(1)})\cr +The name of the JDBC driver to load.} + +\item{classPath}{(\code{character(1)})\cr +The path to the JDBC driver.} + +\item{url}{(\code{character(1)})\cr +The source to connect to.} } \value{ An object that inherits from \code{DBIConnection} driver specified in \code{drv}. @@ -119,4 +139,6 @@ Certain drivers may use credentials stored in a file, such as ~/.pgpass (Postgre \link[odbc:dbConnect-OdbcDriver-method]{odbc::odbc} \link[duckdb:duckdb]{duckdb::duckdb} + +\link[RJDBC:JDBC]{RJDBC::JDBC} } From 2eabd164401c24f489bc34173123df56a4f872ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 10 Oct 2025 12:41:44 +0200 Subject: [PATCH 004/129] feat(schema_exists): Add Oracle support --- NAMESPACE | 1 + R/schema_exists.R | 8 ++++++++ 2 files changed, 9 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 56e386c1..abbaa581 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ S3method(id,data.frame) S3method(id,tbl_dbi) S3method(interlace,tbl_sql) S3method(schema_exists,DBIConnection) +S3method(schema_exists,JDBCConnection) S3method(schema_exists,SQLiteConnection) S3method(schema_exists,default) S3method(table_exists,DBIConnection) diff --git a/R/schema_exists.R b/R/schema_exists.R index 4f67f668..be7810ec 100644 --- a/R/schema_exists.R +++ b/R/schema_exists.R @@ -36,6 +36,14 @@ schema_exists.DBIConnection <- function(conn, schema) { return(nrow(result) == 1) } +#' @export +schema_exists.JDBCConnection <- function(conn, schema) { + query <- paste0("SELECT * FROM ALL_USERS WHERE USERNAME = '", schema, "'") + result <- DBI::dbGetQuery(conn, query) + + return(nrow(result) == 1) +} + #' @export schema_exists.default <- function(conn, schema) { From 5e16063e20a99bae8c7e1f75d35c7a554571e474 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:45:09 +0200 Subject: [PATCH 005/129] feat(get_connection): Warn the user that JDBCConnection is assumed to be Oracle --- R/connection.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/connection.R b/R/connection.R index 072ca86e..7acd0778 100644 --- a/R/connection.R +++ b/R/connection.R @@ -244,7 +244,18 @@ get_connection.JDBCDriver <- function( status <- do.call(DBI::dbCanConnect, args = args) if (!status) stop(attr(status, "reason"), call. = FALSE) - return(do.call(DBI::dbConnect, args = args)) + # Connect + conn <- do.call(DBI::dbConnect, args = args) + + # Assume connection is to an Oracle data base + rlang::warn( + message = paste0("Connections of class '", class(conn), "' are assumed to be connections to Oracle databases"), + .frequency = "regularly", + .frequency_id = "JDBC means Oracle warning", + call. = FALSE + ) + + return(conn) } #' @rdname get_connection From 112f699d5c0e44b700ef4f234a03b68fe246607b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:45:41 +0200 Subject: [PATCH 006/129] fix(create_logs_if_missing): Remove `catalog` field on Oracle --- R/create_logs_if_missing.R | 2 +- tests/testthat/test-create_logs_if_missing.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/create_logs_if_missing.R b/R/create_logs_if_missing.R index 8e1556c3..ba9d97a0 100644 --- a/R/create_logs_if_missing.R +++ b/R/create_logs_if_missing.R @@ -33,7 +33,7 @@ create_logs_if_missing <- function(conn, log_table) { log_file = character(0) ) - if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection"))) { + if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection", "JBDCConnection"))) { log_signature <- dplyr::select(log_signature, !"catalog") } diff --git a/tests/testthat/test-create_logs_if_missing.R b/tests/testthat/test-create_logs_if_missing.R index 43d4a8af..018a85ef 100644 --- a/tests/testthat/test-create_logs_if_missing.R +++ b/tests/testthat/test-create_logs_if_missing.R @@ -38,7 +38,7 @@ test_that("create_logs_if_missing() can create logs in default and test schema", log_file = character(0) ) - if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection"))) { + if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection", "JBDCConnection"))) { log_signature <- dplyr::select(log_signature, !"catalog") } From edc4b7358c66aa8871e5a6b98d076bfc4eac3986 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:47:38 +0200 Subject: [PATCH 007/129] debug(Oracle): Set `analyze = FALSE` on all `copy_to` calls --- R/Logger.R | 6 ++++-- R/digest_to_checksum.R | 2 +- R/locks.R | 9 ++++++--- R/update_snapshot.R | 4 ++-- tests/testthat/setup.R | 6 +++--- tests/testthat/test-create_logs_if_missing.R | 2 +- 6 files changed, 17 insertions(+), 12 deletions(-) diff --git a/R/Logger.R b/R/Logger.R index 51e9fec8..54ddd0cc 100644 --- a/R/Logger.R +++ b/R/Logger.R @@ -190,7 +190,8 @@ Logger <- R6::R6Class( dest = private$log_conn, df = patch, name = unique_table_name("SCDB_logger_patch"), - temporary = TRUE + temporary = TRUE, + analyze = FALSE ) defer_db_cleanup(patch) # Clean up on exit @@ -341,7 +342,8 @@ Logger <- R6::R6Class( dest = private$log_conn, df = patch, name = unique_table_name("SCDB_logger_patch"), - temporary = TRUE + temporary = TRUE, + analyze = FALSE ) defer_db_cleanup(patch) # Clean up on exit diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index 93ede804..d0c32fa5 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -75,7 +75,7 @@ digest_to_checksum.default <- function( id__ = dplyr::row_number(), dplyr::across(tidyselect::all_of(col), openssl::md5) ) %>% - dplyr::copy_to(dbplyr::remote_con(.data), df = ., name = unique_table_name("SCDB_digest_to_checksum_helper")) + dplyr::copy_to(dbplyr::remote_con(.data), df = ., name = unique_table_name("SCDB_digest_to_checksum_helper"), analyze = FALSE) defer_db_cleanup(checksums) .data <- .data %>% diff --git a/R/locks.R b/R/locks.R index 6dd6e056..5dbedb66 100644 --- a/R/locks.R +++ b/R/locks.R @@ -58,7 +58,8 @@ lock_table <- function(conn, db_table, schema = NULL) { "pid" = numeric(0) ), db_lock_table_id, - temporary = FALSE + temporary = FALSE, + analyze = FALSE ) if (inherits(conn, "PqConnection")) { # PostgreSQL needs an index for rows_insert @@ -89,7 +90,8 @@ lock_table <- function(conn, db_table, schema = NULL) { "pid" = Sys.getpid(), "lock_start" = as.numeric(Sys.time()) ), - name = unique_table_name("SCDB_lock") + name = unique_table_name("SCDB_lock"), + analyze = FALSE ) defer_db_cleanup(lock) @@ -174,7 +176,8 @@ unlock_table <- function(conn, db_table, schema = NULL, pid = Sys.getpid()) { "table" = purrr::pluck(db_table_id, "name", "table"), "pid" = pid ), - name = unique_table_name("SCDB_lock") + name = unique_table_name("SCDB_lock"), + analyze = FALSE ) defer_db_cleanup(lock) diff --git a/R/update_snapshot.R b/R/update_snapshot.R index 11562bbb..5b9d28a3 100644 --- a/R/update_snapshot.R +++ b/R/update_snapshot.R @@ -190,7 +190,7 @@ update_snapshot <- function(.data, conn, db_table, timestamp, filters = NULL, me # Copy to the target connection if needed if (!identical(dbplyr::remote_con(.data), conn)) { - .data <- dplyr::copy_to(conn, .data, name = unique_table_name("SCDB_update_snapshot_input")) + .data <- dplyr::copy_to(conn, .data, name = unique_table_name("SCDB_update_snapshot_input"), analyze = FALSE) defer_db_cleanup(.data) } @@ -221,7 +221,7 @@ update_snapshot <- function(.data, conn, db_table, timestamp, filters = NULL, me # Apply filter to current records if (!is.null(filters) && !identical(dbplyr::remote_con(filters), conn)) { - filters <- dplyr::copy_to(conn, filters, name = unique_table_name("SCDB_update_snapshot_filter")) + filters <- dplyr::copy_to(conn, filters, name = unique_table_name("SCDB_update_snapshot_filter"), analyze = FALSE) defer_db_cleanup(filters) } db_table <- filter_keys(db_table, filters) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index be5af595..905980a3 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -40,10 +40,10 @@ for (conn in get_test_conns()) { # Copy mtcars to conn dplyr::copy_to(conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), - name = id("test.mtcars", conn), temporary = FALSE, overwrite = TRUE) + name = id("test.mtcars", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) dplyr::copy_to(conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), - name = id("__mtcars", conn), temporary = FALSE, overwrite = TRUE) + name = id("__mtcars", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) dplyr::copy_to(conn, mtcars %>% @@ -51,7 +51,7 @@ for (conn in get_test_conns()) { digest_to_checksum() %>% dplyr::mutate(from_ts = as.POSIXct("2020-01-01 09:00:00"), until_ts = as.POSIXct(NA)), - name = id("__mtcars_historical", conn), temporary = FALSE, overwrite = TRUE) + name = id("__mtcars_historical", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) DBI::dbDisconnect(conn) } diff --git a/tests/testthat/test-create_logs_if_missing.R b/tests/testthat/test-create_logs_if_missing.R index 018a85ef..e868d8a4 100644 --- a/tests/testthat/test-create_logs_if_missing.R +++ b/tests/testthat/test-create_logs_if_missing.R @@ -43,7 +43,7 @@ test_that("create_logs_if_missing() can create logs in default and test schema", } log_signature <- log_signature %>% - dplyr::copy_to(conn, df = ., unique_table_name()) %>% + dplyr::copy_to(conn, df = ., unique_table_name(), analyze = FALSE) %>% dplyr::collect() expect_identical( From f4476e27377578e141120789f72a0d662293617f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:47:51 +0200 Subject: [PATCH 008/129] feat(getTableSignature): Add Oracle implementation --- R/getTableSignature.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/getTableSignature.R b/R/getTableSignature.R index 0ec36f1e..c87ccf76 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -39,6 +39,11 @@ methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { checksum = "char(32)", from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" + ), + "JDBCConnection" = c( + checksum = "CHAR(32)", + from_ts = "TIMESTAMP", + until_ts = "TIMESTAMP" ) ) From 2bddfd48d4f2031955fffc38050fededdfa69135 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:48:12 +0200 Subject: [PATCH 009/129] feat(DESCRIPTION): Add rJava to Suggests --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e351ba0e..e2fd816b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,10 +63,11 @@ Suggests: microbenchmark, odbc, pak, + pkgdown, + rJava, RJDBC, rmarkdown, roxygen2, - pkgdown, RPostgres, RSQLite, spelling, From da8faad5a83b9209a8548bcfd9e8306efae4f056 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:48:43 +0200 Subject: [PATCH 010/129] feat(get_schema): Add Oracle implementation --- NAMESPACE | 1 + R/get_schema.R | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index abbaa581..fe1b7c78 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,6 +35,7 @@ S3method(get_connection,duckdb_driver) S3method(get_schema,"Microsoft SQL Server") S3method(get_schema,"NULL") S3method(get_schema,Id) +S3method(get_schema,JDBCConnection) S3method(get_schema,PqConnection) S3method(get_schema,SQLiteConnection) S3method(get_schema,duckdb_connection) diff --git a/R/get_schema.R b/R/get_schema.R index 7605166c..191a9543 100644 --- a/R/get_schema.R +++ b/R/get_schema.R @@ -102,6 +102,11 @@ get_schema.duckdb_connection <- function(obj, ...) { return("main") } +#' @export +get_schema.JDBCConnection <- function(obj, ...) { + return(DBI::dbGetQuery(obj, "SELECT user FROM dual")$USER) +} + #' @export get_schema.NULL <- function(obj, ...) { return(NULL) From 10a38e1c31b9e792e31bb3d3f6595fef6dbc3f77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:49:03 +0200 Subject: [PATCH 011/129] feat(get_tables): Add Oracle implementation --- NAMESPACE | 1 + R/get_tables.R | 41 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index fe1b7c78..765ef51a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ S3method(get_schema,duckdb_connection) S3method(get_schema,tbl_dbi) S3method(get_tables,"Microsoft SQL Server") S3method(get_tables,DBIConnection) +S3method(get_tables,JDBCConnection) S3method(get_tables,OdbcConnection) S3method(get_tables,PqConnection) S3method(get_tables,SQLiteConnection) diff --git a/R/get_tables.R b/R/get_tables.R index f03d21d4..90a0bd12 100644 --- a/R/get_tables.R +++ b/R/get_tables.R @@ -170,6 +170,47 @@ get_tables.duckdb_connection <- function(conn, pattern = NULL, show_temporary = } +#' @importFrom rlang .data +#' @export +get_tables.JDBCConnection <- function(conn, pattern = NULL, show_temporary = TRUE) { + query <- paste( + "SELECT", + "owner AS \"schema\",", + "table_name AS \"table\"", + "FROM all_tables", + "WHERE owner NOT IN ('SYS', 'SYSTEM', 'SYSAUX', 'CTXSYS', 'MDSYS', 'OLAPSYS',", + "'ORDDATA', 'ORDSYS', 'OUTLN', 'WMSYS', 'XDB', 'APEX_PUBLIC_USER',", + "'DBSNMP', 'DIP', 'GSMADMIN_INTERNAL', 'ORACLE_OCM', 'ORDS_METADATA',", + "'ORDS_PUBLIC_USER', 'SPATIAL_CSW_DEBUG_USR', 'SPATIAL_WFS_DEBUG_USR',", + "'APPQOSSYS', 'DBSFWUSER', 'LBACSYS',", + "'GSMCATUSER', 'MDDATA', 'SYSBACKUP', 'SYSDG', 'SYSKM', 'SYSMAN')", + "UNION ALL", + "SELECT", + "owner AS \"schema\",", + "view_name AS \"table\"", + "FROM all_views", + "WHERE owner NOT IN ('SYS', 'SYSTEM', 'SYSAUX', 'CTXSYS', 'MDSYS', 'OLAPSYS',", + "'ORDDATA', 'ORDSYS', 'OUTLN', 'WMSYS', 'XDB', 'APEX_PUBLIC_USER',", + "'DBSNMP', 'DIP', 'GSMADMIN_INTERNAL', 'ORACLE_OCM', 'ORDS_METADATA',", + "'ORDS_PUBLIC_USER', 'SPATIAL_CSW_DEBUG_USR', 'SPATIAL_WFS_DEBUG_USR',", + "'APPQOSSYS', 'DBSFWUSER', 'LBACSYS',", + "'GSMCATUSER', 'MDDATA', 'SYSBACKUP', 'SYSDG', 'SYSKM', 'SYSMAN')", + "ORDER BY \"schema\", \"table\"" + ) + + tables <- DBI::dbGetQuery(conn, query) + + if (!is.null(pattern)) { + tables <- tables %>% + dplyr::mutate(db_table_str = paste(.data$schema, .data$table, sep = ".")) %>% + dplyr::filter(grepl(pattern, .data$db_table_str)) %>% + dplyr::select(!"db_table_str") + } + + return(tables) +} + + #' @export get_tables.OdbcConnection <- function(conn, pattern = NULL, show_temporary = TRUE) { query <- paste("SELECT", From 3173e395d5f2d86804518ae06accb5a86ff8c271 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:50:43 +0200 Subject: [PATCH 012/129] feat(oracle): Add method for dbGetRowsAffected --- NAMESPACE | 3 +++ R/backend_oracle.R | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 R/backend_oracle.R diff --git a/NAMESPACE b/NAMESPACE index 765ef51a..9bb07f62 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,10 +85,13 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) +exportMethods(dbGetRowsAffected) import(parallelly) importClassesFrom(DBI,DBIConnection) +importFrom(DBI,dbGetRowsAffected) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) +importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/R/backend_oracle.R b/R/backend_oracle.R new file mode 100644 index 00000000..447f1235 --- /dev/null +++ b/R/backend_oracle.R @@ -0,0 +1,20 @@ +# dbplyr needs additional implementation for Oracle to work. + +#' @importFrom DBI dbGetRowsAffected +NULL + +#' @importFrom rJava .jcall +#' @importFrom methods setMethod +#' @exportMethod dbGetRowsAffected +#' @noRd +setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { + if (!is.null(res@stat)) { + tryCatch({ + cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") + return(if (cnt < 0) 0L else as.integer(cnt)) + }, error = function(e) { + return(NA_integer_) + }) + } + return(NA_integer_) +}) From 7fc8cdb1beb11f1141c765b68b4ba0756b6f1863 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:52:09 +0200 Subject: [PATCH 013/129] feat(oracle): Manually quote identifiers in `dbWriteTable` --- NAMESPACE | 2 ++ R/backend_oracle.R | 20 ++++++++++++++++++++ 2 files changed, 22 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 9bb07f62..706b20d2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,9 +86,11 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbGetRowsAffected) +exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importFrom(DBI,dbGetRowsAffected) +importFrom(DBI,dbWriteTable) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 447f1235..1b2c2a9a 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -18,3 +18,23 @@ setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { } return(NA_integer_) }) + +#' @importFrom DBI dbWriteTable +NULL + +#' @importFrom methods setMethod +#' @exportMethod dbWriteTable +#' @noRd +setMethod("dbWriteTable", signature("JDBCConnection", "SQL", "data.frame"), + function(conn, name, value, ...) { + + method <- getMethod(dbWriteTable, signature(conn = "JDBCConnection", name = "ANY", value = "ANY")) + + + # Manually quote column names + names(value) <- as.character(DBI::dbQuoteIdentifier(conn, names(value))) + + method@.Data(conn, name, value, ...) + + } +) From 628acd109b363192692337be8389ec0db65f77d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 11:57:09 +0200 Subject: [PATCH 014/129] feat(oracle): Add method for dbQuoteIdentifiers --- NAMESPACE | 2 ++ R/backend_oracle.R | 21 +++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 706b20d2..84ea8993 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,10 +86,12 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbGetRowsAffected) +exportMethods(dbQuoteIdentifier) exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importFrom(DBI,dbGetRowsAffected) +importFrom(DBI,dbQuoteIdentifier) importFrom(DBI,dbWriteTable) importFrom(R6,R6Class) importFrom(magrittr,"%>%") diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1b2c2a9a..f03744b1 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -19,6 +19,27 @@ setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { return(NA_integer_) }) + +#' @importFrom DBI dbQuoteIdentifier +NULL + +#' @exportMethod dbQuoteIdentifier +#' @noRd +setMethod("dbQuoteIdentifier", signature("JDBCConnection", "character"), + function(conn, x, ...) { + x <- enc2utf8(x) + + reserved_words <- c("DATE", "NUMBER", "VARCHAR") + + needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + + x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + + return(DBI::SQL(x, names = names(x))) + } +) + + #' @importFrom DBI dbWriteTable NULL From 449e52bed3c1f3375092bc8d8b4299e82daa3054 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 16 Oct 2025 10:02:12 +0000 Subject: [PATCH 015/129] docs: Re-build roxygen documentation --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 84ea8993..ce56caca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -96,6 +96,7 @@ importFrom(DBI,dbWriteTable) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) +importFrom(methods,setMethod) importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) From a1a0d48fdeb48a46b67b0c8696512b3f5d8ab596 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 12:22:09 +0200 Subject: [PATCH 016/129] chore(all-workflows): Disable most workflows while implementing --- .github/workflows/all-workflows.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/all-workflows.yaml b/.github/workflows/all-workflows.yaml index c34e5b77..d6feafaa 100644 --- a/.github/workflows/all-workflows.yaml +++ b/.github/workflows/all-workflows.yaml @@ -34,6 +34,8 @@ jobs: backend_exclude: oracle # code-coverage creates data bases for the tests. Here you can specify the schemas you need for the workflow + backend_exclude: sqlite,duckdb,postgres,mssql schemas: test,test.one check_postgres_logs: false + skip: R-CMD-check,styler,render-readme,pkgdown,update-lockfile,update-cache secrets: inherit From 1c77b82821430dfeba0a317d022f0e9012fdc054 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 12:31:29 +0200 Subject: [PATCH 017/129] feat(oracle): Remove ambiguity for `dbExistsTable` dispatch --- NAMESPACE | 2 ++ R/backend_oracle.R | 10 ++++++++++ 2 files changed, 12 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ce56caca..bd8fdc54 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,11 +85,13 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) +exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) +importFrom(DBI,dbExistsTable) importFrom(DBI,dbGetRowsAffected) importFrom(DBI,dbQuoteIdentifier) importFrom(DBI,dbWriteTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index f03744b1..02bf7e3f 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -1,5 +1,15 @@ # dbplyr needs additional implementation for Oracle to work. +#' @importFrom DBI dbExistsTable +NULL + +#' @exportMethod dbExistsTable +setMethod("dbExistsTable", signature("JDBCConnection", "Id"), + function(conn, name, ...) { + methods::callNextMethod() # Remove ambiguity + } +) + #' @importFrom DBI dbGetRowsAffected NULL From 366962d9911848b1738d1af913963c77d2077702 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 12:33:20 +0200 Subject: [PATCH 018/129] feat(oracle): Remove ambiguity for `dbQuoteIdentifier` dispatch --- R/backend_oracle.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 02bf7e3f..51f87382 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -49,6 +49,14 @@ setMethod("dbQuoteIdentifier", signature("JDBCConnection", "character"), } ) +#' @exportMethod dbQuoteIdentifier +#' @noRd +setMethod("dbQuoteIdentifier", signature("JDBCConnection", "SQL"), + function(conn, x, ...) { + return(x) # Remove ambiguity (also assume already quoted) + } +) + #' @importFrom DBI dbWriteTable NULL From 19e590a2b2ac285b90070cb789565266b839619b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 12:34:40 +0200 Subject: [PATCH 019/129] ebug(Oracle): Set analyze = FALSE on all copy_to calls 2 --- tests/testthat/test-db_joins.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index 8fac777d..b011cdd8 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -11,9 +11,9 @@ test_that("*_join() works with character `by` and `na_by`", { number = c(NA, "2", "1", "1")) # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) + x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE) + y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) q <- dplyr::left_join(x, y, na_by = "number") %>% @@ -48,9 +48,9 @@ test_that("*_join() works with character `by` and `na_by`", { n_add = 4) # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) + x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE) + y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) q <- dplyr::full_join(x, y, by = "date", na_by = "region_id") %>% From 83bdb5cd9ef724b842261bdacfd33ff4ee51bc7a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:01:57 +0200 Subject: [PATCH 020/129] debug(oracle): Check if "IS NOT DISTINCT" works --- tests/testthat/test-db_joins.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index b011cdd8..f78c223f 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -15,6 +15,10 @@ test_that("*_join() works with character `by` and `na_by`", { y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + # Check if Oracle supports "IS NOT DISTINCT FROM" + if (inherits(conn, "JDBCConnection")) { + DBI::dbGetQuery(conn, "SELECT 1 FROM DUAL WHERE 1 IS NOT DISTINCT FROM 1;") + } q <- dplyr::left_join(x, y, na_by = "number") %>% dplyr::collect() %>% From ade48595427881aef095f368f05dcbda5c33f3f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:11:36 +0200 Subject: [PATCH 021/129] feat(digest_to_checksum): Add Oracle implementaiton --- NAMESPACE | 1 + R/digest_to_checksum.R | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index bd8fdc54..1b9acf81 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(db_timestamp,duckdb_connection) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) +S3method(digest_to_checksum,tbl_JDBCConnection) S3method(digest_to_checksum,tbl_PqConnection) S3method(digest_to_checksum,tbl_duckdb_connection) S3method(dplyr::anti_join,tbl_sql) diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index d0c32fa5..d875576e 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -51,6 +51,24 @@ digest_to_checksum <- function(.data, col = "checksum", exclude = NULL) { return(.data) } +#' @export +`digest_to_checksum.tbl_JDBCConnection` <- function( + .data, + col = formals(digest_to_checksum)$col, + exclude = formals(digest_to_checksum)$exclude) { + + hash_cols <- dbplyr::ident(setdiff(colnames(.data), c(col, exclude))) + + .data <- dplyr::mutate( + .data, + !!col := !!dplyr::sql( + glue::glue("RAWTOHEX(STANDARD_HASH({paste0(hash_cols, collapse = ' || ')}, 'SHA256'))") + ) + ) + + return(.data) +} + #' @export digest_to_checksum.default <- function( .data, From e14739620d1724553726e0424dd31cc21435cada Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:30:00 +0200 Subject: [PATCH 022/129] feat(get_connection): Cast JDBCConnection to Oracle --- NAMESPACE | 1 + R/connection.R | 15 +++++++++++++++ 2 files changed, 16 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 1b9acf81..8d7dd84c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,6 +86,7 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) +exportClasses(Oracle) exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) diff --git a/R/connection.R b/R/connection.R index 7acd0778..e58474f2 100644 --- a/R/connection.R +++ b/R/connection.R @@ -207,6 +207,12 @@ get_connection.duckdb_driver <- function( return(do.call(DBI::dbConnect, args = args)) } + +#' @export +#' @noRd +methods::setClass("Oracle", contains = "JDBCConnection") + + #' @rdname get_connection #' @param driverClass (`character(1)`)\cr #' The name of the JDBC driver to load. @@ -255,6 +261,15 @@ get_connection.JDBCDriver <- function( call. = FALSE ) + # Cast to superclass + conn <- new( + "Oracle", + jc=conn@jc, + identifier.quote=conn@identifier.quote, + options=conn@options, + auto.commit=conn@auto.commit + ) + return(conn) } From 03e48e3be3a64b72ae4ec07becb6c9125dd1e231 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:44:10 +0200 Subject: [PATCH 023/129] fix(get_connection): Import the JDBCConnection class --- NAMESPACE | 1 + R/connection.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 8d7dd84c..7f2415d2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -93,6 +93,7 @@ exportMethods(dbQuoteIdentifier) exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) +importClassesFrom(RJDBC,JDBCConnection) importFrom(DBI,dbExistsTable) importFrom(DBI,dbGetRowsAffected) importFrom(DBI,dbQuoteIdentifier) diff --git a/R/connection.R b/R/connection.R index e58474f2..cbbead73 100644 --- a/R/connection.R +++ b/R/connection.R @@ -208,6 +208,7 @@ get_connection.duckdb_driver <- function( } +#' @importClassesFrom RJDBC JDBCConnection #' @export #' @noRd methods::setClass("Oracle", contains = "JDBCConnection") From 7370b61ee85ae0fa7f0ac1db80a8d98104eedaaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:53:06 +0200 Subject: [PATCH 024/129] fix(get_connection): Remove unused slots from Oracle class coersion --- R/connection.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/connection.R b/R/connection.R index cbbead73..4fc81b1c 100644 --- a/R/connection.R +++ b/R/connection.R @@ -266,9 +266,7 @@ get_connection.JDBCDriver <- function( conn <- new( "Oracle", jc=conn@jc, - identifier.quote=conn@identifier.quote, - options=conn@options, - auto.commit=conn@auto.commit + identifier.quote=conn@identifier.quote ) return(conn) From d7e1d22208f860600394242493a1bb5b0819cfcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 13:53:29 +0200 Subject: [PATCH 025/129] docs(get_connection): Specify that "JDBCConnection" is experimental --- R/connection.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/connection.R b/R/connection.R index 4fc81b1c..3d63ccdc 100644 --- a/R/connection.R +++ b/R/connection.R @@ -256,7 +256,11 @@ get_connection.JDBCDriver <- function( # Assume connection is to an Oracle data base rlang::warn( - message = paste0("Connections of class '", class(conn), "' are assumed to be connections to Oracle databases"), + message = paste0( + "Connections of class '", + class(conn), + "' are experimental and are assumed to be connections to Oracle databases" + ), .frequency = "regularly", .frequency_id = "JDBC means Oracle warning", call. = FALSE From 55824e238d63b66bb7b3600af09a999935164481 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 14:11:29 +0200 Subject: [PATCH 026/129] f feat(get_connection): Cast JDBCConnection to Oracle --- NAMESPACE | 8 ++++---- R/backend_oracle.R | 7 +++++++ R/connection.R | 6 ------ R/digest_to_checksum.R | 2 +- R/getTableSignature.R | 2 +- R/get_schema.R | 2 +- R/get_tables.R | 2 +- R/schema_exists.R | 2 +- tests/testthat/test-db_joins.R | 2 +- 9 files changed, 17 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7f2415d2..f1e6c420 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,7 +11,7 @@ S3method(db_timestamp,duckdb_connection) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) -S3method(digest_to_checksum,tbl_JDBCConnection) +S3method(digest_to_checksum,tbl_Oracle) S3method(digest_to_checksum,tbl_PqConnection) S3method(digest_to_checksum,tbl_duckdb_connection) S3method(dplyr::anti_join,tbl_sql) @@ -36,15 +36,15 @@ S3method(get_connection,duckdb_driver) S3method(get_schema,"Microsoft SQL Server") S3method(get_schema,"NULL") S3method(get_schema,Id) -S3method(get_schema,JDBCConnection) +S3method(get_schema,Oracle) S3method(get_schema,PqConnection) S3method(get_schema,SQLiteConnection) S3method(get_schema,duckdb_connection) S3method(get_schema,tbl_dbi) S3method(get_tables,"Microsoft SQL Server") S3method(get_tables,DBIConnection) -S3method(get_tables,JDBCConnection) S3method(get_tables,OdbcConnection) +S3method(get_tables,Oracle) S3method(get_tables,PqConnection) S3method(get_tables,SQLiteConnection) S3method(get_tables,duckdb_connection) @@ -54,7 +54,7 @@ S3method(id,data.frame) S3method(id,tbl_dbi) S3method(interlace,tbl_sql) S3method(schema_exists,DBIConnection) -S3method(schema_exists,JDBCConnection) +S3method(schema_exists,Oracle) S3method(schema_exists,SQLiteConnection) S3method(schema_exists,default) S3method(table_exists,DBIConnection) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 51f87382..4bfaa91d 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -1,5 +1,12 @@ # dbplyr needs additional implementation for Oracle to work. +#' @importClassesFrom RJDBC JDBCConnection +#' @export +#' @noRd +methods::setClass("Oracle", contains = "JDBCConnection") + + + #' @importFrom DBI dbExistsTable NULL diff --git a/R/connection.R b/R/connection.R index 3d63ccdc..ec4b45d9 100644 --- a/R/connection.R +++ b/R/connection.R @@ -208,12 +208,6 @@ get_connection.duckdb_driver <- function( } -#' @importClassesFrom RJDBC JDBCConnection -#' @export -#' @noRd -methods::setClass("Oracle", contains = "JDBCConnection") - - #' @rdname get_connection #' @param driverClass (`character(1)`)\cr #' The name of the JDBC driver to load. diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index d875576e..cf6ab93f 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -52,7 +52,7 @@ digest_to_checksum <- function(.data, col = "checksum", exclude = NULL) { } #' @export -`digest_to_checksum.tbl_JDBCConnection` <- function( +`digest_to_checksum.tbl_Oracle` <- function( .data, col = formals(digest_to_checksum)$col, exclude = formals(digest_to_checksum)$exclude) { diff --git a/R/getTableSignature.R b/R/getTableSignature.R index c87ccf76..27f2aefb 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -40,7 +40,7 @@ methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" ), - "JDBCConnection" = c( + "Oracle" = c( checksum = "CHAR(32)", from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" diff --git a/R/get_schema.R b/R/get_schema.R index 191a9543..1ef7860a 100644 --- a/R/get_schema.R +++ b/R/get_schema.R @@ -103,7 +103,7 @@ get_schema.duckdb_connection <- function(obj, ...) { } #' @export -get_schema.JDBCConnection <- function(obj, ...) { +get_schema.Oracle <- function(obj, ...) { return(DBI::dbGetQuery(obj, "SELECT user FROM dual")$USER) } diff --git a/R/get_tables.R b/R/get_tables.R index 90a0bd12..27974960 100644 --- a/R/get_tables.R +++ b/R/get_tables.R @@ -172,7 +172,7 @@ get_tables.duckdb_connection <- function(conn, pattern = NULL, show_temporary = #' @importFrom rlang .data #' @export -get_tables.JDBCConnection <- function(conn, pattern = NULL, show_temporary = TRUE) { +get_tables.Oracle <- function(conn, pattern = NULL, show_temporary = TRUE) { query <- paste( "SELECT", "owner AS \"schema\",", diff --git a/R/schema_exists.R b/R/schema_exists.R index be7810ec..e2d9e775 100644 --- a/R/schema_exists.R +++ b/R/schema_exists.R @@ -37,7 +37,7 @@ schema_exists.DBIConnection <- function(conn, schema) { } #' @export -schema_exists.JDBCConnection <- function(conn, schema) { +schema_exists.Oracle <- function(conn, schema) { query <- paste0("SELECT * FROM ALL_USERS WHERE USERNAME = '", schema, "'") result <- DBI::dbGetQuery(conn, query) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index f78c223f..3ab6033a 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -16,7 +16,7 @@ test_that("*_join() works with character `by` and `na_by`", { y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) # Check if Oracle supports "IS NOT DISTINCT FROM" - if (inherits(conn, "JDBCConnection")) { + if (inherits(conn, "Oracle")) { DBI::dbGetQuery(conn, "SELECT 1 FROM DUAL WHERE 1 IS NOT DISTINCT FROM 1;") } From 766c422d649b45fa89d82ef9fb7e4d6809ed274b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 14:33:37 +0200 Subject: [PATCH 027/129] feat(join_na_sql): Add Oracle implementation --- R/db_joins.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/db_joins.R b/R/db_joins.R index 9d0e75d6..82c9c6ce 100644 --- a/R/db_joins.R +++ b/R/db_joins.R @@ -68,6 +68,11 @@ join_na_sql.tbl_dbi <- function(x, by, na_by) { return(join_na_not_null(by = by, na_by = na_by)) } +#' @noRd +`join_na_sql.tbl_Oracle` <- function(x, by, na_by) { + return(join_na_not_null(by = by, na_by = na_by)) +} + #' Get colnames to select #' #' @inheritParams left_join From 03e01e9503a178fb871f3337520a5f6bfa915214 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 14:39:08 +0200 Subject: [PATCH 028/129] debug test-db_joins --- tests/testthat/test-db_joins.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index 3ab6033a..484ca565 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -117,6 +117,7 @@ test_that("*_join() works with `dplyr::join_by()`", { y <- get_table(conn, "__mtcars") %>% dplyr::select(name, drat, wt, qsec) + print(dplyr::show_query(y)) # Test the implemented joins q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() From 55255caf514555d31cc4a32066b6b33c8dd3f939 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 14:42:41 +0200 Subject: [PATCH 029/129] debug defer_db_cleanup --- tests/testthat/test-get_tables.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-get_tables.R b/tests/testthat/test-get_tables.R index 2b09c446..be9656e7 100644 --- a/tests/testthat/test-get_tables.R +++ b/tests/testthat/test-get_tables.R @@ -101,6 +101,13 @@ test_that("get_tables() works with temporary tables", { checkmate::expect_subset(c(table_1, table_2, tmp_name), db_table_names) connection_clean_up(conn) + + print("DBI::dbIsValid(conn)") + print(DBI::dbIsValid(conn)) + print("DBI::dbExistsTable(conn, tmp_id)") + print(DBI::dbExistsTable(conn, tmp_id)) + print("DBI::dbRemoveTable(conn, tmp_id)") + print(DBI::dbRemoveTable(conn, tmp_id)) } }) From d71b7458f721a6b10b3a2c3ab6050e39a7e6928e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 14:46:02 +0200 Subject: [PATCH 030/129] debug getTableSignature --- tests/testthat/test-getTableSignature.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-getTableSignature.R b/tests/testthat/test-getTableSignature.R index f5859a07..d55c633d 100644 --- a/tests/testthat/test-getTableSignature.R +++ b/tests/testthat/test-getTableSignature.R @@ -329,7 +329,8 @@ for (conn in c(list(NULL), get_test_conns())) { test_that(glue::glue("getTableSignature() generates consistent data types ({class(conn)})"), { # This tests that the data types are consistent when copying to a remote table with getTableSignature(). # We first copy the data to a remote table, then copy that table to another remote table on the same connection. - # The + print("getTableSignature(data_random, conn)") + print(getTableSignature(data_random, conn)) remote_data_1 <- dplyr::copy_to( conn, data_random, From 1b2a0679a38af7f4de6bd138c30f21921149a71f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:08:21 +0200 Subject: [PATCH 031/129] Revert "debug(oracle): Check if "IS NOT DISTINCT" works" This reverts commit 646ea1aae21cc0d0c30eea5c483e05c5966f6d9b. --- tests/testthat/test-db_joins.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index 484ca565..824a80a2 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -15,10 +15,6 @@ test_that("*_join() works with character `by` and `na_by`", { y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - # Check if Oracle supports "IS NOT DISTINCT FROM" - if (inherits(conn, "Oracle")) { - DBI::dbGetQuery(conn, "SELECT 1 FROM DUAL WHERE 1 IS NOT DISTINCT FROM 1;") - } q <- dplyr::left_join(x, y, na_by = "number") %>% dplyr::collect() %>% From 43d7f1216f4d43943543a2c7857fde3acc8738b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:11:36 +0200 Subject: [PATCH 032/129] debug(Oracle): Set analyze = FALSE on all copy_to calls 3 --- tests/testthat/test-update_snapshot.R | 30 +++++++++++++-------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/tests/testthat/test-update_snapshot.R b/tests/testthat/test-update_snapshot.R index c0824805..0e5cff69 100644 --- a/tests/testthat/test-update_snapshot.R +++ b/tests/testthat/test-update_snapshot.R @@ -8,7 +8,7 @@ test_that("update_snapshot() can handle first snapshot", { # Use unmodified mtcars as the initial snapshot .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name()) + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) # Configure the logger for this update db_table <- "test.SCDB_tmp1" @@ -109,7 +109,7 @@ test_that("update_snapshot() can add a new snapshot", { # Modify snapshot and run update step .data <- mtcars %>% dplyr::mutate(hp = dplyr::if_else(hp > 130, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name()) + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) # Configure the logger for this update db_table <- "test.SCDB_tmp1" @@ -179,7 +179,7 @@ test_that("update_snapshot() can update a snapshot on an existing date", { # We now attempt to do another update on the same date .data <- mtcars %>% dplyr::mutate(hp = dplyr::if_else(hp > 100, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name()) + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) # Configure the logger for this update db_table <- "test.SCDB_tmp1" @@ -248,7 +248,7 @@ test_that("update_snapshot() can insert a snapshot between existing dates", { # We now attempt to an update between these two updates .data <- mtcars %>% dplyr::mutate(hp = dplyr::if_else(hp > 150, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name()) + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) # This should fail if we do not specify "enforce_chronological_order = FALSE" expect_error( @@ -309,9 +309,9 @@ test_that("update_snapshot() works (holistic test 1)", { t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) # Copy t0, t1, and t2 to conn - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE) + t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) logger <- LoggerNull$new() update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01 08:00:00", logger = logger) @@ -378,9 +378,9 @@ test_that("update_snapshot() works (holistic test 2)", { t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) # Copy t0, t1, and t2 to conn (and suppress check_from message) - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE) + t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) # Check non-chronological insertion @@ -431,7 +431,7 @@ test_that("update_snapshot() handles 'NULL' updates", { # Use mtcars as the test data set .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name()) + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) defer_db_cleanup(.data) # This is a simple update where 23 rows are replaced with 23 new ones on the given date @@ -489,7 +489,7 @@ test_that("update_snapshot() works with Id objects", { expect_no_error( mtcars %>% dplyr::mutate(disp = sample(mtcars$disp, nrow(mtcars))) %>% - dplyr::copy_to(dest = conn, df = ., name = unique_table_name()) %>% + dplyr::copy_to(dest = conn, df = ., name = unique_table_name(), analyze = FALSE) %>% update_snapshot( conn = conn, db_table = target_table, @@ -518,7 +518,7 @@ test_that("update_snapshot() checks table formats", { ) # Test columns not matching - broken_table <- dplyr::copy_to(conn, dplyr::select(mtcars, !"mpg"), name = "mtcars_broken", overwrite = TRUE) + broken_table <- dplyr::copy_to(conn, dplyr::select(mtcars, !"mpg"), name = "mtcars_broken", overwrite = TRUE, analyze = FALSE) expect_error( update_snapshot( @@ -563,7 +563,7 @@ test_that("update_snapshot() works with across connection", { dplyr::mutate(name = rownames(mtcars)) # Copy table to the source - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name()) + .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) # For each conn, we test if update_snapshot preserves data types for (target_conn in get_test_conns()) { @@ -612,7 +612,7 @@ test_that("update_snapshot() works with across connection", { # For each conn, we test if update_snapshot preserves data types for (source_conn in get_test_conns()) { - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name()) + .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) target_table <- id("mtcars_modified", target_conn) if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) From b7148b5d57101ec665abd527ab752baa961c3953 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:19:01 +0200 Subject: [PATCH 033/129] fix(getTableSignature): Use `purrr::map` to get data types --- R/getTableSignature.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/getTableSignature.R b/R/getTableSignature.R index 27f2aefb..be646958 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -16,7 +16,7 @@ methods::setGeneric("getTableSignature", methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { # Retrieve the translated data types - signature <- as.list(DBI::dbDataType(conn, dplyr::collect(utils::head(.data, 0)))) + signature <- purrr::map(utils::head(.data, 0), ~ DBI::dbDataType(conn, .)) # Define the column types to be updated based on backend class backend_coltypes <- list( From 0ec142ab5509a4cde39e7e59b2197b8c14e1b605 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:19:54 +0200 Subject: [PATCH 034/129] Revert "debug getTableSignature" This reverts commit ec7bcf6949ecaf4c893f9d5d3b0e0f6c644c9d1a. --- tests/testthat/test-getTableSignature.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-getTableSignature.R b/tests/testthat/test-getTableSignature.R index d55c633d..f5859a07 100644 --- a/tests/testthat/test-getTableSignature.R +++ b/tests/testthat/test-getTableSignature.R @@ -329,8 +329,7 @@ for (conn in c(list(NULL), get_test_conns())) { test_that(glue::glue("getTableSignature() generates consistent data types ({class(conn)})"), { # This tests that the data types are consistent when copying to a remote table with getTableSignature(). # We first copy the data to a remote table, then copy that table to another remote table on the same connection. - print("getTableSignature(data_random, conn)") - print(getTableSignature(data_random, conn)) + # The remote_data_1 <- dplyr::copy_to( conn, data_random, From 66a7cba88fca1042222f2b5e147753dc3b624714 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:22:45 +0200 Subject: [PATCH 035/129] debug test-db_joins --- tests/testthat/test-db_joins.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index 824a80a2..ce3d14a7 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -114,6 +114,7 @@ test_that("*_join() works with `dplyr::join_by()`", { dplyr::select(name, drat, wt, qsec) print(dplyr::show_query(y)) + print(dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))) # Test the implemented joins q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() From 5cbb6edbf416475815ed7e0fb26e11961dbade5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 15:26:44 +0200 Subject: [PATCH 036/129] feat(oracle): Remove ambiguity for `dbQuoteIdentifier` dispatch --- R/backend_oracle.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 4bfaa91d..56a45533 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -64,6 +64,15 @@ setMethod("dbQuoteIdentifier", signature("JDBCConnection", "SQL"), } ) +#' @exportMethod dbQuoteIdentifier +#' @noRd +setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), + function(conn, x, ...) { + + # For `Id`, run on each non-NA element + return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) + } +) #' @importFrom DBI dbWriteTable NULL From be8d757737e56ca0555217f170e39b122135c20a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 19:20:08 +0200 Subject: [PATCH 037/129] fix(create_index): Quote identifiers --- R/create_index.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/create_index.R b/R/create_index.R index 10b740c1..5195170b 100644 --- a/R/create_index.R +++ b/R/create_index.R @@ -72,7 +72,8 @@ create_index.DBIConnection <- function(conn, db_table, columns) { stringr::str_replace_all(stringr::fixed("."), "_") query <- glue::glue( - "CREATE UNIQUE INDEX {index} ON {as.character(db_table, explicit = TRUE)} ({toString(columns)})" + "CREATE UNIQUE INDEX {index} ON {as.character(db_table, explicit = TRUE)} ", + "({toString(DBI::dbQuoteIdentifier(conn, columns))})" ) DBI::dbExecute(conn, query) From 5d86a244fc666326a52d64169987e199c5b73e7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 20:05:41 +0200 Subject: [PATCH 038/129] debug dbCreateTable - Insert method to catch calls --- NAMESPACE | 2 ++ R/backend_oracle.R | 17 +++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index f1e6c420..0ede3b84 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,6 +87,7 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportClasses(Oracle) +exportMethods(dbCreateTable) exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) @@ -94,6 +95,7 @@ exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) +importFrom(DBI,dbCreateTable) importFrom(DBI,dbExistsTable) importFrom(DBI,dbGetRowsAffected) importFrom(DBI,dbQuoteIdentifier) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 56a45533..84b541e4 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -74,6 +74,23 @@ setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), } ) +#' @importFrom DBI dbCreateTable +NULL + +#' @exportMethod dbCreateTable +#' @noRd +methods::setMethod("dbCreateTable", methods::signature("Oracle", "Id"), + function(conn, name, fields, ..., row.names = NULL, temporary = FALSE) { + stopifnot(is.null(row.names)) + stopifnot(is.logical(temporary), length(temporary) == 1L) + query <- DBI::sqlCreateTable(con = conn, table = name, fields = fields, + row.names = row.names, temporary = temporary, ...) + print(query) + DBI::dbExecute(conn, query) + invisible(TRUE) + } +) + #' @importFrom DBI dbWriteTable NULL From 3a8108cefa25d533f33e66f03c1b9ed3c33dd502 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 20:17:56 +0200 Subject: [PATCH 039/129] debug db_joins --- tests/testthat/test-db_joins.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R index ce3d14a7..263c74e2 100644 --- a/tests/testthat/test-db_joins.R +++ b/tests/testthat/test-db_joins.R @@ -113,9 +113,30 @@ test_that("*_join() works with `dplyr::join_by()`", { y <- get_table(conn, "__mtcars") %>% dplyr::select(name, drat, wt, qsec) + print("dplyr::show_query(y)") print(dplyr::show_query(y)) + + print("dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))") print(dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))) + print("dplyr::tbl_vars(y)") + print(dplyr::tbl_vars(y)) + + print("make_join_aliases") + print(dbplyr:::make_join_aliases(x$src$con, NULL, NULL, NULL, rlang::caller_env())) + + print("join_inline_select") + by <- dplyr::join_by(x$name == y$name) + print(dbplyr:::join_inline_select(y$lazy_query, by$y, by$on)) + + print("y_lq") + print(inline_result$lq) + + print("table_names_y") + print(dbplyr:::make_table_names(join_alias$y, y_lq)) + + + # Test the implemented joins q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) From 0212807b0e5fb6a4e2e524518aac3bd48c0cc5d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 22:31:37 +0200 Subject: [PATCH 040/129] debug dbCreateTable --- R/backend_oracle.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 84b541e4..0651c622 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -86,6 +86,13 @@ methods::setMethod("dbCreateTable", methods::signature("Oracle", "Id"), query <- DBI::sqlCreateTable(con = conn, table = name, fields = fields, row.names = row.names, temporary = temporary, ...) print(query) + + print("dbCreateTable - class(conn)") + print(class(conn)) + + print("selectMethod(DBI::sqlCreateTable, signature('Oracle'))") + print(selectMethod(DBI::sqlCreateTable, signature("Oracle"))) + DBI::dbExecute(conn, query) invisible(TRUE) } From 13d8a2739f575b232c4e702e0a6377cb92d9d868 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 22:40:44 +0200 Subject: [PATCH 041/129] fix(digest_to_checksum): Use `DBI::dbQuoteIdentifier` to over `dbplyr::ident` for Oracle --- R/digest_to_checksum.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index cf6ab93f..f25ebaf7 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -57,7 +57,7 @@ digest_to_checksum <- function(.data, col = "checksum", exclude = NULL) { col = formals(digest_to_checksum)$col, exclude = formals(digest_to_checksum)$exclude) { - hash_cols <- dbplyr::ident(setdiff(colnames(.data), c(col, exclude))) + hash_cols <- DBI::dbQuoteIdentifier(.data$src$con, setdiff(colnames(.data), c(col, exclude))) .data <- dplyr::mutate( .data, From 8fa2a38215423c3b35c0b387d73a44fa105881ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 22:44:40 +0200 Subject: [PATCH 042/129] fix(create_table): Ensure `odbc` method for `DBI::sqlCreateTable` is loaded --- NAMESPACE | 1 + R/create_table.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 0ede3b84..74998538 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -107,3 +107,4 @@ importFrom(methods,setMethod) importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) +importMethodsFrom(odbc,sqlCreateTable) diff --git a/R/create_table.R b/R/create_table.R index b825a207..01d5eb47 100644 --- a/R/create_table.R +++ b/R/create_table.R @@ -13,6 +13,7 @@ #' create_table(mtcars, conn = conn, db_table = "mtcars") #' #' close_connection(conn) +#' @importMethodsFrom odbc sqlCreateTable #' @export create_table <- function(.data, conn = NULL, db_table, ...) { # nolint: function_argument_linter From d5f536540f8dba4c0aa9d869463b1e673601f22b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 22:46:04 +0200 Subject: [PATCH 043/129] WIP --- NAMESPACE | 3 +-- R/backend_oracle.R | 36 ++++++++++++------------------------ 2 files changed, 13 insertions(+), 26 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 74998538..ad1ff717 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method(db_timestamp,"NULL") S3method(db_timestamp,SQLiteConnection) S3method(db_timestamp,default) S3method(db_timestamp,duckdb_connection) +S3method(dbplyr::sql_table_analyze,Oracle) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) @@ -87,7 +88,6 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportClasses(Oracle) -exportMethods(dbCreateTable) exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) @@ -95,7 +95,6 @@ exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) -importFrom(DBI,dbCreateTable) importFrom(DBI,dbExistsTable) importFrom(DBI,dbGetRowsAffected) importFrom(DBI,dbQuoteIdentifier) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 0651c622..3027d794 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -6,6 +6,17 @@ methods::setClass("Oracle", contains = "JDBCConnection") +# The ANALYZE TABLE command generated by dplyr does not work for Oracle, so we manually implement. +#' @exportS3Method dbplyr::sql_table_analyze +#' @noRd +sql_table_analyze.Oracle <- function(con, table, ...) { + dbplyr::build_sql( + "ANALYZE TABLE ", + dbplyr::as.sql(id(table, conn = con), con = con), + " COMPUTE STATISTICS", + con = con + ) +} #' @importFrom DBI dbExistsTable NULL @@ -74,34 +85,11 @@ setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), } ) -#' @importFrom DBI dbCreateTable -NULL - -#' @exportMethod dbCreateTable -#' @noRd -methods::setMethod("dbCreateTable", methods::signature("Oracle", "Id"), - function(conn, name, fields, ..., row.names = NULL, temporary = FALSE) { - stopifnot(is.null(row.names)) - stopifnot(is.logical(temporary), length(temporary) == 1L) - query <- DBI::sqlCreateTable(con = conn, table = name, fields = fields, - row.names = row.names, temporary = temporary, ...) - print(query) - - print("dbCreateTable - class(conn)") - print(class(conn)) - - print("selectMethod(DBI::sqlCreateTable, signature('Oracle'))") - print(selectMethod(DBI::sqlCreateTable, signature("Oracle"))) - - DBI::dbExecute(conn, query) - invisible(TRUE) - } -) - #' @importFrom DBI dbWriteTable NULL #' @importFrom methods setMethod +#' @importClassesFrom RJDBC JDBCConnection #' @exportMethod dbWriteTable #' @noRd setMethod("dbWriteTable", signature("JDBCConnection", "SQL", "data.frame"), From 4bcd9a7e8630c2a8277ed4c50ef2194577aace93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 16 Oct 2025 23:03:21 +0200 Subject: [PATCH 044/129] fix(getTableSignature): Ensure `odbc` and `RJDBC` methods for `DBI::dbDataType` are loaded --- NAMESPACE | 2 ++ R/getTableSignature.R | 2 ++ 2 files changed, 4 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ad1ff717..d13cb861 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -106,4 +106,6 @@ importFrom(methods,setMethod) importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) +importMethodsFrom(RJDBC,dbDataType) +importMethodsFrom(odbc,dbDataType) importMethodsFrom(odbc,sqlCreateTable) diff --git a/R/getTableSignature.R b/R/getTableSignature.R index be646958..d9f9c33a 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -12,6 +12,8 @@ methods::setGeneric("getTableSignature", function(.data, conn = NULL) standardGeneric("getTableSignature"), signature = "conn") +#' @importMethodsFrom RJDBC dbDataType +#' @importMethodsFrom odbc dbDataType #' @importClassesFrom DBI DBIConnection methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { From de2eed86b2e681f2146dee7d81c76c1c6681cb81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 08:46:48 +0200 Subject: [PATCH 045/129] fix(dbQuoteIdentifier): Change signature --- R/backend_oracle.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 3027d794..c435eec2 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -77,7 +77,7 @@ setMethod("dbQuoteIdentifier", signature("JDBCConnection", "SQL"), #' @exportMethod dbQuoteIdentifier #' @noRd -setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), +setMethod("dbQuoteIdentifier", signature("JDBCConnection", "Id"), function(conn, x, ...) { # For `Id`, run on each non-NA element From fe9f8e81286ffaeee60df382bcbd867a89841a51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 08:54:43 +0200 Subject: [PATCH 046/129] debug: Move rJava and RJDBC to Imports --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e2fd816b..b0e4b315 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,6 +43,8 @@ Imports: openssl, parallelly, purrr, + rJava, + RJDBC, rlang, R6, stringr, @@ -64,8 +66,6 @@ Suggests: odbc, pak, pkgdown, - rJava, - RJDBC, rmarkdown, roxygen2, RPostgres, From e0c81afc9a4f2d099271dd614634ec6da08bb808 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 09:37:15 +0200 Subject: [PATCH 047/129] debug get_table --- tests/testthat/test-get_table.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-get_table.R b/tests/testthat/test-get_table.R index c2bef1b5..05f8fab4 100644 --- a/tests/testthat/test-get_table.R +++ b/tests/testthat/test-get_table.R @@ -14,6 +14,11 @@ test_that("get_table() returns list of tables if no table is requested", { test_that("get_table() works when tables/view exist", { for (conn in get_test_conns()) { + print('get_table(conn, "__mtcars")') + print(get_table(conn, "__mtcars")) + print('dplyr::collect(get_table(conn, "__mtcars"))') + print(dplyr::collect(get_table(conn, "__mtcars"))) + mtcars_t <- tibble::tibble(mtcars %>% dplyr::mutate(name = rownames(mtcars))) # Lets try different ways to read __mtcars (added during setup) From 0129a3f51ce4e8b52f90fe0efcd99a6556c85c86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 09:53:17 +0200 Subject: [PATCH 048/129] debug oracle - import more methods --- NAMESPACE | 9 +++++---- R/backend_oracle.R | 21 +++++++++------------ 2 files changed, 14 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d13cb861..e4b23669 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -95,10 +95,6 @@ exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) -importFrom(DBI,dbExistsTable) -importFrom(DBI,dbGetRowsAffected) -importFrom(DBI,dbQuoteIdentifier) -importFrom(DBI,dbWriteTable) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) @@ -106,6 +102,11 @@ importFrom(methods,setMethod) importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) +importMethodsFrom(DBI,dbExistsTable) +importMethodsFrom(DBI,dbGetRowsAffected) +importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(RJDBC,dbDataType) +importMethodsFrom(RJDBC,dbExistsTable) +importMethodsFrom(RJDBC,dbWriteTable) importMethodsFrom(odbc,dbDataType) importMethodsFrom(odbc,sqlCreateTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index c435eec2..5bbf15c1 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -1,6 +1,15 @@ # dbplyr needs additional implementation for Oracle to work. +#' @importMethodsFrom DBI dbExistsTable +#' @importMethodsFrom RJDBC dbExistsTable +#' @importMethodsFrom DBI dbGetRowsAffected +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @importMethodsFrom RJDBC dbWriteTable #' @importClassesFrom RJDBC JDBCConnection +NULL + + +# Create Frankenstein class #' @export #' @noRd methods::setClass("Oracle", contains = "JDBCConnection") @@ -18,9 +27,6 @@ sql_table_analyze.Oracle <- function(con, table, ...) { ) } -#' @importFrom DBI dbExistsTable -NULL - #' @exportMethod dbExistsTable setMethod("dbExistsTable", signature("JDBCConnection", "Id"), function(conn, name, ...) { @@ -28,8 +34,6 @@ setMethod("dbExistsTable", signature("JDBCConnection", "Id"), } ) -#' @importFrom DBI dbGetRowsAffected -NULL #' @importFrom rJava .jcall #' @importFrom methods setMethod @@ -47,10 +51,6 @@ setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { return(NA_integer_) }) - -#' @importFrom DBI dbQuoteIdentifier -NULL - #' @exportMethod dbQuoteIdentifier #' @noRd setMethod("dbQuoteIdentifier", signature("JDBCConnection", "character"), @@ -85,9 +85,6 @@ setMethod("dbQuoteIdentifier", signature("JDBCConnection", "Id"), } ) -#' @importFrom DBI dbWriteTable -NULL - #' @importFrom methods setMethod #' @importClassesFrom RJDBC JDBCConnection #' @exportMethod dbWriteTable From 1ba22fa3661c18993254306cd6b7a0e3dd314041 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 09:53:57 +0200 Subject: [PATCH 049/129] debug oracle - print showMethods --- tests/testthat/setup.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 905980a3..a71c8f80 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -37,7 +37,7 @@ for (conn in get_test_conns()) { purrr::walk(c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .)) - + print(showMethods(DBI::dbWriteTable)) # Copy mtcars to conn dplyr::copy_to(conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), name = id("test.mtcars", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) From ef25388a7fbaba3732f41f91a566e8d28c1a65dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 10:22:35 +0200 Subject: [PATCH 050/129] debug oracle- remove ambiguity for dbWriteTable dispatch --- R/backend_oracle.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 5bbf15c1..192203c3 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -14,6 +14,20 @@ NULL #' @noRd methods::setClass("Oracle", contains = "JDBCConnection") +#' @exportMethod dbWriteTable +setMethod("dbWriteTable", signature("JDBCConnection", "character", "data.frame"), + function(conn, name, value, ...) { + DBI::dbWriteTable(conn, id(conn, name), value, ...) + } +) + +#' @exportMethod dbWriteTable +setMethod("dbWriteTable", signature("JDBCConnection", "Id", "data.frame"), + function(conn, name, value, ...) { + DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn, name), value, ...) + } +) + # The ANALYZE TABLE command generated by dplyr does not work for Oracle, so we manually implement. #' @exportS3Method dbplyr::sql_table_analyze From 5abedc4b3433e4e8d52d81c8bd0b2fabfc70e284 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 12:25:38 +0200 Subject: [PATCH 051/129] debug table creation - show chosen methods --- tests/testthat/setup.R | 67 +++++++++++++++++++++++++++++------------- 1 file changed, 47 insertions(+), 20 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index a71c8f80..fc5fbaa8 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -29,29 +29,56 @@ checkmate::reportAssertions(coll) for (conn in get_test_conns()) { # Start with some clean up - purrr::walk(c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", - "test.SCDB_logs", "test.SCDB_logger", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", - "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2"), - ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn))) - - purrr::walk(c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), - ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .)) + purrr::walk( + c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", + "test.SCDB_logs", "test.SCDB_logger", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", + "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2" + ), + ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) + ) + + purrr::walk( + c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), + ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) + ) print(showMethods(DBI::dbWriteTable)) + print(selectMethod(DBI::dbWriteTable, signature(class(conn), "Id", "data.frame"))) + + print(showMethods(DBI::sqlCreateTable)) + print(selectMethod(DBI::sqlCreateTable, signature(class(conn), "Id"))) + # Copy mtcars to conn - dplyr::copy_to(conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), - name = id("test.mtcars", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) - - dplyr::copy_to(conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), - name = id("__mtcars", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) - - dplyr::copy_to(conn, - mtcars %>% - dplyr::mutate(name = rownames(mtcars)) %>% - digest_to_checksum() %>% - dplyr::mutate(from_ts = as.POSIXct("2020-01-01 09:00:00"), - until_ts = as.POSIXct(NA)), - name = id("__mtcars_historical", conn), temporary = FALSE, overwrite = TRUE, analyze = FALSE) + dplyr::copy_to( + conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), + name = id("test.mtcars", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dplyr::copy_to( + conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), + name = id("__mtcars", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dplyr::copy_to( + conn, + mtcars %>% + dplyr::mutate(name = rownames(mtcars)) %>% + digest_to_checksum() %>% + dplyr::mutate( + from_ts = as.POSIXct("2020-01-01 09:00:00"), + until_ts = as.POSIXct(NA) + ), + name = id("__mtcars_historical", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) DBI::dbDisconnect(conn) } From d4ffc298262710273b1ed56c98f0fad5e1d950d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 12:45:13 +0200 Subject: [PATCH 052/129] fix backend_oracle - change how classes are merged --- R/backend_oracle.R | 2 +- R/connection.R | 2 +- R/db_joins.R | 2 +- R/digest_to_checksum.R | 2 +- R/getTableSignature.R | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 192203c3..7a716b79 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -12,7 +12,7 @@ NULL # Create Frankenstein class #' @export #' @noRd -methods::setClass("Oracle", contains = "JDBCConnection") +methods::setClassUnion("Oracle_JDBC", c("Oracle", "JDBCConnection")) #' @exportMethod dbWriteTable setMethod("dbWriteTable", signature("JDBCConnection", "character", "data.frame"), diff --git a/R/connection.R b/R/connection.R index ec4b45d9..6686cb52 100644 --- a/R/connection.R +++ b/R/connection.R @@ -262,7 +262,7 @@ get_connection.JDBCDriver <- function( # Cast to superclass conn <- new( - "Oracle", + "Oracle_JDBC", jc=conn@jc, identifier.quote=conn@identifier.quote ) diff --git a/R/db_joins.R b/R/db_joins.R index 82c9c6ce..b1f17ce2 100644 --- a/R/db_joins.R +++ b/R/db_joins.R @@ -69,7 +69,7 @@ join_na_sql.tbl_dbi <- function(x, by, na_by) { } #' @noRd -`join_na_sql.tbl_Oracle` <- function(x, by, na_by) { +`join_na_sql.tbl_Oracle_JDBC` <- function(x, by, na_by) { return(join_na_not_null(by = by, na_by = na_by)) } diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index f25ebaf7..77127cdd 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -52,7 +52,7 @@ digest_to_checksum <- function(.data, col = "checksum", exclude = NULL) { } #' @export -`digest_to_checksum.tbl_Oracle` <- function( +`digest_to_checksum.tbl_Oracle_JDBC` <- function( .data, col = formals(digest_to_checksum)$col, exclude = formals(digest_to_checksum)$exclude) { diff --git a/R/getTableSignature.R b/R/getTableSignature.R index d9f9c33a..dec31ce7 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -42,7 +42,7 @@ methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" ), - "Oracle" = c( + "Oracle_JDBC" = c( checksum = "CHAR(32)", from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" From d9ebc4a9cd0816c4f170c2015a62f26829cd3c83 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Fri, 17 Oct 2025 10:49:41 +0000 Subject: [PATCH 053/129] docs: Re-build roxygen documentation --- NAMESPACE | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e4b23669..cd202e97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,7 +12,7 @@ S3method(dbplyr::sql_table_analyze,Oracle) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) -S3method(digest_to_checksum,tbl_Oracle) +S3method(digest_to_checksum,tbl_Oracle_JDBC) S3method(digest_to_checksum,tbl_PqConnection) S3method(digest_to_checksum,tbl_duckdb_connection) S3method(dplyr::anti_join,tbl_sql) @@ -87,7 +87,7 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) -exportClasses(Oracle) +exportClasses(Oracle_JDBC) exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) From 22ae908b813f5c4a5505658308c9b77bc3cc84d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 12:55:21 +0200 Subject: [PATCH 054/129] fix backend_oracle - import odbc Oracle class --- NAMESPACE | 1 + R/backend_oracle.R | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index cd202e97..93197dfd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -95,6 +95,7 @@ exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) +importClassesFrom(odbc,Oracle) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 7a716b79..5a0d7b6d 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -5,11 +5,12 @@ #' @importMethodsFrom DBI dbGetRowsAffected #' @importMethodsFrom DBI dbQuoteIdentifier #' @importMethodsFrom RJDBC dbWriteTable -#' @importClassesFrom RJDBC JDBCConnection NULL # Create Frankenstein class +#' @importClassesFrom odbc Oracle +#' @importClassesFrom RJDBC JDBCConnection #' @export #' @noRd methods::setClassUnion("Oracle_JDBC", c("Oracle", "JDBCConnection")) From 4c83d597755a582253c2db6c00609ed047336dec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 17 Oct 2025 13:15:28 +0200 Subject: [PATCH 055/129] fix backend_oracle - change how classes are merged --- NAMESPACE | 5 ++-- R/backend_oracle.R | 66 +++++++++++++++++++----------------------- R/connection.R | 8 +++-- R/db_joins.R | 2 +- R/digest_to_checksum.R | 2 +- R/getTableSignature.R | 2 +- 6 files changed, 40 insertions(+), 45 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 93197dfd..95d7e237 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,7 +12,7 @@ S3method(dbplyr::sql_table_analyze,Oracle) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) -S3method(digest_to_checksum,tbl_Oracle_JDBC) +S3method(digest_to_checksum,tbl_Oracle) S3method(digest_to_checksum,tbl_PqConnection) S3method(digest_to_checksum,tbl_duckdb_connection) S3method(dplyr::anti_join,tbl_sql) @@ -87,7 +87,6 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) -exportClasses(Oracle_JDBC) exportMethods(dbExistsTable) exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) @@ -95,7 +94,6 @@ exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) -importClassesFrom(odbc,Oracle) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) @@ -106,6 +104,7 @@ importFrom(rlang,.data) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbQuoteIdentifier) +importMethodsFrom(DBI,dbWriteTable) importMethodsFrom(RJDBC,dbDataType) importMethodsFrom(RJDBC,dbExistsTable) importMethodsFrom(RJDBC,dbWriteTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 5a0d7b6d..43b25e88 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -4,29 +4,23 @@ #' @importMethodsFrom RJDBC dbExistsTable #' @importMethodsFrom DBI dbGetRowsAffected #' @importMethodsFrom DBI dbQuoteIdentifier +#' @importMethodsFrom DBI dbWriteTable #' @importMethodsFrom RJDBC dbWriteTable NULL -# Create Frankenstein class -#' @importClassesFrom odbc Oracle -#' @importClassesFrom RJDBC JDBCConnection -#' @export -#' @noRd -methods::setClassUnion("Oracle_JDBC", c("Oracle", "JDBCConnection")) - #' @exportMethod dbWriteTable setMethod("dbWriteTable", signature("JDBCConnection", "character", "data.frame"), - function(conn, name, value, ...) { - DBI::dbWriteTable(conn, id(conn, name), value, ...) - } + function(conn, name, value, ...) { + DBI::dbWriteTable(conn, id(conn, name), value, ...) + } ) #' @exportMethod dbWriteTable setMethod("dbWriteTable", signature("JDBCConnection", "Id", "data.frame"), - function(conn, name, value, ...) { - DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn, name), value, ...) - } + function(conn, name, value, ...) { + DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn, name), value, ...) + } ) @@ -44,9 +38,9 @@ sql_table_analyze.Oracle <- function(con, table, ...) { #' @exportMethod dbExistsTable setMethod("dbExistsTable", signature("JDBCConnection", "Id"), - function(conn, name, ...) { - methods::callNextMethod() # Remove ambiguity - } + function(conn, name, ...) { + methods::callNextMethod() # Remove ambiguity + } ) @@ -69,35 +63,35 @@ setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { #' @exportMethod dbQuoteIdentifier #' @noRd setMethod("dbQuoteIdentifier", signature("JDBCConnection", "character"), - function(conn, x, ...) { - x <- enc2utf8(x) + function(conn, x, ...) { + x <- enc2utf8(x) - reserved_words <- c("DATE", "NUMBER", "VARCHAR") + reserved_words <- c("DATE", "NUMBER", "VARCHAR") - needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words - x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") - return(DBI::SQL(x, names = names(x))) - } + return(DBI::SQL(x, names = names(x))) + } ) #' @exportMethod dbQuoteIdentifier #' @noRd setMethod("dbQuoteIdentifier", signature("JDBCConnection", "SQL"), - function(conn, x, ...) { - return(x) # Remove ambiguity (also assume already quoted) - } + function(conn, x, ...) { + return(x) # Remove ambiguity (also assume already quoted) + } ) #' @exportMethod dbQuoteIdentifier #' @noRd setMethod("dbQuoteIdentifier", signature("JDBCConnection", "Id"), - function(conn, x, ...) { + function(conn, x, ...) { - # For `Id`, run on each non-NA element - return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) - } + # For `Id`, run on each non-NA element + return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) + } ) #' @importFrom methods setMethod @@ -105,15 +99,15 @@ setMethod("dbQuoteIdentifier", signature("JDBCConnection", "Id"), #' @exportMethod dbWriteTable #' @noRd setMethod("dbWriteTable", signature("JDBCConnection", "SQL", "data.frame"), - function(conn, name, value, ...) { + function(conn, name, value, ...) { - method <- getMethod(dbWriteTable, signature(conn = "JDBCConnection", name = "ANY", value = "ANY")) + method <- getMethod(dbWriteTable, signature(conn = "JDBCConnection", name = "ANY", value = "ANY")) - # Manually quote column names - names(value) <- as.character(DBI::dbQuoteIdentifier(conn, names(value))) + # Manually quote column names + names(value) <- as.character(DBI::dbQuoteIdentifier(conn, names(value))) - method@.Data(conn, name, value, ...) + method@.Data(conn, name, value, ...) - } + } ) diff --git a/R/connection.R b/R/connection.R index 6686cb52..747f1da9 100644 --- a/R/connection.R +++ b/R/connection.R @@ -261,10 +261,12 @@ get_connection.JDBCDriver <- function( ) # Cast to superclass + setClass("Oracle", slots=list(), contains = "JDBCConnection") + conn <- new( - "Oracle_JDBC", - jc=conn@jc, - identifier.quote=conn@identifier.quote + "Oracle", + jc = slot(conn, "jc"), + identifier.quote = slot(conn, "identifier.quote") ) return(conn) diff --git a/R/db_joins.R b/R/db_joins.R index b1f17ce2..82c9c6ce 100644 --- a/R/db_joins.R +++ b/R/db_joins.R @@ -69,7 +69,7 @@ join_na_sql.tbl_dbi <- function(x, by, na_by) { } #' @noRd -`join_na_sql.tbl_Oracle_JDBC` <- function(x, by, na_by) { +`join_na_sql.tbl_Oracle` <- function(x, by, na_by) { return(join_na_not_null(by = by, na_by = na_by)) } diff --git a/R/digest_to_checksum.R b/R/digest_to_checksum.R index 77127cdd..f25ebaf7 100644 --- a/R/digest_to_checksum.R +++ b/R/digest_to_checksum.R @@ -52,7 +52,7 @@ digest_to_checksum <- function(.data, col = "checksum", exclude = NULL) { } #' @export -`digest_to_checksum.tbl_Oracle_JDBC` <- function( +`digest_to_checksum.tbl_Oracle` <- function( .data, col = formals(digest_to_checksum)$col, exclude = formals(digest_to_checksum)$exclude) { diff --git a/R/getTableSignature.R b/R/getTableSignature.R index dec31ce7..d9f9c33a 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -42,7 +42,7 @@ methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" ), - "Oracle_JDBC" = c( + "Oracle" = c( checksum = "CHAR(32)", from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" From 8d1e89236c1c72813faeaba363fbce75f8d0afdd Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Fri, 17 Oct 2025 12:20:53 +0000 Subject: [PATCH 056/129] chore: Update Docker specification --- docker-specs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 docker-specs diff --git a/docker-specs b/docker-specs new file mode 100644 index 00000000..d22f0d28 --- /dev/null +++ b/docker-specs @@ -0,0 +1,16 @@ +FROM r-base:latest + +# tex packages are installed in /root/bin so we have to make sure those +# packages accessible by adding that directory to the PATH variable. +ENV PATH="/opt/hostedtoolcache/pandoc/3.1.11/x64:/snap/bin:/home/runner/.local/bin:/opt/pipx_bin:/home/runner/.cargo/bin:/home/runner/.config/composer/vendor/bin:/usr/local/.ghcup/bin:/home/runner/.dotnet/tools:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin:/root/bin" + +# system dependencies (apt-get since r-base is debian based) +RUN apt-get update; \ + apt-get install -y build-essential gfortran\ + libapparmor-dev libboost-all-dev libcairo2-dev libcurl4-gnutls-dev\ + libfontconfig1-dev libgsl-dev libjpeg-dev liblapack-dev libpng-dev\ + libproj-dev libsodium-dev libssl-dev libudunits2-dev libxml2-dev\ + mesa-common-dev libglu1-mesa-dev libharfbuzz-dev libfribidi-dev\ + default-jre default-jdk pandoc git gnupg; + +RUN R -e 'install.packages(pak)' From 65ba9973f084acb49abfff36890ae082f9bd88da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 12:20:53 +0200 Subject: [PATCH 057/129] try different approach --- .github/workflows/all-workflows.yaml | 2 +- R/backend_oracle.R | 146 +++++++++++++-------------- R/connection.R | 5 +- 3 files changed, 73 insertions(+), 80 deletions(-) diff --git a/.github/workflows/all-workflows.yaml b/.github/workflows/all-workflows.yaml index d6feafaa..d05eb0fd 100644 --- a/.github/workflows/all-workflows.yaml +++ b/.github/workflows/all-workflows.yaml @@ -26,7 +26,7 @@ jobs: name: ⚙️ Dispatch needs: context if: needs.context.outputs.abort != 'true' || contains('main,master', github.ref_name) - uses: ssi-dk/AEF-DDF/.github/workflows/workflow-dispatcher.yaml@main + uses: ssi-dk/AEF-DDF/.github/workflows/workflow-dispatcher.yaml@dockerise-workflows with: # We pass information about the triggering event event_name: ${{ github.event_name }} diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 43b25e88..cd1ec467 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -10,104 +10,98 @@ NULL #' @exportMethod dbWriteTable -setMethod("dbWriteTable", signature("JDBCConnection", "character", "data.frame"), +setMethod("dbWriteTable", signature("Oracle", "character", "data.frame"), function(conn, name, value, ...) { - DBI::dbWriteTable(conn, id(conn, name), value, ...) + DBI::dbWriteTable(conn@conn, id(conn@conn, name), value, ...) } ) #' @exportMethod dbWriteTable -setMethod("dbWriteTable", signature("JDBCConnection", "Id", "data.frame"), +setMethod("dbWriteTable", signature("Oracle", "Id", "data.frame"), function(conn, name, value, ...) { - DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn, name), value, ...) + DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn@conn, name), value, ...) } ) -# The ANALYZE TABLE command generated by dplyr does not work for Oracle, so we manually implement. -#' @exportS3Method dbplyr::sql_table_analyze -#' @noRd -sql_table_analyze.Oracle <- function(con, table, ...) { - dbplyr::build_sql( - "ANALYZE TABLE ", - dbplyr::as.sql(id(table, conn = con), con = con), - " COMPUTE STATISTICS", - con = con - ) -} +# # The ANALYZE TABLE command generated by dplyr does not work for Oracle, so we manually implement. +# #' @exportS3Method dbplyr::sql_table_analyze +# #' @noRd +# sql_table_analyze.Oracle <- function(con, table, ...) { +# dbplyr::build_sql( +# "ANALYZE TABLE ", +# dbplyr::as.sql(id(table, conn = con), con = con), +# " COMPUTE STATISTICS", +# con = con +# ) +# } #' @exportMethod dbExistsTable -setMethod("dbExistsTable", signature("JDBCConnection", "Id"), +setMethod("dbExistsTable", signature("dbExistsTable", "Id"), function(conn, name, ...) { - methods::callNextMethod() # Remove ambiguity - } -) - - -#' @importFrom rJava .jcall -#' @importFrom methods setMethod -#' @exportMethod dbGetRowsAffected -#' @noRd -setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { - if (!is.null(res@stat)) { - tryCatch({ - cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") - return(if (cnt < 0) 0L else as.integer(cnt)) - }, error = function(e) { - return(NA_integer_) - }) - } - return(NA_integer_) -}) - -#' @exportMethod dbQuoteIdentifier -#' @noRd -setMethod("dbQuoteIdentifier", signature("JDBCConnection", "character"), - function(conn, x, ...) { - x <- enc2utf8(x) - - reserved_words <- c("DATE", "NUMBER", "VARCHAR") - - needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words - - x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") - - return(DBI::SQL(x, names = names(x))) + DBI::dbExistsTable(conn@conn, name, ...) } ) -#' @exportMethod dbQuoteIdentifier -#' @noRd -setMethod("dbQuoteIdentifier", signature("JDBCConnection", "SQL"), - function(conn, x, ...) { - return(x) # Remove ambiguity (also assume already quoted) - } -) -#' @exportMethod dbQuoteIdentifier -#' @noRd -setMethod("dbQuoteIdentifier", signature("JDBCConnection", "Id"), - function(conn, x, ...) { - - # For `Id`, run on each non-NA element - return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) - } -) +# #' @importFrom rJava .jcall +# #' @importFrom methods setMethod +# #' @exportMethod dbGetRowsAffected +# #' @noRd +# setMethod("dbGetRowsAffected", "Oracle", function(res, ...) { +# if (!is.null(res@stat)) { +# tryCatch({ +# cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") +# return(if (cnt < 0) 0L else as.integer(cnt)) +# }, error = function(e) { +# return(NA_integer_) +# }) +# } +# return(NA_integer_) +# }) + +# #' @exportMethod dbQuoteIdentifier +# #' @noRd +# setMethod("dbQuoteIdentifier", signature("Oracle", "character"), +# function(conn, x, ...) { +# x <- enc2utf8(x) + +# reserved_words <- c("DATE", "NUMBER", "VARCHAR") + +# needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + +# x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + +# return(DBI::SQL(x, names = names(x))) +# } +# ) + +# #' @exportMethod dbQuoteIdentifier +# #' @noRd +# setMethod("dbQuoteIdentifier", signature("Oracle", "SQL"), +# function(conn, x, ...) { +# return(x) # Remove ambiguity (also assume already quoted) +# } +# ) + +# #' @exportMethod dbQuoteIdentifier +# #' @noRd +# setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), +# function(conn, x, ...) { + +# # For `Id`, run on each non-NA element +# return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) +# } +# ) #' @importFrom methods setMethod -#' @importClassesFrom RJDBC JDBCConnection #' @exportMethod dbWriteTable #' @noRd -setMethod("dbWriteTable", signature("JDBCConnection", "SQL", "data.frame"), +setMethod("dbWriteTable", signature("Oracle", "SQL", "data.frame"), function(conn, name, value, ...) { - method <- getMethod(dbWriteTable, signature(conn = "JDBCConnection", name = "ANY", value = "ANY")) - - - # Manually quote column names - names(value) <- as.character(DBI::dbQuoteIdentifier(conn, names(value))) + names(value) <- as.character(DBI::dbQuoteIdentifier(conn@conn, names(value))) - method@.Data(conn, name, value, ...) - - } + DBI::dbWriteTable(conn@conn, name, value) + } ) diff --git a/R/connection.R b/R/connection.R index 747f1da9..fe2a663e 100644 --- a/R/connection.R +++ b/R/connection.R @@ -261,12 +261,11 @@ get_connection.JDBCDriver <- function( ) # Cast to superclass - setClass("Oracle", slots=list(), contains = "JDBCConnection") + setClass("Oracle", slots=list(conn)) conn <- new( "Oracle", - jc = slot(conn, "jc"), - identifier.quote = slot(conn, "identifier.quote") + conn = conn ) return(conn) From 6b063c7c1aa597b39c269fd916f0d0de0734a8dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 12:37:21 +0200 Subject: [PATCH 058/129] use main branch for workflows --- .github/workflows/all-workflows.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/all-workflows.yaml b/.github/workflows/all-workflows.yaml index d05eb0fd..d6feafaa 100644 --- a/.github/workflows/all-workflows.yaml +++ b/.github/workflows/all-workflows.yaml @@ -26,7 +26,7 @@ jobs: name: ⚙️ Dispatch needs: context if: needs.context.outputs.abort != 'true' || contains('main,master', github.ref_name) - uses: ssi-dk/AEF-DDF/.github/workflows/workflow-dispatcher.yaml@dockerise-workflows + uses: ssi-dk/AEF-DDF/.github/workflows/workflow-dispatcher.yaml@main with: # We pass information about the triggering event event_name: ${{ github.event_name }} From 0c9bb4197107d131e70617f40cf852cdda6cb803 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 12:46:25 +0200 Subject: [PATCH 059/129] try different approach --- NAMESPACE | 9 ++- R/backend_oracle.R | 165 ++++++++++++++++++++++++++++++--------------- R/connection.R | 7 +- 3 files changed, 116 insertions(+), 65 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 95d7e237..c00e50da 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,7 +8,6 @@ S3method(db_timestamp,"NULL") S3method(db_timestamp,SQLiteConnection) S3method(db_timestamp,default) S3method(db_timestamp,duckdb_connection) -S3method(dbplyr::sql_table_analyze,Oracle) S3method(digest_to_checksum,"tbl_Microsoft SQL Server") S3method(digest_to_checksum,data.frame) S3method(digest_to_checksum,default) @@ -88,25 +87,25 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbExistsTable) -exportMethods(dbGetRowsAffected) exportMethods(dbQuoteIdentifier) +exportMethods(dbSendQuery) exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) +importClassesFrom(odbc,Oracle) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) -importFrom(methods,setMethod) -importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) importMethodsFrom(DBI,dbExistsTable) -importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbQuoteIdentifier) +importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbWriteTable) importMethodsFrom(RJDBC,dbDataType) importMethodsFrom(RJDBC,dbExistsTable) +importMethodsFrom(RJDBC,dbSendQuery) importMethodsFrom(RJDBC,dbWriteTable) importMethodsFrom(odbc,dbDataType) importMethodsFrom(odbc,sqlCreateTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index cd1ec467..bc006ecd 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -1,31 +1,60 @@ # dbplyr needs additional implementation for Oracle to work. -#' @importMethodsFrom DBI dbExistsTable -#' @importMethodsFrom RJDBC dbExistsTable -#' @importMethodsFrom DBI dbGetRowsAffected -#' @importMethodsFrom DBI dbQuoteIdentifier +#' @importClassesFrom RJDBC JDBCConnection +#' @importClassesFrom odbc Oracle +setClass("OracleConnection", slots = list(jdbc_conn = "JDBCConnection"), contains = "Oracle") + #' @importMethodsFrom DBI dbWriteTable #' @importMethodsFrom RJDBC dbWriteTable -NULL - +#' @exportMethod dbWriteTable +setMethod( + "dbWriteTable", + signature( + conn = "OracleConnection", + name = "character", + value = "data.frame" + ), + function(conn, name, value, ...) { + DBI::dbWriteTable(conn@jdbc_conn, id(conn@jdbc_conn, name), value, ...) + } +) +#' @importMethodsFrom DBI dbWriteTable +#' @importMethodsFrom RJDBC dbWriteTable #' @exportMethod dbWriteTable -setMethod("dbWriteTable", signature("Oracle", "character", "data.frame"), - function(conn, name, value, ...) { - DBI::dbWriteTable(conn@conn, id(conn@conn, name), value, ...) - } +setMethod( + "dbWriteTable", + signature( + conn = "OracleConnection", + name = "Id", + value = "data.frame" + ), + function(conn, name, value, ...) { + DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn@jdbc_conn, name), value, ...) + } ) +#' @importMethodsFrom DBI dbWriteTable +#' @importMethodsFrom RJDBC dbWriteTable #' @exportMethod dbWriteTable -setMethod("dbWriteTable", signature("Oracle", "Id", "data.frame"), - function(conn, name, value, ...) { - DBI::dbWriteTable(conn, DBI::dbQuoteIdentifier(conn@conn, name), value, ...) - } +setMethod( + "dbWriteTable", + signature( + conn = "OracleConnection", + name = "SQL", + value = "data.frame" + ), + function(conn, name, value, ...) { + + names(value) <- as.character(DBI::dbQuoteIdentifier(conn@jdbc_conn, names(value))) + + DBI::dbWriteTable(conn@jdbc_conn, name, value) + } ) # # The ANALYZE TABLE command generated by dplyr does not work for Oracle, so we manually implement. -# #' @exportS3Method dbplyr::sql_table_analyze +# #' DBI::dbSendQuery@exportS3Method dbplyr::sql_table_analyze # #' @noRd # sql_table_analyze.Oracle <- function(con, table, ...) { # dbplyr::build_sql( @@ -34,13 +63,20 @@ setMethod("dbWriteTable", signature("Oracle", "Id", "data.frame"), # " COMPUTE STATISTICS", # con = con # ) -# } +# }dbExistsTable +#' @importMethodsFrom DBI dbExistsTable +#' @importMethodsFrom RJDBC dbExistsTable #' @exportMethod dbExistsTable -setMethod("dbExistsTable", signature("dbExistsTable", "Id"), - function(conn, name, ...) { - DBI::dbExistsTable(conn@conn, name, ...) - } +setMethod( + "dbExistsTable", + signature( + conn = "OracleConnection", + name = "Id" + ), + function(conn, name, ...) { + DBI::dbExistsTable(conn@jdbc_conn, name, ...) + } ) @@ -48,7 +84,7 @@ setMethod("dbExistsTable", signature("dbExistsTable", "Id"), # #' @importFrom methods setMethod # #' @exportMethod dbGetRowsAffected # #' @noRd -# setMethod("dbGetRowsAffected", "Oracle", function(res, ...) { +# setMethod("dbGetRowsAffected", "OracleConnection", function(res, ...) { # if (!is.null(res@stat)) { # tryCatch({ # cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") @@ -60,48 +96,67 @@ setMethod("dbExistsTable", signature("dbExistsTable", "Id"), # return(NA_integer_) # }) -# #' @exportMethod dbQuoteIdentifier -# #' @noRd -# setMethod("dbQuoteIdentifier", signature("Oracle", "character"), -# function(conn, x, ...) { -# x <- enc2utf8(x) - -# reserved_words <- c("DATE", "NUMBER", "VARCHAR") +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleConnection", + x = "character" + ), + function(conn, x, ...) { + x <- enc2utf8(x) -# needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + reserved_words <- c("DATE", "NUMBER", "VARCHAR") -# x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words -# return(DBI::SQL(x, names = names(x))) -# } -# ) + x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") -# #' @exportMethod dbQuoteIdentifier -# #' @noRd -# setMethod("dbQuoteIdentifier", signature("Oracle", "SQL"), -# function(conn, x, ...) { -# return(x) # Remove ambiguity (also assume already quoted) -# } -# ) + return(DBI::SQL(x, names = names(x))) + } +) -# #' @exportMethod dbQuoteIdentifier -# #' @noRd -# setMethod("dbQuoteIdentifier", signature("Oracle", "Id"), -# function(conn, x, ...) { +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleConnection", + x = "SQL" + ), + function(conn, x, ...) { + return(x) # Remove ambiguity (also assume already quoted) + } +) -# # For `Id`, run on each non-NA element -# return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn, purrr::discard(x@name, is.na)), collapse = "."))) -# } -# ) +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleConnection", + x = "Id" + ), + function(conn, x, ...) { + + # For `Id`, run on each non-NA element + return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn@jdbc_conn, purrr::discard(x@name, is.na)), collapse = "."))) + } +) -#' @importFrom methods setMethod -#' @exportMethod dbWriteTable -#' @noRd -setMethod("dbWriteTable", signature("Oracle", "SQL", "data.frame"), - function(conn, name, value, ...) { - names(value) <- as.character(DBI::dbQuoteIdentifier(conn@conn, names(value))) - DBI::dbWriteTable(conn@conn, name, value) +#' @importMethodsFrom DBI dbSendQuery +#' @importMethodsFrom RJDBC dbSendQuery +#' @exportMethod dbSendQuery +setMethod( + "dbSendQuery", + signature( + conn = "OracleConnection", + statement = "character" + ), + function(conn, statement, ...) { + DBI::dbSendQuery(conn@jdbc_conn, statement) } ) diff --git a/R/connection.R b/R/connection.R index fe2a663e..9ed6b820 100644 --- a/R/connection.R +++ b/R/connection.R @@ -260,12 +260,9 @@ get_connection.JDBCDriver <- function( call. = FALSE ) - # Cast to superclass - setClass("Oracle", slots=list(conn)) - conn <- new( - "Oracle", - conn = conn + "OracleConnection", + jdbc_conn = conn ) return(conn) From cce2ff839526268e30b7b5cdeb6749ce8b71e9ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 15:13:42 +0200 Subject: [PATCH 060/129] map dbIsValid --- NAMESPACE | 2 ++ R/backend_oracle.R | 12 ++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index c00e50da..ec3d4538 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,6 +87,7 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbExistsTable) +exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) exportMethods(dbSendQuery) exportMethods(dbWriteTable) @@ -100,6 +101,7 @@ importFrom(methods,setGeneric) importFrom(rlang,":=") importFrom(rlang,.data) importMethodsFrom(DBI,dbExistsTable) +importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbWriteTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index bc006ecd..50bb826e 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -160,3 +160,15 @@ setMethod( DBI::dbSendQuery(conn@jdbc_conn, statement) } ) + +#' @importMethodsFrom DBI dbIsValid +#' @exportMethod dbIsValid +setMethod( + "dbIsValid", + signature( + dbObj = "OracleConnection" + ), + function(dbObj, ...) { + DBI::dbIsValid(dbObj@jdbc_conn, ...) + } +) From 5d879f7afd29ff84234e936976149d8069cacaac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 15:35:15 +0200 Subject: [PATCH 061/129] map dbBegin --- NAMESPACE | 2 ++ R/backend_oracle.R | 12 ++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ec3d4538..d9b561ee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,6 +86,7 @@ export(table_exists) export(unique_table_name) export(unlock_table) export(update_snapshot) +exportMethods(dbBegin) exportMethods(dbExistsTable) exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) @@ -100,6 +101,7 @@ importFrom(magrittr,"%>%") importFrom(methods,setGeneric) importFrom(rlang,":=") importFrom(rlang,.data) +importMethodsFrom(DBI,dbBegin) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 50bb826e..5ded1b50 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -172,3 +172,15 @@ setMethod( DBI::dbIsValid(dbObj@jdbc_conn, ...) } ) + +#' @importMethodsFrom DBI dbBegin +#' @exportMethod dbBegin +setMethod( + "dbBegin", + signature( + conn = "OracleConnection" + ), + function(conn, ...) { + DBI::dbBegin(conn@jdbc_conn, ...) + } +) \ No newline at end of file From 24eafebe6cd13261a01e58381e0dc91887c9ff6c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 15:40:57 +0200 Subject: [PATCH 062/129] map dbCommit --- NAMESPACE | 2 ++ R/backend_oracle.R | 12 ++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index d9b561ee..7842b12a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,6 +87,7 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbBegin) +exportMethods(dbCommit) exportMethods(dbExistsTable) exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) @@ -102,6 +103,7 @@ importFrom(methods,setGeneric) importFrom(rlang,":=") importFrom(rlang,.data) importMethodsFrom(DBI,dbBegin) +importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 5ded1b50..daa99278 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -183,4 +183,16 @@ setMethod( function(conn, ...) { DBI::dbBegin(conn@jdbc_conn, ...) } +) + +#' @importMethodsFrom DBI dbCommit +#' @exportMethod dbCommit +setMethod( + "dbCommit", + signature( + conn = "OracleConnection" + ), + function(conn, ...) { + DBI::dbCommit(conn@jdbc_conn, ...) + } ) \ No newline at end of file From 5d526c12d5910ef666a5505b36da5abef899c153 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:24:26 +0200 Subject: [PATCH 063/129] Rename class to OracleJdbc --- R/backend_oracle.R | 26 +++++++++++++------------- R/connection.R | 2 +- R/getTableSignature.R | 2 +- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index daa99278..d7bb7df1 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -2,7 +2,7 @@ #' @importClassesFrom RJDBC JDBCConnection #' @importClassesFrom odbc Oracle -setClass("OracleConnection", slots = list(jdbc_conn = "JDBCConnection"), contains = "Oracle") +setClass("OracleJdbc", slots = list(jdbc_conn = "JDBCConnection"), contains = "Oracle") #' @importMethodsFrom DBI dbWriteTable #' @importMethodsFrom RJDBC dbWriteTable @@ -10,7 +10,7 @@ setClass("OracleConnection", slots = list(jdbc_conn = "JDBCConnection"), contain setMethod( "dbWriteTable", signature( - conn = "OracleConnection", + conn = "OracleJdbc", name = "character", value = "data.frame" ), @@ -25,7 +25,7 @@ setMethod( setMethod( "dbWriteTable", signature( - conn = "OracleConnection", + conn = "OracleJdbc", name = "Id", value = "data.frame" ), @@ -40,7 +40,7 @@ setMethod( setMethod( "dbWriteTable", signature( - conn = "OracleConnection", + conn = "OracleJdbc", name = "SQL", value = "data.frame" ), @@ -71,7 +71,7 @@ setMethod( setMethod( "dbExistsTable", signature( - conn = "OracleConnection", + conn = "OracleJdbc", name = "Id" ), function(conn, name, ...) { @@ -84,7 +84,7 @@ setMethod( # #' @importFrom methods setMethod # #' @exportMethod dbGetRowsAffected # #' @noRd -# setMethod("dbGetRowsAffected", "OracleConnection", function(res, ...) { +# setMethod("dbGetRowsAffected", "OracleJdbc", function(res, ...) { # if (!is.null(res@stat)) { # tryCatch({ # cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") @@ -101,7 +101,7 @@ setMethod( setMethod( "dbQuoteIdentifier", signature( - conn = "OracleConnection", + conn = "OracleJdbc", x = "character" ), function(conn, x, ...) { @@ -122,7 +122,7 @@ setMethod( setMethod( "dbQuoteIdentifier", signature( - conn = "OracleConnection", + conn = "OracleJdbc", x = "SQL" ), function(conn, x, ...) { @@ -135,7 +135,7 @@ setMethod( setMethod( "dbQuoteIdentifier", signature( - conn = "OracleConnection", + conn = "OracleJdbc", x = "Id" ), function(conn, x, ...) { @@ -153,7 +153,7 @@ setMethod( setMethod( "dbSendQuery", signature( - conn = "OracleConnection", + conn = "OracleJdbc", statement = "character" ), function(conn, statement, ...) { @@ -166,7 +166,7 @@ setMethod( setMethod( "dbIsValid", signature( - dbObj = "OracleConnection" + dbObj = "OracleJdbc" ), function(dbObj, ...) { DBI::dbIsValid(dbObj@jdbc_conn, ...) @@ -178,7 +178,7 @@ setMethod( setMethod( "dbBegin", signature( - conn = "OracleConnection" + conn = "OracleJdbc" ), function(conn, ...) { DBI::dbBegin(conn@jdbc_conn, ...) @@ -190,7 +190,7 @@ setMethod( setMethod( "dbCommit", signature( - conn = "OracleConnection" + conn = "OracleJdbc" ), function(conn, ...) { DBI::dbCommit(conn@jdbc_conn, ...) diff --git a/R/connection.R b/R/connection.R index 9ed6b820..3f90be80 100644 --- a/R/connection.R +++ b/R/connection.R @@ -261,7 +261,7 @@ get_connection.JDBCDriver <- function( ) conn <- new( - "OracleConnection", + "OracleJdbc", jdbc_conn = conn ) diff --git a/R/getTableSignature.R b/R/getTableSignature.R index d9f9c33a..6c79b175 100644 --- a/R/getTableSignature.R +++ b/R/getTableSignature.R @@ -42,7 +42,7 @@ methods::setMethod("getTableSignature", "DBIConnection", function(.data, conn) { from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" ), - "Oracle" = c( + "OracleJdbc" = c( checksum = "CHAR(32)", from_ts = "TIMESTAMP", until_ts = "TIMESTAMP" From bcfceaaf9d10f4a0522852fe18626c08481f6359 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:25:36 +0200 Subject: [PATCH 064/129] map dbGetInfo --- NAMESPACE | 2 ++ R/backend_oracle.R | 14 +++++++++++++- 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 7842b12a..d6b5399a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(update_snapshot) exportMethods(dbBegin) exportMethods(dbCommit) exportMethods(dbExistsTable) +exportMethods(dbGetInfo) exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) exportMethods(dbSendQuery) @@ -105,6 +106,7 @@ importFrom(rlang,.data) importMethodsFrom(DBI,dbBegin) importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) +importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbSendQuery) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index d7bb7df1..589e4e12 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -195,4 +195,16 @@ setMethod( function(conn, ...) { DBI::dbCommit(conn@jdbc_conn, ...) } -) \ No newline at end of file +) + +#' @importMethodsFrom DBI dbGetInfo +#' @exportMethod dbGetInfo +setMethod( + "dbGetInfo", + signature( + dbObj = "OracleJdbc" + ), + function(dbObj, ...) { + DBI::dbGetInfo(dbObj@jdbc_conn, ...) + } +) From 546a76c459bc85e6f3445a5bb5cad0724d899817 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:26:34 +0200 Subject: [PATCH 065/129] map dbRollback --- NAMESPACE | 2 ++ R/backend_oracle.R | 12 ++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index d6b5399a..5e54f216 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -92,6 +92,7 @@ exportMethods(dbExistsTable) exportMethods(dbGetInfo) exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) +exportMethods(dbRollback) exportMethods(dbSendQuery) exportMethods(dbWriteTable) import(parallelly) @@ -109,6 +110,7 @@ importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) +importMethodsFrom(DBI,dbRollback) importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbWriteTable) importMethodsFrom(RJDBC,dbDataType) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 589e4e12..1375d3b7 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -185,6 +185,18 @@ setMethod( } ) +#' @importMethodsFrom DBI dbRollback +#' @exportMethod dbRollback +setMethod( + "dbRollback", + signature( + conn = "OracleJdbc" + ), + function(conn, ...) { + DBI::dbRollback(conn@jdbc_conn, ...) + } +) + #' @importMethodsFrom DBI dbCommit #' @exportMethod dbCommit setMethod( From d85caa867b7c21fae38c9c00b939cd485f2df510 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:27:51 +0200 Subject: [PATCH 066/129] remove debug info from setup --- tests/testthat/setup.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index fc5fbaa8..8ac12e80 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -42,12 +42,6 @@ for (conn in get_test_conns()) { ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) ) - print(showMethods(DBI::dbWriteTable)) - print(selectMethod(DBI::dbWriteTable, signature(class(conn), "Id", "data.frame"))) - - print(showMethods(DBI::sqlCreateTable)) - print(selectMethod(DBI::sqlCreateTable, signature(class(conn), "Id"))) - # Copy mtcars to conn dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), From ad88bcb942a4c74d8467451e94ef95e2a0a18bb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:52:44 +0200 Subject: [PATCH 067/129] Add list of RJDBC maps --- R/backend_oracle.R | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1375d3b7..73640c5c 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -4,6 +4,42 @@ #' @importClassesFrom odbc Oracle setClass("OracleJdbc", slots = list(jdbc_conn = "JDBCConnection"), contains = "Oracle") + +# DBI methods defined in RJDBC package +# dbOption +# dbListConnections +# dbGetInfo +# dbUnloadDriver +# dbConnect +# dbDisconnect +# dbIsValid - mapped +# dbSendQuery - mapped +# dbSendUpdate +# dbGetQuery +# dbGetException +# dbGetInfo +# dbListResults +# dbListTables +# dbGetTables +# dbExistsTable - mapped +# dbRemoveTable +# dbListFields +# dbGetFields +# dbReadTable +# dbReadTable +# dbDataType +# dbWriteTable - mapped +# dbCommit +# dbRollback - mapped +# dbBegin - mapped +# dbClearResult +# dbGetInfo - mapped +# dbHasCompleted +# dbColumnInfo + +# Additonal implementations +# dbQuoteIdentifier + #' @importMethodsFrom DBI dbWriteTable #' @importMethodsFrom RJDBC dbWriteTable #' @exportMethod dbWriteTable From 8d78baec41f8f43f706ff49bdd04122d699709f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 20:52:53 +0200 Subject: [PATCH 068/129] map dbSendStatement --- NAMESPACE | 2 ++ R/backend_oracle.R | 15 +++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 5e54f216..3aca1751 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -94,6 +94,7 @@ exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) exportMethods(dbRollback) exportMethods(dbSendQuery) +exportMethods(dbSendStatement) exportMethods(dbWriteTable) import(parallelly) importClassesFrom(DBI,DBIConnection) @@ -112,6 +113,7 @@ importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbRollback) importMethodsFrom(DBI,dbSendQuery) +importMethodsFrom(DBI,dbSendStatement) importMethodsFrom(DBI,dbWriteTable) importMethodsFrom(RJDBC,dbDataType) importMethodsFrom(RJDBC,dbExistsTable) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 73640c5c..3468d219 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -39,6 +39,8 @@ setClass("OracleJdbc", slots = list(jdbc_conn = "JDBCConnection"), contains = "O # Additonal implementations # dbQuoteIdentifier +# dbSendStatement + #' @importMethodsFrom DBI dbWriteTable #' @importMethodsFrom RJDBC dbWriteTable @@ -256,3 +258,16 @@ setMethod( DBI::dbGetInfo(dbObj@jdbc_conn, ...) } ) + +#' @importMethodsFrom DBI dbSendStatement +#' @exportMethod dbSendStatement +setMethod( + "dbSendStatement", + signature( + conn = "OracleJdbc", + statement = "character" + ), + function(conn, statement, ...) { + DBI::dbSendQuery(conn@jdbc_conn, statement, ...) + } +) From 325f2cdd50919d4fae79b372fb275b240231f54a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 21:03:12 +0200 Subject: [PATCH 069/129] set JDBC urll as OracleJdbc servername --- R/connection.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/connection.R b/R/connection.R index 3f90be80..140247e8 100644 --- a/R/connection.R +++ b/R/connection.R @@ -262,7 +262,8 @@ get_connection.JDBCDriver <- function( conn <- new( "OracleJdbc", - jdbc_conn = conn + jdbc_conn = conn, + servername = url ) return(conn) From 2249c11b0fa8caf5c83fe53c99c54243ab077946 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 21:04:20 +0200 Subject: [PATCH 070/129] Try to implement dbGetRowsAffected --- NAMESPACE | 3 +++ R/backend_oracle.R | 31 +++++++++++++++---------------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3aca1751..95d5b79c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -90,6 +90,7 @@ exportMethods(dbBegin) exportMethods(dbCommit) exportMethods(dbExistsTable) exportMethods(dbGetInfo) +exportMethods(dbGetRowsAffected) exportMethods(dbIsValid) exportMethods(dbQuoteIdentifier) exportMethods(dbRollback) @@ -103,12 +104,14 @@ importClassesFrom(odbc,Oracle) importFrom(R6,R6Class) importFrom(magrittr,"%>%") importFrom(methods,setGeneric) +importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) importMethodsFrom(DBI,dbBegin) importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbGetInfo) +importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbIsValid) importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbRollback) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 3468d219..8fa1bbf6 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -117,22 +117,21 @@ setMethod( } ) - -# #' @importFrom rJava .jcall -# #' @importFrom methods setMethod -# #' @exportMethod dbGetRowsAffected -# #' @noRd -# setMethod("dbGetRowsAffected", "OracleJdbc", function(res, ...) { -# if (!is.null(res@stat)) { -# tryCatch({ -# cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") -# return(if (cnt < 0) 0L else as.integer(cnt)) -# }, error = function(e) { -# return(NA_integer_) -# }) -# } -# return(NA_integer_) -# }) +#' @importFrom rJava .jcall +#' @importMethodsFrom DBI dbGetRowsAffected +#' @exportMethod dbGetRowsAffected +#' @noRd +setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { + if (!is.null(res@stat)) { + tryCatch({ + cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") + return(if (cnt < 0) 0L else as.integer(cnt)) + }, error = function(e) { + return(NA_integer_) + }) + } + return(NA_integer_) +}) #' @importMethodsFrom DBI dbQuoteIdentifier #' @exportMethod dbQuoteIdentifier From 85688bcfcac4c1731a0f68a18dade5d74f13e182 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 21:14:06 +0200 Subject: [PATCH 071/129] set JDBC urll as OracleJdbc servername --- R/backend_oracle.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 8fa1bbf6..59d7c608 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -2,7 +2,7 @@ #' @importClassesFrom RJDBC JDBCConnection #' @importClassesFrom odbc Oracle -setClass("OracleJdbc", slots = list(jdbc_conn = "JDBCConnection"), contains = "Oracle") +setClass("OracleJdbc", slots = list("jdbc_conn" = "JDBCConnection", "servername" = ""), contains = "Oracle") # DBI methods defined in RJDBC package @@ -254,7 +254,8 @@ setMethod( dbObj = "OracleJdbc" ), function(dbObj, ...) { - DBI::dbGetInfo(dbObj@jdbc_conn, ...) + out <- DBI::dbGetInfo(dbObj@jdbc_conn, ...) + out$info <- list("servername" = dbObj@servername) } ) From b5986b5c11412575d6862722514e390bf0e842e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 22:29:24 +0200 Subject: [PATCH 072/129] Try to implement dbGetRowsAffected --- R/backend_oracle.R | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 59d7c608..34047d0b 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -121,17 +121,23 @@ setMethod( #' @importMethodsFrom DBI dbGetRowsAffected #' @exportMethod dbGetRowsAffected #' @noRd -setMethod("dbGetRowsAffected", "JDBCResult", function(res, ...) { - if (!is.null(res@stat)) { - tryCatch({ - cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") - return(if (cnt < 0) 0L else as.integer(cnt)) - }, error = function(e) { - return(NA_integer_) - }) +setMethod( + "dbGetRowsAffected", + signature( + res = "JDBCResult" + ), + function(res, ...) { + if (!is.null(res@stat)) { + tryCatch({ + cnt <- rJava::.jcall(res@stat, "I", "getUpdateCount") + return(if (cnt < 0) 0L else as.integer(cnt)) + }, error = function(e) { + return(NA_integer_) + }) + } + return(NA_integer_) } - return(NA_integer_) -}) +) #' @importMethodsFrom DBI dbQuoteIdentifier #' @exportMethod dbQuoteIdentifier @@ -256,6 +262,7 @@ setMethod( function(dbObj, ...) { out <- DBI::dbGetInfo(dbObj@jdbc_conn, ...) out$info <- list("servername" = dbObj@servername) + return(out) } ) From f85c4638d149f5be9244aac8a2fa8ce573af6366 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 23 Oct 2025 22:30:50 +0200 Subject: [PATCH 073/129] set JDBC urll as OracleJdbc servername --- R/backend_oracle.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 34047d0b..6e26e2dc 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -2,7 +2,7 @@ #' @importClassesFrom RJDBC JDBCConnection #' @importClassesFrom odbc Oracle -setClass("OracleJdbc", slots = list("jdbc_conn" = "JDBCConnection", "servername" = ""), contains = "Oracle") +setClass("OracleJdbc", slots = list("jdbc_conn" = "JDBCConnection", "servername" = "character"), contains = "Oracle") # DBI methods defined in RJDBC package @@ -260,9 +260,10 @@ setMethod( dbObj = "OracleJdbc" ), function(dbObj, ...) { - out <- DBI::dbGetInfo(dbObj@jdbc_conn, ...) - out$info <- list("servername" = dbObj@servername) - return(out) + modifyList( + DBI::dbGetInfo(dbObj@jdbc_conn, ...), + list("servername" = dbObj@servername) + ) } ) From 96dfa8bd68665971e32e79c5dd369db09f8df0f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 10:32:56 +0200 Subject: [PATCH 074/129] debug id.tbl_dbi issue --- R/id.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/id.R b/R/id.R index 0f0dabcc..27886895 100644 --- a/R/id.R +++ b/R/id.R @@ -135,6 +135,9 @@ id.tbl_dbi <- function(db_table, ...) { matches <- get_tables(dbplyr::remote_con(db_table), show_temporary = TRUE) %>% dplyr::filter(.data$table == !!table) + print("matches:") + print(matches) + if (!is.null(schema)) matches <- dplyr::filter(matches, .data$schema == !!schema) if (!is.null(catalog)) matches <- dplyr::filter(matches, .data$catalog == !!catalog) From c1e178e41605c34200137d6776ced1dba66d83f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 11:04:58 +0200 Subject: [PATCH 075/129] set JDBC urll as OracleJdbc servername --- R/backend_oracle.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 6e26e2dc..37d9c2fb 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -262,7 +262,10 @@ setMethod( function(dbObj, ...) { modifyList( DBI::dbGetInfo(dbObj@jdbc_conn, ...), - list("servername" = dbObj@servername) + list( + "servername" = dbObj@servername, + "port" = "" + ) ) } ) From 4382dff5939944fd613feb21cbef179dd09a7432 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 11:05:21 +0200 Subject: [PATCH 076/129] debug id.tbl_dbi issue --- R/id.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/id.R b/R/id.R index 27886895..85720e44 100644 --- a/R/id.R +++ b/R/id.R @@ -135,8 +135,14 @@ id.tbl_dbi <- function(db_table, ...) { matches <- get_tables(dbplyr::remote_con(db_table), show_temporary = TRUE) %>% dplyr::filter(.data$table == !!table) + print("table_ident") + print(table_ident) + + print("table") + print(table) + print("matches:") - print(matches) + print(get_tables(dbplyr::remote_con(db_table), show_temporary = TRUE)) if (!is.null(schema)) matches <- dplyr::filter(matches, .data$schema == !!schema) if (!is.null(catalog)) matches <- dplyr::filter(matches, .data$catalog == !!catalog) From 02326f9f35a39f91b3838bf7c2caa1fcc9ff1652 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 11:59:22 +0200 Subject: [PATCH 077/129] fix id.tbl_dbi issue --- R/id.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/id.R b/R/id.R index 85720e44..08dbf170 100644 --- a/R/id.R +++ b/R/id.R @@ -114,6 +114,11 @@ id.tbl_dbi <- function(db_table, ...) { stop("Unknown table specification", call. = FALSE) } + # Unquote table names for Oracle backend + if (inherits(table_conn, "OracleJdbc")) { + components <- stringr::str_remove_all(components, '\"') + } + table <- purrr::pluck(components, 1) schema <- purrr::pluck(components, 2) catalog <- purrr::pluck(components, 3) From cfe5872a395e483372dd5e50210e2fa8e10187fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 12:11:08 +0200 Subject: [PATCH 078/129] revert debug id.tbl_dbi issue --- R/id.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/R/id.R b/R/id.R index 08dbf170..ceb59f5d 100644 --- a/R/id.R +++ b/R/id.R @@ -140,15 +140,6 @@ id.tbl_dbi <- function(db_table, ...) { matches <- get_tables(dbplyr::remote_con(db_table), show_temporary = TRUE) %>% dplyr::filter(.data$table == !!table) - print("table_ident") - print(table_ident) - - print("table") - print(table) - - print("matches:") - print(get_tables(dbplyr::remote_con(db_table), show_temporary = TRUE)) - if (!is.null(schema)) matches <- dplyr::filter(matches, .data$schema == !!schema) if (!is.null(catalog)) matches <- dplyr::filter(matches, .data$catalog == !!catalog) From eda332339ab14ba2bf953236059b2476520b9358 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Fri, 24 Oct 2025 12:31:02 +0200 Subject: [PATCH 079/129] debug type casting --- tests/testthat/setup.R | 53 ++++++++ tests/testthat/test-connection.R | 34 ----- tests/testthat/test-create_table.R | 98 -------------- tests/testthat/test-db_functions.R | 9 -- tests/testthat/test-digest_to_checksum.R | 59 -------- tests/testthat/test-get_schema.R | 130 ------------------ tests/testthat/test-get_table.R | 5 - tests/testthat/test-helpers.R | 63 --------- tests/testthat/test-id.R | 165 ----------------------- tests/testthat/test-schema_exists.R | 19 --- tests/testthat/test-table_exists.R | 111 --------------- 11 files changed, 53 insertions(+), 693 deletions(-) delete mode 100644 tests/testthat/test-connection.R delete mode 100644 tests/testthat/test-create_table.R delete mode 100644 tests/testthat/test-db_functions.R delete mode 100644 tests/testthat/test-digest_to_checksum.R delete mode 100644 tests/testthat/test-get_schema.R delete mode 100644 tests/testthat/test-helpers.R delete mode 100644 tests/testthat/test-id.R delete mode 100644 tests/testthat/test-schema_exists.R delete mode 100644 tests/testthat/test-table_exists.R diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 8ac12e80..93934d64 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -74,6 +74,59 @@ for (conn in get_test_conns()) { analyze = FALSE ) + dplyr::copy_to( + conn, + mtcars %>% + dplyr::mutate(name = rownames(mtcars)) %>% + digest_to_checksum() %>% + dplyr::mutate( + from_ts = as.POSIXct("2020-01-01 09:00:00"), + until_ts = as.POSIXct(NA) + ), + name = id("MTCARS", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + print('dplyr::show_query(get_table(conn, "MTCARS"))') + print(dplyr::show_query(get_table(conn, "MTCARS"))) + + print('get_table(conn, "MTCARS")') + print(get_table(conn, "MTCARS")) + + print('dplyr::collect(get_table(conn, "MTCARS"))') + print(dplyr::collect(get_table(conn, "MTCARS"))) + + f <- getMethod("dbGetQuery", signature(conn="JDBCConnection", statement="character"))@.Data + print('f("SELECT * FROM FROM MTCARS)') + print(f(conn@jdbc_conn, "SELECT * FROM MTCARS")) + print(tibble::as_tibble(f(conn@jdbc_conn, "SELECT * FROM MTCARS"))) + + query <- paste( + "SELECT column_name, data_type, data_length, data_precision, data_scale, nullable", + "FROM ALL_TAB_COLUMNS", + "WHERE table_name = 'MTCARS'" + ) + print(f(conn@jdbc_conn, query)) + + + + + sql <- DBI::SQL("SELECT * FROM MTCARS") + + res <- DBI::dbSendQuery(conn, sql) + print("class(res)") + print(class(res)) + + print("dbFetch") + f <- DBI::dbFetch(res, n = Inf) + print(f) + + print(tibble::tibble(f)) + + print("??") + DBI::dbDisconnect(conn) } diff --git a/tests/testthat/test-connection.R b/tests/testthat/test-connection.R deleted file mode 100644 index 4fc2094c..00000000 --- a/tests/testthat/test-connection.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("get_connection() works", { - for (conn in get_test_conns()) { - expect_true(DBI::dbIsValid(conn)) - - connection_clean_up(conn) - } -}) - - -test_that("get_connection() notifies if connection fails", { - skip_if_not_installed("RSQLite") - - for (i in 1:100) { - random_string <- paste(sample(letters, size = 32, replace = TRUE), collapse = "") - - if (dir.exists(random_string)) next - - expect_error( - get_connection(drv = RSQLite::SQLite(), dbname = file.path(random_string, "/invalid_path")), - regexp = "checkmate::check_path_for_output\\(dbname\\)" - ) - } -}) - - -test_that("close_connection() works", { - for (conn in get_test_conns()) { - - # Check that we can close the connection - expect_true(DBI::dbIsValid(conn)) - close_connection(conn) - expect_false(DBI::dbIsValid(conn)) - } -}) diff --git a/tests/testthat/test-create_table.R b/tests/testthat/test-create_table.R deleted file mode 100644 index 3471ada3..00000000 --- a/tests/testthat/test-create_table.R +++ /dev/null @@ -1,98 +0,0 @@ -test_that("create_table() refuses a historical table", { - expect_error( - cars %>% - dplyr::mutate(from_ts = NA) %>% - create_table(db_table = "fail.cars"), - "checksum/from_ts/until_ts column\\(s\\) already exist\\(s\\) in \\.data!" - ) -}) - - -test_that("create_table() can create temporary tables", { - for (conn in get_test_conns()) { - - table <- create_table(cars, db_table = unique_table_name(), conn = conn, temporary = TRUE) - - expect_identical(colnames(table), c(colnames(cars), "checksum", "from_ts", "until_ts")) - expect_identical( - dplyr::collect(dplyr::select(table, -tidyselect::all_of(c("checksum", "from_ts", "until_ts")))), - dplyr::collect(dplyr::copy_to(conn, cars, unique_table_name()) %>% utils::head(0)) - ) - - connection_clean_up(conn) - } -}) - - -test_that("create_table() can create tables in default schema", { - for (conn in get_test_conns()) { - - table <- create_table(cars, db_table = unique_table_name(), conn = conn, temporary = FALSE) - defer_db_cleanup(table) - - expect_identical(colnames(table), c(colnames(cars), "checksum", "from_ts", "until_ts")) - expect_identical( - dplyr::collect(dplyr::select(table, -tidyselect::all_of(c("checksum", "from_ts", "until_ts")))), - dplyr::collect(dplyr::copy_to(conn, cars, unique_table_name()) %>% utils::head(0)) - ) - - connection_clean_up(conn) - } -}) - - -test_that("create_table() can create tables in non default schema", { - for (conn in get_test_conns()) { - - table <- create_table( - cars, db_table = id(paste0("test.", unique_table_name()), conn), conn = conn, temporary = FALSE - ) - defer_db_cleanup(table) - - expect_identical(colnames(table), c(colnames(cars), "checksum", "from_ts", "until_ts")) - expect_identical( - dplyr::collect(dplyr::select(table, -tidyselect::all_of(c("checksum", "from_ts", "until_ts")))), - dplyr::collect(dplyr::copy_to(conn, cars, unique_table_name()) %>% utils::head(0)) - ) - - connection_clean_up(conn) - } -}) - - -test_that("create_table() works with no conn", { - table <- create_table(cars, db_table = unique_table_name(), conn = NULL) - - expect_identical(colnames(table), c(colnames(cars), "checksum", "from_ts", "until_ts")) - expect_identical( - dplyr::select(table, -tidyselect::all_of(c("checksum", "from_ts", "until_ts"))), - cars %>% utils::head(0) - ) -}) - - -test_that("create_table() does not overwrite tables", { - for (conn in get_test_conns()) { - - table_name <- unique_table_name() - table <- create_table(cars, db_table = table_name, conn = conn, temporary = TRUE) - - table_regex <- paste( - paste(c(get_catalog(conn, temporary = TRUE), get_schema(conn, temporary = TRUE)), collapse = "."), - paste0("#?", table_name), - sep = "." - ) - - expect_error( - create_table(iris, db_table = table_name, conn = conn, temporary = TRUE), - regexp = paste("Table", table_regex, "already exists!") - ) - - expect_identical( - dplyr::collect(dplyr::select(table, -tidyselect::all_of(c("checksum", "from_ts", "until_ts")))), - dplyr::collect(dplyr::copy_to(conn, cars, unique_table_name()) %>% utils::head(0)) - ) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-db_functions.R b/tests/testthat/test-db_functions.R deleted file mode 100644 index afa393de..00000000 --- a/tests/testthat/test-db_functions.R +++ /dev/null @@ -1,9 +0,0 @@ -test_that("is.historical() works", { - for (conn in get_test_conns()) { - - expect_true(is.historical(dplyr::tbl(conn, id("__mtcars_historical", conn)))) - expect_false(is.historical(dplyr::tbl(conn, id("__mtcars", conn)))) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-digest_to_checksum.R b/tests/testthat/test-digest_to_checksum.R deleted file mode 100644 index 358785c5..00000000 --- a/tests/testthat/test-digest_to_checksum.R +++ /dev/null @@ -1,59 +0,0 @@ -test_that("digest_to_checksum() works", { - for (conn in get_test_conns()) { - - expect_s3_class(mtcars %>% digest_to_checksum(), "data.frame") - expect_s3_class(mtcars %>% tibble::as_tibble() %>% digest_to_checksum(), "tbl_df") - expect_s3_class(get_table(conn, "__mtcars") %>% digest_to_checksum(), "tbl_dbi") - - # Check that col argument works - expect_identical( - mtcars %>% digest_to_checksum(col = "checky") %>% dplyr::pull("checky"), - mtcars %>% digest_to_checksum() %>% dplyr::pull("checksum") - ) - - - expect_identical( - mtcars %>% dplyr::mutate(name = rownames(mtcars)) %>% digest_to_checksum() %>% colnames(), - get_table(conn, "__mtcars") %>% digest_to_checksum() %>% colnames() - ) - - - # Check that NA's generate unique checksums - x <- data.frame(col1 = c("A", NA), - col2 = c(NA, "A")) - - # .. locally - checksums <- x %>% digest_to_checksum() %>% dplyr::pull("checksum") - expect_false(checksums[1] == checksums[2]) - - # .. and on the remote - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) - - checksums <- x %>% digest_to_checksum() %>% dplyr::pull("checksum") - expect_false(checksums[1] == checksums[2]) - - connection_clean_up(conn) - } -}) - - -test_that("digest_to_checksum() warns works correctly when overwriting", { - for (conn in get_test_conns()) { - - checksum_vector_1 <- mtcars %>% - digest_to_checksum() %>% - dplyr::pull(checksum) - - expect_warning( - checksum_vector_2 <- mtcars %>% # nolint: implicit_assignment_linter - digest_to_checksum(col = "checksum") %>% - digest_to_checksum(col = "checksum") %>% - dplyr::pull(checksum), - "Column checksum already exists in data and will be overwritten!" - ) - - expect_identical(checksum_vector_1, checksum_vector_2) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-get_schema.R b/tests/testthat/test-get_schema.R deleted file mode 100644 index fa99269c..00000000 --- a/tests/testthat/test-get_schema.R +++ /dev/null @@ -1,130 +0,0 @@ -test_that("get_schema() and get_catalog() works for tbl_dbi", { - for (conn in get_test_conns()) { - - # Check for permanent tables in default schema - table <- dplyr::tbl(conn, "__mtcars") - expect_identical(get_schema(table), get_schema(conn)) - expect_identical(get_catalog(table), get_catalog(conn)) - - table_id_inferred <- DBI::Id( - catalog = get_catalog(table), - schema = get_schema(table), - table = "__mtcars" - ) - - expect_identical( - dplyr::collect(dplyr::tbl(conn, table_id_inferred)), - dplyr::collect(table) - ) - - - # Check for temporary tables - table_name <- unique_table_name() - table <- dplyr::copy_to(conn, mtcars, table_name, temporary = TRUE) - expect_identical(get_schema(table), get_schema(conn, temporary = TRUE)) - expect_identical(get_catalog(table), get_catalog(conn, temporary = TRUE)) - - table_id_inferred <- DBI::Id( - catalog = get_catalog(table), - schema = get_schema(table), - table = paste0(ifelse(inherits(conn, "Microsoft SQL Server"), "#", ""), table_name) - ) - - expect_identical( - dplyr::collect(dplyr::tbl(conn, table_id_inferred)), - dplyr::collect(table) - ) - - connection_clean_up(conn) - } -}) - - -test_that("get_schema() works for Id", { - expect_null(get_schema(DBI::Id(table = "table"))) - expect_identical(get_schema(DBI::Id(schema = "schema", table = "table")), "schema") -}) - - -test_that("get_catalog() works for Id", { - expect_null(get_catalog(DBI::Id(table = "table"))) - expect_identical(get_catalog(DBI::Id(catalog = "catalog", table = "table")), "catalog") -}) - - -test_that("get_schema() works for NULL", { - expect_null(get_schema(NULL)) -}) - - -test_that("get_catalog() works for NULL", { - expect_null(get_catalog(NULL)) -}) - - -for (conn in c(list(NULL), get_test_conns())) { - - if (is.null(conn)) { - test_that("get_schema() works for NULL connection", { - expect_null(get_schema(conn)) - expect_null(get_schema(conn, temporary = TRUE)) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("get_schema() works for SQLiteConnection", { - expect_identical(get_schema(conn), "main") - expect_identical(get_schema(conn, temporary = TRUE), "temp") - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("get_schema() works for PqConnection", { - expect_identical(get_schema(conn), "public") - checkmate::expect_character(get_schema(conn, temporary = TRUE), pattern = "^pg_temp_.*", len = 1) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("get_schema() works for Microsoft SQL Server", { - expect_identical(get_schema(conn), "dbo") - expect_identical(get_schema(conn, temporary = TRUE), "dbo") - }) - } - - if (!is.null(conn)) connection_clean_up(conn) -} - - -for (conn in c(list(NULL), get_test_conns())) { - - if (is.null(conn)) { - test_that("get_catalog() works for NULL connection", { - expect_null(get_catalog(conn)) - expect_null(get_catalog(conn, temporary = TRUE)) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("get_catalog() works for SQLiteConnection", { - expect_null(get_catalog(conn)) - expect_null(get_catalog(conn, temporary = TRUE)) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("get_catalog() works for PqConnection", { - expect_null(get_catalog(conn)) - expect_null(get_catalog(conn, temporary = TRUE)) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("get_catalog() works for Microsoft SQL Server", { - expect_identical(get_catalog(conn), "master") - expect_identical(get_catalog(conn, temporary = TRUE), "tempdb") - }) - } - - if (!is.null(conn)) connection_clean_up(conn) -} diff --git a/tests/testthat/test-get_table.R b/tests/testthat/test-get_table.R index 05f8fab4..c2bef1b5 100644 --- a/tests/testthat/test-get_table.R +++ b/tests/testthat/test-get_table.R @@ -14,11 +14,6 @@ test_that("get_table() returns list of tables if no table is requested", { test_that("get_table() works when tables/view exist", { for (conn in get_test_conns()) { - print('get_table(conn, "__mtcars")') - print(get_table(conn, "__mtcars")) - print('dplyr::collect(get_table(conn, "__mtcars"))') - print(dplyr::collect(get_table(conn, "__mtcars"))) - mtcars_t <- tibble::tibble(mtcars %>% dplyr::mutate(name = rownames(mtcars))) # Lets try different ways to read __mtcars (added during setup) diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R deleted file mode 100644 index b9d538b3..00000000 --- a/tests/testthat/test-helpers.R +++ /dev/null @@ -1,63 +0,0 @@ -test_that("nrow() works", { - for (conn in get_test_conns()) { - x <- get_table(conn, "__mtcars") - - expect_identical(nrow(x), as.integer(dplyr::pull(dplyr::count(x)))) - expect_identical(nrow(x), nrow(mtcars)) - - connection_clean_up(conn) - } -}) - - -test_that("defer_db_cleanup() works in function call", { - for (conn in get_test_conns()) { - name <- unique_table_name() - - test <- function() { - mt <- dplyr::copy_to(conn, mtcars, name, temporary = FALSE) - expect_true(DBI::dbExistsTable(conn, id(name, conn))) - - defer_db_cleanup(mt) - expect_true(DBI::dbExistsTable(conn, id(name, conn))) - } - - test() - - expect_false(DBI::dbExistsTable(conn, id(name, conn))) - - connection_clean_up(conn) - } -}) - - -test_that("defer_db_cleanup() works with withr::deferred_run", { - for (conn in get_test_conns()) { - mt <- dplyr::copy_to(conn, mtcars, unique_table_name()) - mt_id <- id(mt) - defer_db_cleanup(mt) - - expect_true(DBI::dbExistsTable(conn, mt_id)) - - expect_message(withr::deferred_run(), "Ran 1/1 deferred expressions") - - expect_false(DBI::dbExistsTable(conn, mt_id)) - - connection_clean_up(conn) - } -}) - - -test_that("unique_table_name() works", { - table_1 <- unique_table_name() - table_2 <- unique_table_name() - checkmate::expect_character(table_1, pattern = "SCDB_[a-zA-Z0-9]{10}") - checkmate::expect_character(table_2, pattern = "SCDB_[a-zA-Z0-9]{10}") - checkmate::expect_disjunct(table_1, table_2) - - table_1 <- unique_table_name("test") - table_2 <- unique_table_name("test") - checkmate::expect_character(table_1, pattern = "test_[a-zA-Z0-9]{10}") - checkmate::expect_character(table_2, pattern = "test_[a-zA-Z0-9]{10}") - checkmate::expect_disjunct(table_1, table_2) -}) diff --git a/tests/testthat/test-id.R b/tests/testthat/test-id.R deleted file mode 100644 index 4620acac..00000000 --- a/tests/testthat/test-id.R +++ /dev/null @@ -1,165 +0,0 @@ -test_that("id() works for character input without implied schema", { - for (conn in get_test_conns()) { - - # Without schema, we expect: - - # ... no change of no conn is given - expect_identical(id("test_mtcars"), DBI::Id(table = "test_mtcars")) - - # .. the defaults schema if conn is given - expect_identical( - id("test_mtcars", conn), - DBI::Id(catalog = get_catalog(conn), schema = SCDB::get_schema(conn), table = "test_mtcars") - ) - - connection_clean_up(conn) - } -}) - - -test_that("id() works for character input with implied schema", { - # With schema we expect the implied schema.table to be resolved: - - # ... when no conn is given, we naively assume schema.table holds true - expect_identical(id("test.mtcars"), DBI::Id(schema = "test", table = "mtcars")) - - - for (conn in get_test_conns()) { - - # ... when conn is given, we check if implied schema exists. - # NOTE: All testing connections should have the schema "test" (except SQLite without attached schemas) - # therefore, in almost all cases, we should resolve the schema correctly (except the SQLite case above) - if (inherits(conn, "SQLiteConnection") && !schema_exists(conn, "test")) { - expect_identical(id("test.mtcars", conn), DBI::Id(schema = "main", table = "test.mtcars")) - } else { - expect_identical(id("test.mtcars", conn), DBI::Id(catalog = get_catalog(conn), schema = "test", table = "mtcars")) - } - - connection_clean_up(conn) - } -}) - - -test_that("id() works for character input with implied schema when schema does not exist", { - for (conn in get_test_conns()) { - - # Generate schema that does not exist - k <- 0 - while (k < 100) { - invalid_schema_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") - k <- k + 1 - if (schema_exists(conn, invalid_schema_name)) next - break - } - - if (k < 100) { - - table_name <- paste(invalid_schema_name, "mtcars", sep = ".") - - # When schema does not exist and allow_table_only is TRUE, the schema should be the default schema - expect_identical( - id(table_name, conn = conn, allow_table_only = TRUE), - DBI::Id(catalog = get_catalog(conn), schema = get_schema(conn), table = table_name) - ) - - # When schema does not exist and allow_table_only is FALSE, the schema should be as implied - expect_identical( - id(table_name, conn = conn, allow_table_only = FALSE), - DBI::Id(catalog = get_catalog(conn), schema = invalid_schema_name, table = "mtcars") - ) - - } else { - warning("Non-existing schema could not be generated!", call. = FALSE) - } - - connection_clean_up(conn) - - # When connection is closed, the existence of the schema cannot be validated and an error should be given - expect_error(id(table_name, conn = conn), "DBI::dbIsValid\\(conn\\): FALSE") - } -}) - - -test_that("id() works for DBI::Id inputs", { - for (conn in get_test_conns()) { - - # When passing an Id without a schema, id should enrich the Id with the default schema - expect_identical( - id(DBI::Id(table = "mtcars"), conn), - DBI::Id(catalog = get_catalog(conn), schema = get_schema(conn), table = "mtcars") - ) - - connection_clean_up(conn) - } -}) - - -test_that("id() is consistent for tbl_dbi inputs", { - for (conn in get_test_conns()) { - - expectation <- id(dplyr::tbl(conn, id("test.mtcars", conn))) - - expect_identical( - expectation, - id.tbl_dbi(dplyr::tbl(conn, id("test.mtcars", conn))) - ) - - connection_clean_up(conn) - } -}) - - -test_that("id() is gives informative error for manipulated tbl_dbi inputs", { - for (conn in get_test_conns()) { - - expect_error( - id(dplyr::mutate(dplyr::tbl(conn, "__mtcars"), a = 2)), - "Table identification can only be determined if the lazy query is unmodified" - ) - - connection_clean_up(conn) - } -}) - - -test_that("id() works for data.frame inputs", { - for (conn in get_test_conns()) { - - # Output of get_tables should be parsable by id - db_table <- utils::head(get_tables(conn), 1) - - db_table_id <- expect_no_error(id(db_table)) - - # And it should have the corresponding fields, which we here check by comparing the string representations - expect_identical( - as.character(db_table_id), - paste(unlist(db_table), collapse = ".") - ) - - connection_clean_up(conn) - } -}) - - -test_that("as.character.id() works with implicit output", { - expect_identical(as.character(DBI::Id(table = "table")), "table") - expect_identical(as.character(DBI::Id(schema = "schema", table = "table")), "schema.table") - expect_identical(as.character(DBI::Id(catalog = "catalog", schema = "schema", table = "table")), - "catalog.schema.table") - - expect_identical(as.character(DBI::Id(table = "table", schema = "schema")), "schema.table") - expect_identical(as.character(DBI::Id(table = "table", schema = "schema", catalog = "catalog")), - "catalog.schema.table") -}) - - -test_that("as.character.id() works with explicit output", { - expect_identical(as.character(DBI::Id(table = "table"), explicit = TRUE), "\"table\"") - expect_identical(as.character(DBI::Id(schema = "schema", table = "table"), explicit = TRUE), "\"schema\".\"table\"") - expect_identical(as.character(DBI::Id(catalog = "catalog", schema = "schema", table = "table"), explicit = TRUE), - "\"catalog\".\"schema\".\"table\"") - - expect_identical(as.character(DBI::Id(table = "table", schema = "schema"), explicit = TRUE), "\"schema\".\"table\"") - expect_identical(as.character(DBI::Id(table = "table", schema = "schema", catalog = "catalog"), explicit = TRUE), - "\"catalog\".\"schema\".\"table\"") -}) diff --git a/tests/testthat/test-schema_exists.R b/tests/testthat/test-schema_exists.R deleted file mode 100644 index e05102bf..00000000 --- a/tests/testthat/test-schema_exists.R +++ /dev/null @@ -1,19 +0,0 @@ -test_that("schema_exists() works", { - conns <- get_test_conns() - for (conn_id in seq_along(conns)) { - - conn <- conns[[conn_id]] - - # Not all data bases support schemas. - # Here we filter out the data bases that do not support schema - # NOTE: SQLite does support schema, but we test both with and without attaching schemas - if (names(conns)[[conn_id]] != "SQLite") { - expect_true(schema_exists(conn, "test")) - - random_string <- paste(sample(c(letters, LETTERS), size = 16, replace = TRUE), collapse = "") - expect_false(schema_exists(conn, random_string)) - } - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-table_exists.R b/tests/testthat/test-table_exists.R deleted file mode 100644 index 3c835e47..00000000 --- a/tests/testthat/test-table_exists.R +++ /dev/null @@ -1,111 +0,0 @@ -test_that("table_exists() works for default schema", { - for (conn in get_test_conns()) { - - # Generate table in default schema that does not exist - k <- 0 - while (k < 100) { - invalid_table_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") - k <- k + 1 - if (DBI::dbExistsTable(conn, id(invalid_table_name, conn))) next - break - } - - if (k < 100) { - - # Without explicit schema, table_exists assumes default schema - expect_true(table_exists(conn, "__mtcars")) - expect_false(table_exists(conn, invalid_table_name)) - - expect_true(table_exists(conn, DBI::Id(table = "__mtcars"))) - expect_false(table_exists(conn, DBI::Id(table = invalid_table_name))) - - # Using the default schema should therefore yield the same results - expect_true(table_exists(conn, paste(get_schema(conn), "__mtcars", sep = "."))) - expect_false(table_exists(conn, paste(get_schema(conn), invalid_table_name, sep = "."))) - - expect_true(table_exists(conn, DBI::Id(schema = get_schema(conn), table = "__mtcars"))) - expect_false(table_exists(conn, DBI::Id(schema = get_schema(conn), table = invalid_table_name))) - - } else { - warning("Non-existing table in default schema could not be generated!", call. = FALSE) - } - - connection_clean_up(conn) - } -}) - - -test_that("table_exists() works for non-default schema", { - for (conn in get_test_conns()) { - - # Generate schema that does not exist - k <- 0 - while (k < 100) { - invalid_schema_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") - k <- k + 1 - if (schema_exists(conn, invalid_schema_name)) next - break - } - - if (k < 100) { - - # With an implied schema, table_exists should still determine existence correctly - - # Character inputs - expect_true(table_exists(conn, "test.mtcars")) - expect_false(table_exists(conn, paste(invalid_schema_name, "mtcars", sep = "."))) - - - # DBI::Id inputs - if (schema_exists(conn, "test")) { - expect_true(table_exists(conn, DBI::Id(schema = "test", table = "mtcars"))) - } else { - expect_false(table_exists(conn, DBI::Id(schema = "test", table = "mtcars"))) - } - expect_false(table_exists(conn, DBI::Id(schema = invalid_schema_name, table = "mtcars"))) - - } else { - warning("Non-existing schema could not be generated!", call. = FALSE) - } - - connection_clean_up(conn) - } -}) - - -test_that("table_exists() fails when multiple matches are found", { - for (conn in get_test_conns()) { - - # Not all data bases support schemas. - # Here we filter out the data bases that do not support schema - # NOTE: SQLite does support schema, but we test both with and without attaching schemas - if (schema_exists(conn, "test") && schema_exists(conn, "test.one")) { - - DBI::dbExecute(conn, 'CREATE TABLE "test"."one.two"(a TEXT)') - DBI::dbExecute(conn, 'CREATE TABLE "test.one"."two"(b TEXT)') - - expect_error( - table_exists(conn, "test.one.two"), - regex = "More than one table matching 'test.one.two' was found!" - ) - - } - - connection_clean_up(conn) - } -}) - - -test_that("table_exists() works when starting from empty", { - skip_if_not_installed("RSQLite") - - conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") - - expect_false(table_exists(conn, "mtcars")) - - dplyr::copy_to(conn, mtcars, "mtcars", temporary = FALSE) - - expect_true(table_exists(conn, "mtcars")) - - connection_clean_up(conn) -}) From 5afc9e3b11f97f39cad8f00fa932f8b93bfa3d1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Sat, 25 Oct 2025 12:32:52 +0200 Subject: [PATCH 080/129] map db_collect --- NAMESPACE | 1 + R/backend_oracle.R | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 95d5b79c..f48f8095 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,6 +66,7 @@ export(close_connection) export(create_index) export(create_logs_if_missing) export(create_table) +export(db_collect.OracleJdbc) export(db_timestamp) export(defer_db_cleanup) export(digest_to_checksum) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 37d9c2fb..282cc386 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -40,6 +40,12 @@ setClass("OracleJdbc", slots = list("jdbc_conn" = "JDBCConnection", "servername" # Additonal implementations # dbQuoteIdentifier # dbSendStatement +# dbCollect + +#' @export +db_collect.OracleJdbc <- function(con, sql, n = -1, ...) { + dbGetQuery(con, sql, n, ...) +} #' @importMethodsFrom DBI dbWriteTable From 59e0c488e9f4a5ba35d261b2439d7a29e6eafd23 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Sun, 26 Oct 2025 21:04:47 +0100 Subject: [PATCH 081/129] debug type casting --- tests/testthat/setup.R | 50 ++++++++++++++++++++++++++++-------------- 1 file changed, 34 insertions(+), 16 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 93934d64..ab02fc24 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -89,14 +89,6 @@ for (conn in get_test_conns()) { analyze = FALSE ) - print('dplyr::show_query(get_table(conn, "MTCARS"))') - print(dplyr::show_query(get_table(conn, "MTCARS"))) - - print('get_table(conn, "MTCARS")') - print(get_table(conn, "MTCARS")) - - print('dplyr::collect(get_table(conn, "MTCARS"))') - print(dplyr::collect(get_table(conn, "MTCARS"))) f <- getMethod("dbGetQuery", signature(conn="JDBCConnection", statement="character"))@.Data print('f("SELECT * FROM FROM MTCARS)') @@ -113,20 +105,46 @@ for (conn in get_test_conns()) { - sql <- DBI::SQL("SELECT * FROM MTCARS") + #sql <- DBI::SQL("SELECT * FROM MTCARS") - res <- DBI::dbSendQuery(conn, sql) - print("class(res)") - print(class(res)) + #res <- DBI::dbSendQuery(conn, sql) + #print("class(res)") + #print(class(res)) - print("dbFetch") - f <- DBI::dbFetch(res, n = Inf) - print(f) + #print("dbFetch") + #foo <- DBI::dbFetch(res, n = Inf) + #print(foo) - print(tibble::tibble(f)) + #print(tibble::tibble(foo)) print("??") + print("DBI::dbWriteTable(conn@jdbc_conn, \"MTCARS2\", mtcars)") + print(DBI::dbWriteTable(conn@jdbc_conn, "MTCARS2", mtcars)) + + query <- paste( + "SELECT column_name, data_type, data_length, data_precision, data_scale, nullable", + "FROM ALL_TAB_COLUMNS", + "WHERE table_name = 'MTCARS2'" + ) + print(f(conn@jdbc_conn, query)) + + foo <- DBI::dbReadTable(conn@jdbc_conn, "MTCARS2") + print(foo) + print(tibble::tibble(foo)) + + + res <- DBI::dbSendQuery(conn@jdbc_conn, "SELECT * FROM MTCARS2") + class("res") + class(res) + + cts <- purrr::map(1:11, ~ rJava::.jcall(res@md, "I", "getColumnType", .)) + print("cts") + print(cts) + + DBI::dbClearResult(res) + + DBI::dbDisconnect(conn) } From c6300761a4baf0527447ae38f6d8b1931ee7347d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Wed, 5 Nov 2025 13:23:04 +0100 Subject: [PATCH 082/129] debug: Add small workflow to check Oracla data-type issue --- .github/workflows/oracle-reprex.yaml | 255 +++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) create mode 100644 .github/workflows/oracle-reprex.yaml diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml new file mode 100644 index 00000000..9ea5799f --- /dev/null +++ b/.github/workflows/oracle-reprex.yaml @@ -0,0 +1,255 @@ +on: + push + + +jobs: + code-coverage-oracle: + name: "🧪 Tests: Oracle Database (Experimental)" + runs-on: ubuntu-latest + defaults: + run: + shell: bash + + services: + oracledb: + image: gvenzl/oracle-free:latest + env: + APP_USER: "github_ci" + APP_USER_PASSWORD: "github_ci" + ORACLE_PASSWORD: "github_ci" + ports: + - 1521:1521 + options: >- + --health-cmd healthcheck.sh + --health-interval 20s + --health-timeout 10s + --health-retries 10 + + env: + BACKEND: Oracle + BACKEND_DRV: RJDBC::JDBC + BACKEND_ARGS: '' + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - name: ⬇️ Checkout repo + uses: actions/checkout@v5 + with: + fetch-depth: 0 + persist-credentials: false + + - name: 🔧 Set environment variables + run: | + ORACLEHOST=localhost + + echo "ORACLEHOST=${ORACLEHOST}" >> $GITHUB_ENV + + CONN_ARGS_JSON="{ + \"Oracle\": { + \"driverClass\": \"oracle.jdbc.OracleDriver\", + \"classPath\": \"/usr/lib/oracle/ojdbc8.jar\", + \"url\": \"jdbc:oracle:thin:@${ORACLEHOST}:1521/FREEPDB1\", + \"user\": \"github_ci\", + \"password\": \"github_ci\" + } + }" + + echo "CONN_ARGS_JSON<> $GITHUB_ENV + echo $CONN_ARGS_JSON >> $GITHUB_ENV + echo "EOF" >> $GITHUB_ENV + + + - name: 🔧 Install Oracle JDBC driver + run: | + sudo apt-get update + # Create directory for the driver with sudo + sudo mkdir -p /usr/lib/oracle + + # Download the Oracle JDBC driver directly from Maven Central with sudo + sudo curl -o /usr/lib/oracle/ojdbc8.jar https://repo1.maven.org/maven2/com/oracle/database/jdbc/ojdbc8/21.5.0.0/ojdbc8-21.5.0.0.jar + + # Verify the driver was downloaded successfully + if sudo test -f "/usr/lib/oracle/ojdbc8.jar"; then + echo "Oracle JDBC driver downloaded successfully" + sudo ls -la /usr/lib/oracle/ + # Make the JAR file readable by everyone + sudo chmod 644 /usr/lib/oracle/ojdbc8.jar + else + echo "Failed to download Oracle JDBC driver" + exit 1 + fi + + - name: 🔧 Set up Oracle JDK + uses: actions/setup-java@v5 + with: + distribution: oracle + java-version: 25 + + - name: 🔧 Setup R + uses: r-lib/actions/setup-r@v2 + with: + r-version: 'release' + use-public-rspm: true + + - name: 🔧 Install R dependencies + uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: | + local::. + any::pak + any::jsonlite + any::rcmdcheck + any::devtools + any::lintr + any::covr + any::roxygen2 + any::pkgdown + any::rmarkdown + any::styler + needs: build, check, coverage, roxygen2, lint, website + + - name: 🔧 Configure Java for R + run: | + # Create .Rprofile to automatically set Java classpath + echo 'Sys.setenv(JAVA_HOME = Sys.getenv("JAVA_HOME"))' > ~/.Rprofile + echo 'Sys.setenv(CLASSPATH = "/usr/lib/oracle/ojdbc8.jar")' >> ~/.Rprofile + + # Test the JDBC connection + Rscript -e ' + library(RJDBC) + + # Print Java version and classpath to debug + print(system("java -version", intern = TRUE)) + print(Sys.getenv("CLASSPATH")) + print(Sys.getenv("JAVA_HOME")) + + # Initialize the Oracle driver explicitly + drv <- JDBC("oracle.jdbc.OracleDriver", "/usr/lib/oracle/ojdbc8.jar") + print("JDBC driver initialized successfully") + + # Try to connect + conn <- tryCatch({ + dbConnect( + drv, + "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", + "github_ci", + "github_ci" + ) + }, error = function(e) { + print(paste("Connection error:", e$message)) + NULL + }) + + if (!is.null(conn)) { + print("Successfully connected to Oracle!") + } + + data <- dplyr::rename_with(iris, ~ toupper(gsub(".", "_", .x, fixed = TRUE))) + + DBI::dbWriteTable(conn, "IRIS", data) + + print(tibble::tibble(DBI::dbReadTable(conn, "IRIS"))) + + print(tibble::tibble(DBI::dbReadTable(conn, "IRIS", lossy = TRUE))) + + print(DBI::dbGetQuery(conn, "select dump(4+4) from dual;")) + + print(DBI::dbGetQuery(conn, paste0("SELECT * FROM IRIS"))) + + r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) + print(class(r)) + + out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=TRUE, tz="", posix.ts=TRUE) + print(tibble::tibble(out)) + DBI::dbClearResult(r) + + r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) + out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=FALSE, tz="", posix.ts=TRUE) + print(tibble::tibble(out)) + DBI::dbClearResult(r) + + res <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) + print(class(res)) + + + block <- 2048L + use.label <- TRUE + lossy <- TRUE + tz <- "" + posix.ts=TRUE + + getColumnLabel <- "getColumnLabel" + cols <- rJava::.jcall(res@md, "I", "getColumnCount") + block <- as.integer(block) + if (length(block) != 1L) stop("invalid block size") + if (cols < 1L) return(NULL) + l <- vector("list", cols) + cts <- rep(0L, cols) ## column type (as per JDBC) + rts <- rep(0L, cols) ## retrieval types (0 = string, 1 = double, 2 = integer, 3 = POSIXct) + for (i in 1:cols) { + ## possible retrieval: + ## getDouble(), getTimestamp() and getString() + ## [NOTE: getBigDecimal() is native for all numeric() types] + ## could cehck java.sql.Timestamp which has .getTime() in millis + cts[i] <- ct <- rJava::.jcall(res@md, "I", "getColumnType", i) + l[[i]] <- character() + ## NOTE: this is also needed in dbColumnInfo() - see also JDBC.types + ## -7 BIT, -6 TINYINT, 5 SMALLINT, 4 INTEGER, -5 BIGINT + ## 6 FLOAT, 7 REAL, 8 DOUBLE, 2 NUMERIC, 3 DECIMAL + ## 1 CHAR, 12 VARCHAR, -1 LONGVARCHAR + ## 91 DATE, 92 TIME, 93 TIMESTAMP + ## -2 BINARY, -3 VARBINARY, -4 LONGVARBINARY + ## 0 NULL, 1111 OTHER, 2000 JAVA_OBJECT + ## 16 BOOLEAN, 1.8+: 2013 TIME_WITH_TIMEZONE, + ## 2014 TIMESTAMP_WITH_TIMEZONE + ## + ## integer-compatible typse + if (ct == 4L || ct == 5L || ct == -6L) { + l[[i]] <- integer() + rts[i] <- 2L + } else if (ct == -5L | (ct >= 2L & ct <= 8L)) { ## BIGINT and various float/num types + ## some numeric types may exceed double precision (see #83) + ## those must be retrieved as strings + ## + ## check precision for NUMERIC/DECIMAL + cp <- switch(as.character(ct), + `2` =, `3` = rJava::.jcall(res@md, "I", "getPrecision", i), + `-5`= 20L, ## BIGINT + 0L) + + print("cp") + print(cp) + print("isTRUE(lossy)") + print(isTRUE(lossy)) + print("cp <= 15") + print(cp <= 15) + if (cp <= 15 || isTRUE(lossy)) { ## safe to retrieve + l[[i]] <- numeric() + rts[i] <- 1L + } + } else if (ct >= 91L && ct <= 93L && isTRUE(posix.ts)) { ## DATE/TIME/TS + l[[i]] <- .POSIXct(numeric(), tz) + rts[i] <- 3L + } else if (ct == -7L) { ## BIT + l[[i]] <- logical() + rts[i] <- 4L + } + names(l)[i] <- rJava::.jcall(res@md, "S", getColumnLabel, i) + + print(".jcall(res@md, \"I\", \"getPrecision\", i)") + print(rJava::.jcall(res@md, "I", "getPrecision", i)) + } + + + print("cts") + print(cts) + + print("rts") + print(rts) + + print("l") + print(l) + + + dbDisconnect(conn) + ' From 7e7f831087d4edfad1c6bf8c0fc664be1b3fd47d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Wed, 5 Nov 2025 21:24:33 +0000 Subject: [PATCH 083/129] fix(OracleJdbc): Set the "lossy" option to `TRUE` --- R/backend_oracle.R | 10 +++++++++- R/connection.R | 3 ++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 282cc386..9c4b57d4 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -2,7 +2,15 @@ #' @importClassesFrom RJDBC JDBCConnection #' @importClassesFrom odbc Oracle -setClass("OracleJdbc", slots = list("jdbc_conn" = "JDBCConnection", "servername" = "character"), contains = "Oracle") +setClass( + "OracleJdbc", + slots = list( + "jdbc_conn" = "JDBCConnection", + "servername" = "character", + "options" = "list" + ), + contains = "Oracle" +) # DBI methods defined in RJDBC package diff --git a/R/connection.R b/R/connection.R index 140247e8..805184b7 100644 --- a/R/connection.R +++ b/R/connection.R @@ -263,7 +263,8 @@ get_connection.JDBCDriver <- function( conn <- new( "OracleJdbc", jdbc_conn = conn, - servername = url + servername = url, + options = list("fetch.lossy" = TRUE) ) return(conn) From 7bdf33537d1ef2da24bf79f98adfb44cde1a58e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Wed, 5 Nov 2025 21:38:07 +0000 Subject: [PATCH 084/129] fix(all-workflows): Remove duplicated "backend_exclude" --- .github/workflows/all-workflows.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/all-workflows.yaml b/.github/workflows/all-workflows.yaml index d6feafaa..98d955f1 100644 --- a/.github/workflows/all-workflows.yaml +++ b/.github/workflows/all-workflows.yaml @@ -31,7 +31,6 @@ jobs: # We pass information about the triggering event event_name: ${{ github.event_name }} run_id: ${{ github.run_id }} - backend_exclude: oracle # code-coverage creates data bases for the tests. Here you can specify the schemas you need for the workflow backend_exclude: sqlite,duckdb,postgres,mssql From 0d857054d47e718c6401c439fbfc877533bef0ee Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 08:40:41 +1100 Subject: [PATCH 085/129] chore: Update pak.lock --- pak.lock | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 79 insertions(+), 4 deletions(-) diff --git a/pak.lock b/pak.lock index 415bbfc9..85b2c12e 100644 --- a/pak.lock +++ b/pak.lock @@ -2326,7 +2326,7 @@ "ref": "local::.", "binary": false, "dep_types": ["Depends", "Imports", "LinkingTo", "Suggests"], - "dependencies": ["checkmate", "DBI", "dbplyr", "dplyr", "glue", "openssl", "parallelly", "purrr", "rlang", "R6", "stringr", "tidyr", "tidyselect", "magrittr"], + "dependencies": ["checkmate", "DBI", "dbplyr", "dplyr", "glue", "openssl", "parallelly", "purrr", "rJava", "RJDBC", "rlang", "R6", "stringr", "tidyr", "tidyselect", "magrittr"], "direct": true, "directpkg": true, "install_args": "", @@ -3566,6 +3566,81 @@ "version": "1.2.1", "vignettes": false }, + { + "ref": "rJava", + "binary": true, + "dep_types": ["Depends", "Imports", "LinkingTo"], + "dependencies": [], + "direct": false, + "directpkg": false, + "install_args": "", + "license": "LGPL-2.1", + "metadata": { + "RemotePkgRef": "rJava", + "RemoteType": "standard", + "RemoteRef": "rJava", + "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", + "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", + "RemoteSha": "1.0-11" + }, + "needscompilation": false, + "package": "rJava", + "params": [], + "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", + "repotype": "cran", + "rversion": "4.5", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/rJava_1.0-11.tar.gz", + "sysreqs": "Java JDK 1.2 or higher (for JRI/REngine JDK 1.4 or\n higher), GNU make", + "sysreqs_packages": [ + { + "sysreq": "gnumake", + "packages": "make", + "pre_install": {}, + "post_install": {} + }, + { + "sysreq": "java", + "packages": "default-jdk", + "pre_install": {}, + "post_install": "R CMD javareconf" + } + ], + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/rJava_1.0-11.tar.gz", + "type": "standard", + "version": "1.0-11", + "vignettes": false + }, + { + "ref": "RJDBC", + "binary": true, + "dep_types": ["Depends", "Imports", "LinkingTo"], + "dependencies": ["DBI", "rJava"], + "direct": false, + "directpkg": false, + "install_args": "", + "license": "MIT + file LICENSE", + "metadata": { + "RemotePkgRef": "RJDBC", + "RemoteType": "standard", + "RemoteRef": "RJDBC", + "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", + "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", + "RemoteSha": "0.2-10" + }, + "needscompilation": false, + "package": "RJDBC", + "params": [], + "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", + "repotype": "cran", + "rversion": "4.5", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/RJDBC_0.2-10.tar.gz", + "sysreqs": "", + "sysreqs_packages": {}, + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/RJDBC_0.2-10.tar.gz", + "type": "standard", + "version": "0.2-10", + "vignettes": false + }, { "ref": "rlang", "binary": true, @@ -5097,8 +5172,8 @@ "version": "24.04", "url": {}, "pre_install": "apt-get -y update", - "install_scripts": "apt-get -y install libx11-dev git libcurl4-openssl-dev libssl-dev xz-utils make libgit2-dev zlib1g-dev pandoc unixodbc-dev libfreetype6-dev libjpeg-dev libpng-dev libtiff-dev libwebp-dev libpq-dev libicu-dev libfontconfig1-dev libfribidi-dev libharfbuzz-dev libxml2-dev", - "post_install": {}, - "packages": ["libx11-dev", "git", "libcurl4-openssl-dev", "libssl-dev", "xz-utils", "make", "libgit2-dev", "zlib1g-dev", "pandoc", "unixodbc-dev", "libfreetype6-dev", "libjpeg-dev", "libpng-dev", "libtiff-dev", "libwebp-dev", "libpq-dev", "libicu-dev", "libfontconfig1-dev", "libfribidi-dev", "libharfbuzz-dev", "libxml2-dev"] + "install_scripts": "apt-get -y install libx11-dev git libcurl4-openssl-dev libssl-dev xz-utils make libgit2-dev zlib1g-dev pandoc unixodbc-dev libfreetype6-dev libjpeg-dev libpng-dev libtiff-dev libwebp-dev default-jdk libpq-dev libicu-dev libfontconfig1-dev libfribidi-dev libharfbuzz-dev libxml2-dev", + "post_install": "R CMD javareconf", + "packages": ["libx11-dev", "git", "libcurl4-openssl-dev", "libssl-dev", "xz-utils", "make", "libgit2-dev", "zlib1g-dev", "pandoc", "unixodbc-dev", "libfreetype6-dev", "libjpeg-dev", "libpng-dev", "libtiff-dev", "libwebp-dev", "default-jdk", "libpq-dev", "libicu-dev", "libfontconfig1-dev", "libfribidi-dev", "libharfbuzz-dev", "libxml2-dev"] } } From 933f8828b2af8a6cb12335e26b63eaa6f825c85d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 07:54:16 +0000 Subject: [PATCH 086/129] debug: Add small workflow to check Oracla data-type issue --- .github/workflows/oracle-reprex.yaml | 41 ++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 9ea5799f..300907d2 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -250,6 +250,47 @@ jobs: print("l") print(l) + rp <- res@env$pull + if (is.jnull(rp)) { + rp <- rJava::.jnew("info/urbanek/Rpackage/RJDBC/JDBCResultPull", rJava::.jcast(res@jr, "java/sql/ResultSet"), rJava::.jarray(as.integer(rts))) + res@env$pull <- rp + } + print("rp") + print(rp) + + ret.fn <- list( ## retrieval functions for the different types + function(i) rJava::.jcall(rp, "[Ljava/lang/String;", "getStrings", i), + function(i) rJava::.jcall(rp, "[D", "getDoubles", i), + function(i) rJava::.jcall(rp, "[I", "getIntegers", i), + function(i) rJava::.jcall(rp, "[D", "getDoubles", i), + function(i) as.logical(rJava::.jcall(rp, "[I", "getIntegers", i))) + + if (n < 0L) { ## infinite pull - collect (using pairlists) & join + stride <- 32768L ## start fairly small to support tiny queries and increase later + while ((nrec <- rJava::.jcall(rp, "I", "fetch", stride, block)) > 0L) { + for (i in seq.int(cols)) + l[[i]] <- pairlist(l[[i]], ret.fn[[rts[i] + 1L]](i)) + if (nrec < stride) break + stride <- 524288L # 512k + } + for (i in seq.int(cols)) l[[i]] <- unlist(l[[i]], TRUE, FALSE) + } else { + nrec <- rJava::.jcall(rp, "I", "fetch", as.integer(n), block) + for (i in seq.int(cols)) l[[i]] <- ret.fn[[rts[i] + 1L]](i) + } + + print("l") + print(l) + + + ## unlisting can strip attrs so do POSIXct at the end for TSs + ts.col <- rts == 3L + if (any(ts.col)) for (i in which(ts.col)) l[[i]] <- .POSIXct(l[[i]], tz) + # as.data.frame is expensive - create it on the fly from the list + attr(l, "row.names") <- c(NA_integer_, length(l[[1]])) + class(l) <- "data.frame" + #.remap.types(l, cts) + dbDisconnect(conn) ' From 0ad18f4379b3a641bd2ff04905592618913192ff Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 18:55:51 +1100 Subject: [PATCH 087/129] chore: Update pak.lock --- pak.lock | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/pak.lock b/pak.lock index 85b2c12e..8c844e46 100644 --- a/pak.lock +++ b/pak.lock @@ -3102,7 +3102,7 @@ "RemoteRef": "purrr", "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", - "RemoteSha": "1.1.0" + "RemoteSha": "1.2.0" }, "needscompilation": false, "package": "purrr", @@ -3110,12 +3110,12 @@ "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", "repotype": "cran", "rversion": "4.5", - "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/purrr_1.1.0.tar.gz", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/purrr_1.2.0.tar.gz", "sysreqs": "", "sysreqs_packages": {}, - "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/purrr_1.1.0.tar.gz", + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/purrr_1.2.0.tar.gz", "type": "standard", - "version": "1.1.0", + "version": "1.2.0", "vignettes": false }, { @@ -4242,7 +4242,7 @@ "RemoteRef": "stringr", "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", - "RemoteSha": "1.5.2" + "RemoteSha": "1.6.0" }, "needscompilation": false, "package": "stringr", @@ -4250,12 +4250,12 @@ "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", "repotype": "cran", "rversion": "4.5", - "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/stringr_1.5.2.tar.gz", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/stringr_1.6.0.tar.gz", "sysreqs": "", "sysreqs_packages": {}, - "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/stringr_1.5.2.tar.gz", + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/stringr_1.6.0.tar.gz", "type": "standard", - "version": "1.5.2", + "version": "1.6.0", "vignettes": false }, { From ce7fab66ebc80b99105cc1ae6fb9b311467454f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 08:02:28 +0000 Subject: [PATCH 088/129] debug: Add small workflow to check Oracla data-type issue --- .github/workflows/oracle-reprex.yaml | 150 ++++----------------------- 1 file changed, 23 insertions(+), 127 deletions(-) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 300907d2..0072fa0c 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -150,147 +150,43 @@ jobs: print(tibble::tibble(DBI::dbReadTable(conn, "IRIS"))) - print(tibble::tibble(DBI::dbReadTable(conn, "IRIS", lossy = TRUE))) - - print(DBI::dbGetQuery(conn, "select dump(4+4) from dual;")) - - print(DBI::dbGetQuery(conn, paste0("SELECT * FROM IRIS"))) r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) - print(class(r)) - out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=TRUE, tz="", posix.ts=TRUE) print(tibble::tibble(out)) DBI::dbClearResult(r) - r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) - out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=FALSE, tz="", posix.ts=TRUE) - print(tibble::tibble(out)) - DBI::dbClearResult(r) - - res <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) - print(class(res)) - - - block <- 2048L - use.label <- TRUE - lossy <- TRUE - tz <- "" - posix.ts=TRUE - - getColumnLabel <- "getColumnLabel" - cols <- rJava::.jcall(res@md, "I", "getColumnCount") - block <- as.integer(block) - if (length(block) != 1L) stop("invalid block size") - if (cols < 1L) return(NULL) - l <- vector("list", cols) - cts <- rep(0L, cols) ## column type (as per JDBC) - rts <- rep(0L, cols) ## retrieval types (0 = string, 1 = double, 2 = integer, 3 = POSIXct) - for (i in 1:cols) { - ## possible retrieval: - ## getDouble(), getTimestamp() and getString() - ## [NOTE: getBigDecimal() is native for all numeric() types] - ## could cehck java.sql.Timestamp which has .getTime() in millis - cts[i] <- ct <- rJava::.jcall(res@md, "I", "getColumnType", i) - l[[i]] <- character() - ## NOTE: this is also needed in dbColumnInfo() - see also JDBC.types - ## -7 BIT, -6 TINYINT, 5 SMALLINT, 4 INTEGER, -5 BIGINT - ## 6 FLOAT, 7 REAL, 8 DOUBLE, 2 NUMERIC, 3 DECIMAL - ## 1 CHAR, 12 VARCHAR, -1 LONGVARCHAR - ## 91 DATE, 92 TIME, 93 TIMESTAMP - ## -2 BINARY, -3 VARBINARY, -4 LONGVARBINARY - ## 0 NULL, 1111 OTHER, 2000 JAVA_OBJECT - ## 16 BOOLEAN, 1.8+: 2013 TIME_WITH_TIMEZONE, - ## 2014 TIMESTAMP_WITH_TIMEZONE - ## - ## integer-compatible typse - if (ct == 4L || ct == 5L || ct == -6L) { - l[[i]] <- integer() - rts[i] <- 2L - } else if (ct == -5L | (ct >= 2L & ct <= 8L)) { ## BIGINT and various float/num types - ## some numeric types may exceed double precision (see #83) - ## those must be retrieved as strings - ## - ## check precision for NUMERIC/DECIMAL - cp <- switch(as.character(ct), - `2` =, `3` = rJava::.jcall(res@md, "I", "getPrecision", i), - `-5`= 20L, ## BIGINT - 0L) - - print("cp") - print(cp) - print("isTRUE(lossy)") - print(isTRUE(lossy)) - print("cp <= 15") - print(cp <= 15) - if (cp <= 15 || isTRUE(lossy)) { ## safe to retrieve - l[[i]] <- numeric() - rts[i] <- 1L - } - } else if (ct >= 91L && ct <= 93L && isTRUE(posix.ts)) { ## DATE/TIME/TS - l[[i]] <- .POSIXct(numeric(), tz) - rts[i] <- 3L - } else if (ct == -7L) { ## BIT - l[[i]] <- logical() - rts[i] <- 4L - } - names(l)[i] <- rJava::.jcall(res@md, "S", getColumnLabel, i) - - print(".jcall(res@md, \"I\", \"getPrecision\", i)") - print(rJava::.jcall(res@md, "I", "getPrecision", i)) - } - - - print("cts") - print(cts) + dbDisconnect(conn) - print("rts") - print(rts) - print("l") - print(l) + devtools::load_all() + # Try to connect + conn <- tryCatch({ + get_connection( + drv, + "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", + "github_ci", + "github_ci" + ) + }, error = function(e) { + print(paste("Connection error:", e$message)) + NULL + }) - rp <- res@env$pull - if (is.jnull(rp)) { - rp <- rJava::.jnew("info/urbanek/Rpackage/RJDBC/JDBCResultPull", rJava::.jcast(res@jr, "java/sql/ResultSet"), rJava::.jarray(as.integer(rts))) - res@env$pull <- rp - } - print("rp") - print(rp) - - ret.fn <- list( ## retrieval functions for the different types - function(i) rJava::.jcall(rp, "[Ljava/lang/String;", "getStrings", i), - function(i) rJava::.jcall(rp, "[D", "getDoubles", i), - function(i) rJava::.jcall(rp, "[I", "getIntegers", i), - function(i) rJava::.jcall(rp, "[D", "getDoubles", i), - function(i) as.logical(rJava::.jcall(rp, "[I", "getIntegers", i))) - - if (n < 0L) { ## infinite pull - collect (using pairlists) & join - stride <- 32768L ## start fairly small to support tiny queries and increase later - while ((nrec <- rJava::.jcall(rp, "I", "fetch", stride, block)) > 0L) { - for (i in seq.int(cols)) - l[[i]] <- pairlist(l[[i]], ret.fn[[rts[i] + 1L]](i)) - if (nrec < stride) break - stride <- 524288L # 512k - } - for (i in seq.int(cols)) l[[i]] <- unlist(l[[i]], TRUE, FALSE) - } else { - nrec <- rJava::.jcall(rp, "I", "fetch", as.integer(n), block) - for (i in seq.int(cols)) l[[i]] <- ret.fn[[rts[i] + 1L]](i) + if (!is.null(conn)) { + print("Successfully connected to Oracle!") } - print("l") - print(l) + data <- dplyr::rename_with(mtcars, ~ toupper(gsub(".", "_", .x, fixed = TRUE))) + DBI::dbWriteTable(conn, "MTCARS", data) - ## unlisting can strip attrs so do POSIXct at the end for TSs - ts.col <- rts == 3L - if (any(ts.col)) for (i in which(ts.col)) l[[i]] <- .POSIXct(l[[i]], tz) - # as.data.frame is expensive - create it on the fly from the list - attr(l, "row.names") <- c(NA_integer_, length(l[[1]])) - class(l) <- "data.frame" - #.remap.types(l, cts) + print(tibble::tibble(DBI::dbReadTable(conn, "MTCARS"))) + r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM MTCARS")) + out <- RJDBC::fetch(r) + print(tibble::tibble(out)) + DBI::dbClearResult(r) dbDisconnect(conn) ' From 8216c1a8e1072c78f3fef1ddf6ba9ca0409b2c2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 10:10:20 +0000 Subject: [PATCH 089/129] feat(dbFetch): Add Oracle implementation --- NAMESPACE | 1 + R/backend_oracle.R | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index f48f8095..b5b8d242 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -111,6 +111,7 @@ importFrom(rlang,.data) importMethodsFrom(DBI,dbBegin) importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) +importMethodsFrom(DBI,dbFetch) importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbIsValid) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 9c4b57d4..adbb76de 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -296,3 +296,16 @@ setMethod( DBI::dbSendQuery(conn@jdbc_conn, statement, ...) } ) + +#' @importMethodsFrom DBI dbFetch +#' @exportMethod dbFetch +setMethod( + "dbFetch", + signature( + res = "JDBCResult", + n = "numeric" + ), + function(res, n, ...) { + RJDBC::fetch(res, n, ...) + } +) From c9d147bd1fe3430f31cafd084c2cefc5822b5625 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 10:10:38 +0000 Subject: [PATCH 090/129] debug: Add small workflow to check Oracla data-type issu --- .github/workflows/oracle-reprex.yaml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 0072fa0c..514a1f6e 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -152,6 +152,13 @@ jobs: r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) + + print("RJDBC::dbOption(conn, \"fetch.lossy\", \"?\")") + print(RJDBC::dbOption(conn, "fetch.lossy", "?")) + + print("RJDBC::dbOption(r, \"fetch.lossy\", \"?\")") + print(RJDBC::dbOption(r, "fetch.lossy", "?")) + out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=TRUE, tz="", posix.ts=TRUE) print(tibble::tibble(out)) DBI::dbClearResult(r) From bd883747178709779aa9730752d177dd17de014d Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 21:13:32 +1100 Subject: [PATCH 091/129] docs: Re-build roxygen documentation --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index b5b8d242..9e7be276 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -90,6 +90,7 @@ export(update_snapshot) exportMethods(dbBegin) exportMethods(dbCommit) exportMethods(dbExistsTable) +exportMethods(dbFetch) exportMethods(dbGetInfo) exportMethods(dbGetRowsAffected) exportMethods(dbIsValid) From 64fe889aa3ac33e4ab6b4ca7858965e0d4360090 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 10:18:42 +0000 Subject: [PATCH 092/129] debug: Add small workflow to check Oracla data-type issu --- .github/workflows/oracle-reprex.yaml | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 514a1f6e..47dba460 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -153,11 +153,16 @@ jobs: r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) - print("RJDBC::dbOption(conn, \"fetch.lossy\", \"?\")") - print(RJDBC::dbOption(conn, "fetch.lossy", "?")) + #setGeneric("dbOption", function(dbo, name, default) default) + #setMethod("dbOption", "JDBCDriver", function(dbo, name, default) if (name %in% names(dbo@options)) dbo@options[[name]] else default) + #setMethod("dbOption", "JDBCConnection", function(dbo, name, default) if (name %in% names(dbo@options)) dbo@options[[name]] else default) + #setMethod("dbOption", "JDBCResult", function(dbo, name, default) dbOption(dbo@conn, name, default)) - print("RJDBC::dbOption(r, \"fetch.lossy\", \"?\")") - print(RJDBC::dbOption(r, "fetch.lossy", "?")) + #print("dbOption(conn, \"fetch.lossy\", \"?\")") + #print(dbOption(conn, "fetch.lossy", "?")) + + #print("dbOption(r, \"fetch.lossy\", \"?\")") + #print(dbOption(r, "fetch.lossy", "?")) out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=TRUE, tz="", posix.ts=TRUE) print(tibble::tibble(out)) @@ -169,11 +174,11 @@ jobs: devtools::load_all() # Try to connect conn <- tryCatch({ - get_connection( + SCDB::get_connection( drv, - "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", - "github_ci", - "github_ci" + url = "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", + user = "github_ci", + password = "github_ci" ) }, error = function(e) { print(paste("Connection error:", e$message)) From 9a38f1f08de34746e7304f929953fcdfbaa47fac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:00:46 +0000 Subject: [PATCH 093/129] fix(backend_oracle): Correctly call `id` in dbWriteTable --- R/backend_oracle.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index adbb76de..f6bb7426 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -67,7 +67,7 @@ setMethod( value = "data.frame" ), function(conn, name, value, ...) { - DBI::dbWriteTable(conn@jdbc_conn, id(conn@jdbc_conn, name), value, ...) + DBI::dbWriteTable(conn@jdbc_conn, id(name, conn@jdbc_conn), value, ...) } ) From 5beb2b1e181518a0b1b2256419444b3de651de36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:20:19 +0000 Subject: [PATCH 094/129] feat(get_schema): Add additional Oracle implementation --- R/get_schema.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/get_schema.R b/R/get_schema.R index 1ef7860a..b261791d 100644 --- a/R/get_schema.R +++ b/R/get_schema.R @@ -107,6 +107,11 @@ get_schema.Oracle <- function(obj, ...) { return(DBI::dbGetQuery(obj, "SELECT user FROM dual")$USER) } +#' @export +get_schema.JDBCConnection <- function(obj, ...) { + return(DBI::dbGetQuery(obj, "SELECT user FROM dual")$USER) +} + #' @export get_schema.NULL <- function(obj, ...) { return(NULL) From d4d410fe44e02e2736bb609e93ea90115caf170e Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 22:21:54 +1100 Subject: [PATCH 095/129] docs: Re-build roxygen documentation --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 9e7be276..c7dcba2f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ S3method(get_connection,duckdb_driver) S3method(get_schema,"Microsoft SQL Server") S3method(get_schema,"NULL") S3method(get_schema,Id) +S3method(get_schema,JDBCConnection) S3method(get_schema,Oracle) S3method(get_schema,PqConnection) S3method(get_schema,SQLiteConnection) From 0e60a14634d9ad248713db22fc9ce5d5ae1f39b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:28:32 +0000 Subject: [PATCH 096/129] feat(fetch): Add Oracle implementation --- R/backend_oracle.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index f6bb7426..1ba77786 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -309,3 +309,15 @@ setMethod( RJDBC::fetch(res, n, ...) } ) + +#' @importMethodsFrom DBI fetch +#' @exportMethod fetch +setMethod( + "fetch", + signature( + res = "JDBCResult" + ), + function(res, ...) { + RJDBC::fetch(res, n = -1, ...) + } +) From 7ad614a203364e5e99d52e16542407ffc5c8ba48 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 22:30:21 +1100 Subject: [PATCH 097/129] docs: Re-build roxygen documentation --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index c7dcba2f..6fab6a65 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -100,6 +100,7 @@ exportMethods(dbRollback) exportMethods(dbSendQuery) exportMethods(dbSendStatement) exportMethods(dbWriteTable) +exportMethods(fetch) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) @@ -122,6 +123,7 @@ importMethodsFrom(DBI,dbRollback) importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbSendStatement) importMethodsFrom(DBI,dbWriteTable) +importMethodsFrom(DBI,fetch) importMethodsFrom(RJDBC,dbDataType) importMethodsFrom(RJDBC,dbExistsTable) importMethodsFrom(RJDBC,dbSendQuery) From 236d52d509dc1bab8b95ac17a7fdd1d5db92f104 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:44:02 +0000 Subject: [PATCH 098/129] debug fetch --- R/backend_oracle.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1ba77786..de19a87c 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -318,6 +318,8 @@ setMethod( res = "JDBCResult" ), function(res, ...) { + stop(getMethod(RJDBC::fetch, signature(res = "JDBCResult", n = "numeric"))) + RJDBC::fetch(res, n = -1, ...) } ) From 135084b7a74a15daaae3a897b5aa633bb3e79c2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:49:10 +0000 Subject: [PATCH 099/129] Revert "debug fetch" This reverts commit 2e94dca4147ca78d1055f92a3fe3b391dfe3e4f8. --- R/backend_oracle.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index de19a87c..1ba77786 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -318,8 +318,6 @@ setMethod( res = "JDBCResult" ), function(res, ...) { - stop(getMethod(RJDBC::fetch, signature(res = "JDBCResult", n = "numeric"))) - RJDBC::fetch(res, n = -1, ...) } ) From a21509884a7970948509792a0b062b8acff9d463 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 11:49:45 +0000 Subject: [PATCH 100/129] debug: Add small workflow to check Oracla data-type issu --- .github/workflows/oracle-reprex.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 47dba460..c9b9a5f5 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -171,6 +171,8 @@ jobs: dbDisconnect(conn) + print(getMethod(RJDBC::fetch, signature(res = "JDBCResult", n = "numeric"))) + devtools::load_all() # Try to connect conn <- tryCatch({ From 2a8f628cd921979bdf00101f91ba18fca368b0bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 12:12:05 +0000 Subject: [PATCH 101/129] feat(fetch): Implement dev code from RJDBC --- R/backend_oracle.R | 109 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 107 insertions(+), 2 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1ba77786..5b21b01d 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -306,7 +306,7 @@ setMethod( n = "numeric" ), function(res, n, ...) { - RJDBC::fetch(res, n, ...) + rjdbc_fetch(res, n, ...) } ) @@ -318,6 +318,111 @@ setMethod( res = "JDBCResult" ), function(res, ...) { - RJDBC::fetch(res, n = -1, ...) + rjdbc_fetch(res, n = -1, ...) } ) + + +# RJDBC has seemingly stopped active development but their latest version of +# `fetch` is needed to retreive results from oracle in a meaningful manor. +# We implement a minimal version of that function here +rjdbc_fetch <- function( + res, + n, + block = 2048L, + ... +) { + + cols <- rJava::.jcall(res@md, "I", "getColumnCount") + block <- as.integer(block) + if (length(block) != 1L) stop("invalid block size") + if (cols < 1L) return(NULL) + l <- vector("list", cols) + cts <- rep(0L, cols) ## column type (as per JDBC) + rts <- rep(0L, cols) ## retrieval types (0 = string, 1 = double, 2 = integer, 3 = POSIXct) + for (i in 1:cols) { + ## possible retrieval: + ## getDouble(), getTimestamp() and getString() + ## [NOTE: getBigDecimal() is native for all numeric() types] + ## could cehck java.sql.Timestamp which has .getTime() in millis + cts[i] <- ct <- rJava::.jcall(res@md, "I", "getColumnType", i) + l[[i]] <- character() + ## NOTE: this is also needed in dbColumnInfo() - see also JDBC.types + ## -7 BIT, -6 TINYINT, 5 SMALLINT, 4 INTEGER, -5 BIGINT + ## 6 FLOAT, 7 REAL, 8 DOUBLE, 2 NUMERIC, 3 DECIMAL + ## 1 CHAR, 12 VARCHAR, -1 LONGVARCHAR + ## 91 DATE, 92 TIME, 93 TIMESTAMP + ## -2 BINARY, -3 VARBINARY, -4 LONGVARBINARY + ## 0 NULL, 1111 OTHER, 2000 JAVA_OBJECT + ## 16 BOOLEAN, 1.8+: 2013 TIME_WITH_TIMEZONE, + ## 2014 TIMESTAMP_WITH_TIMEZONE + ## + ## integer-compatible typse + if (ct == 4L || ct == 5L || ct == -6L) { + l[[i]] <- integer() + rts[i] <- 2L + } else if (ct == -5L || (ct >= 2L && ct <= 8L)) { ## BIGINT and various float/num types + ## some numeric types may exceed double precision (see #83) + ## those must be retrieved as strings + ## + ## check precision for NUMERIC/DECIMAL + cp <- switch( + as.character(ct), + `2` = rJava::.jcall(res@md, "I", "getPrecision", i), + `3` = rJava::.jcall(res@md, "I", "getPrecision", i), + `-5` = 20L, ## BIGINT + 0L + ) + + l[[i]] <- numeric() + rts[i] <- 1L + + } else if (ct >= 91L && ct <= 93L) { ## DATE/TIME/TS + l[[i]] <- as.POSIXct(numeric()) + rts[i] <- 3L + } else if (ct == -7L) { ## BIT + l[[i]] <- logical() + rts[i] <- 4L + } + names(l)[i] <- rJava::.jcall(res@md, "S", "getColumnLabel", i) + } + + rp <- res@env$pull + if (rJava::is.jnull(rp)) { + rp <- rJava::.jnew( + "info/urbanek/Rpackage/RJDBC/JDBCResultPull", + rJava::.jcast(res@jr, "java/sql/ResultSet"), + rJava::.jarray(as.integer(rts)) + ) + res@env$pull <- rp + } + + ret_fn <- list( ## retrieval functions for the different types + function(i) rJava::.jcall(rp, "[Ljava/lang/String;", "getStrings", i), + function(i) rJava::.jcall(rp, "[D", "getDoubles", i), + function(i) rJava::.jcall(rp, "[I", "getIntegers", i), + function(i) rJava::.jcall(rp, "[D", "getDoubles", i), + function(i) as.logical(rJava::.jcall(rp, "[I", "getIntegers", i)) + ) + + if (n < 0L) { ## infinite pull - collect (using pairlists) & join + stride <- 32768L ## start fairly small to support tiny queries and increase later + while ((nrec <- rJava::.jcall(rp, "I", "fetch", stride, block)) > 0L) { + for (i in seq.int(cols)) { + l[[i]] <- pairlist(l[[i]], ret_fn[[rts[i] + 1L]](i)) + } + if (nrec < stride) break + stride <- 524288L # 512k + } + for (i in seq.int(cols)) l[[i]] <- unlist(l[[i]], TRUE, FALSE) + } else { + nrec <- rJava::.jcall(rp, "I", "fetch", as.integer(n), block) + for (i in seq.int(cols)) l[[i]] <- ret_fn[[rts[i] + 1L]](i) + } + ## unlisting can strip attrs so do POSIXct at the end for TSs + ts_col <- rts == 3L + if (any(ts_col)) for (i in which(ts_col)) l[[i]] <- as.POSIXct(l[[i]]) + # as.data.frame is expensive - create it on the fly from the list + attr(l, "row.names") <- c(NA_integer_, length(l[[1]])) + class(l) <- "data.frame" +} From e52c4db53486cfa72a268dcc7fa7456c698ba997 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 12:54:25 +0000 Subject: [PATCH 102/129] feat(OracleJdbcResult): Add new JDBCResult class to prevent conflict --- R/backend_oracle.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 5b21b01d..f0d65b2f 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -12,6 +12,9 @@ setClass( contains = "Oracle" ) +#' @importClassesFrom RJDBC JDBCResult +setClass("OracleJdbcResult", contains = "Oracle") + # DBI methods defined in RJDBC package # dbOption @@ -302,7 +305,7 @@ setMethod( setMethod( "dbFetch", signature( - res = "JDBCResult", + res = "OracleJdbcResult", n = "numeric" ), function(res, n, ...) { @@ -315,10 +318,10 @@ setMethod( setMethod( "fetch", signature( - res = "JDBCResult" + res = "OracleJdbcResult" ), function(res, ...) { - rjdbc_fetch(res, n = -1, ...) + rjdbc_fetch(res, ...) } ) From 1d90f99d131d8fd30fc5af52df7fd25182b8f150 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 12:54:47 +0000 Subject: [PATCH 103/129] feat(fetch): Implement dev code from RJDBC --- R/backend_oracle.R | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index f0d65b2f..b5f613ba 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -328,10 +328,10 @@ setMethod( # RJDBC has seemingly stopped active development but their latest version of # `fetch` is needed to retreive results from oracle in a meaningful manor. -# We implement a minimal version of that function here +# We implement a minimal (always lossy) version of that function here rjdbc_fetch <- function( res, - n, + n = -1, block = 2048L, ... ) { @@ -365,21 +365,8 @@ rjdbc_fetch <- function( l[[i]] <- integer() rts[i] <- 2L } else if (ct == -5L || (ct >= 2L && ct <= 8L)) { ## BIGINT and various float/num types - ## some numeric types may exceed double precision (see #83) - ## those must be retrieved as strings - ## - ## check precision for NUMERIC/DECIMAL - cp <- switch( - as.character(ct), - `2` = rJava::.jcall(res@md, "I", "getPrecision", i), - `3` = rJava::.jcall(res@md, "I", "getPrecision", i), - `-5` = 20L, ## BIGINT - 0L - ) - l[[i]] <- numeric() rts[i] <- 1L - } else if (ct >= 91L && ct <= 93L) { ## DATE/TIME/TS l[[i]] <- as.POSIXct(numeric()) rts[i] <- 3L @@ -428,4 +415,6 @@ rjdbc_fetch <- function( # as.data.frame is expensive - create it on the fly from the list attr(l, "row.names") <- c(NA_integer_, length(l[[1]])) class(l) <- "data.frame" + + return(l) } From e973bf56ad65a5a450a7749bc0e0e80960ee43c6 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 6 Nov 2025 23:56:25 +1100 Subject: [PATCH 104/129] docs: Re-build roxygen documentation --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 6fab6a65..46412e6e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -104,6 +104,7 @@ exportMethods(fetch) import(parallelly) importClassesFrom(DBI,DBIConnection) importClassesFrom(RJDBC,JDBCConnection) +importClassesFrom(RJDBC,JDBCResult) importClassesFrom(odbc,Oracle) importFrom(R6,R6Class) importFrom(magrittr,"%>%") From dff3b4b5fbd10b5e0b70b08572ac86b3d7aa439a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 13:16:12 +0000 Subject: [PATCH 105/129] feat(fetch): Implement dev code from RJDBC --- R/backend_oracle.R | 30 +++++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index b5f613ba..7cac0c2f 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -13,7 +13,13 @@ setClass( ) #' @importClassesFrom RJDBC JDBCResult -setClass("OracleJdbcResult", contains = "Oracle") +setClass( + "OracleJdbcResult", + slots = list( + "jdbc_result" = "JDBCResult" + ), + contains = "JDBCResult" +) # DBI methods defined in RJDBC package @@ -217,7 +223,14 @@ setMethod( statement = "character" ), function(conn, statement, ...) { - DBI::dbSendQuery(conn@jdbc_conn, statement) + res <- DBI::dbSendQuery(conn@jdbc_conn, statement) + + result <- new( + "OracleJdbcResult", + jdbc_result = res + ) + + return(result) } ) @@ -296,7 +309,14 @@ setMethod( statement = "character" ), function(conn, statement, ...) { - DBI::dbSendQuery(conn@jdbc_conn, statement, ...) + res <- DBI::dbSendQuery(conn@jdbc_conn, statement, ...) + + result <- new( + "OracleJdbcResult", + jdbc_result = res + ) + + return(result) } ) @@ -309,7 +329,7 @@ setMethod( n = "numeric" ), function(res, n, ...) { - rjdbc_fetch(res, n, ...) + rjdbc_fetch(res@jdbc_result, n, ...) } ) @@ -321,7 +341,7 @@ setMethod( res = "OracleJdbcResult" ), function(res, ...) { - rjdbc_fetch(res, ...) + rjdbc_fetch(res@jdbc_result, ...) } ) From 201171e5ff217ddbe33e6ccec8aa744ff386e3b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 13:56:29 +0000 Subject: [PATCH 106/129] debug: Add small workflow to check Oracla data-type issu --- .github/workflows/oracle-reprex.yaml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index c9b9a5f5..661b7b74 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -171,7 +171,6 @@ jobs: dbDisconnect(conn) - print(getMethod(RJDBC::fetch, signature(res = "JDBCResult", n = "numeric"))) devtools::load_all() # Try to connect @@ -198,6 +197,9 @@ jobs: print(tibble::tibble(DBI::dbReadTable(conn, "MTCARS"))) r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM MTCARS")) + print(getMethod(RJDBC::fetch, signature(res = class(r), n = "numeric"))) + + out <- RJDBC::fetch(r) print(tibble::tibble(out)) DBI::dbClearResult(r) From bd17dcbeed614f3db736aa32984bf6cff11c85d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 6 Nov 2025 14:17:16 +0000 Subject: [PATCH 107/129] feat(dbClearResult): Add Oracle implementation --- R/backend_oracle.R | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 7cac0c2f..3c5b00ca 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -345,6 +345,19 @@ setMethod( } ) +#' @importMethodsFrom DBI dbClearResult +#' @exportMethod dbClearResult +setMethod( + "dbClearResult", + signature( + res = "OracleJdbcResult" + ), + function(res, ...) { + callNextMethod(res@jdbc_result, ...) + } +) + + # RJDBC has seemingly stopped active development but their latest version of # `fetch` is needed to retreive results from oracle in a meaningful manor. From fc08010b7fc9a1f233485881303eb449e2bc016e Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Fri, 7 Nov 2025 01:18:58 +1100 Subject: [PATCH 108/129] docs: Re-build roxygen documentation --- NAMESPACE | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 46412e6e..8ed1df93 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(unique_table_name) export(unlock_table) export(update_snapshot) exportMethods(dbBegin) +exportMethods(dbClearResult) exportMethods(dbCommit) exportMethods(dbExistsTable) exportMethods(dbFetch) @@ -113,6 +114,7 @@ importFrom(rJava,.jcall) importFrom(rlang,":=") importFrom(rlang,.data) importMethodsFrom(DBI,dbBegin) +importMethodsFrom(DBI,dbClearResult) importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) importMethodsFrom(DBI,dbFetch) From 6f5ccff60b14021cb2788ad3378b71683d81e143 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Mon, 10 Nov 2025 21:23:29 +1100 Subject: [PATCH 109/129] chore: Update pak.lock --- pak.lock | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/pak.lock b/pak.lock index 8c844e46..e94821d8 100644 --- a/pak.lock +++ b/pak.lock @@ -2836,7 +2836,7 @@ "ref": "pkgdown", "binary": true, "dep_types": ["Depends", "Imports", "LinkingTo"], - "dependencies": ["bslib", "callr", "cli", "desc", "downlit", "fontawesome", "fs", "httr2", "jsonlite", "openssl", "purrr", "ragg", "rlang", "rmarkdown", "tibble", "whisker", "withr", "xml2", "yaml"], + "dependencies": ["bslib", "callr", "cli", "desc", "downlit", "fontawesome", "fs", "httr2", "jsonlite", "lifecycle", "openssl", "purrr", "ragg", "rlang", "rmarkdown", "tibble", "whisker", "withr", "xml2", "yaml"], "direct": false, "directpkg": false, "install_args": "", @@ -2847,7 +2847,7 @@ "RemoteRef": "pkgdown", "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", - "RemoteSha": "2.1.3" + "RemoteSha": "2.2.0" }, "needscompilation": false, "package": "pkgdown", @@ -2855,7 +2855,7 @@ "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", "repotype": "cran", "rversion": "4.5", - "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/pkgdown_2.1.3.tar.gz", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/pkgdown_2.2.0.tar.gz", "sysreqs": "pandoc", "sysreqs_packages": [ { @@ -2865,9 +2865,9 @@ "post_install": {} } ], - "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/pkgdown_2.1.3.tar.gz", + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/pkgdown_2.2.0.tar.gz", "type": "standard", - "version": "2.1.3", + "version": "2.2.0", "vignettes": false }, { From 97c374857cfb927ec7dc061e72c290c84fa4f6a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 11:21:26 +0100 Subject: [PATCH 110/129] debug: Add small workflow to check Oracla data-type issu --- .github/workflows/oracle-reprex.yaml | 205 +++++++++++++++------------ 1 file changed, 113 insertions(+), 92 deletions(-) diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 661b7b74..9e7768a6 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -114,95 +114,116 @@ jobs: echo 'Sys.setenv(JAVA_HOME = Sys.getenv("JAVA_HOME"))' > ~/.Rprofile echo 'Sys.setenv(CLASSPATH = "/usr/lib/oracle/ojdbc8.jar")' >> ~/.Rprofile - # Test the JDBC connection - Rscript -e ' - library(RJDBC) - - # Print Java version and classpath to debug - print(system("java -version", intern = TRUE)) - print(Sys.getenv("CLASSPATH")) - print(Sys.getenv("JAVA_HOME")) - - # Initialize the Oracle driver explicitly - drv <- JDBC("oracle.jdbc.OracleDriver", "/usr/lib/oracle/ojdbc8.jar") - print("JDBC driver initialized successfully") - - # Try to connect - conn <- tryCatch({ - dbConnect( - drv, - "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", - "github_ci", - "github_ci" - ) - }, error = function(e) { - print(paste("Connection error:", e$message)) - NULL - }) - - if (!is.null(conn)) { - print("Successfully connected to Oracle!") - } - - data <- dplyr::rename_with(iris, ~ toupper(gsub(".", "_", .x, fixed = TRUE))) - - DBI::dbWriteTable(conn, "IRIS", data) - - print(tibble::tibble(DBI::dbReadTable(conn, "IRIS"))) - - - r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) - - #setGeneric("dbOption", function(dbo, name, default) default) - #setMethod("dbOption", "JDBCDriver", function(dbo, name, default) if (name %in% names(dbo@options)) dbo@options[[name]] else default) - #setMethod("dbOption", "JDBCConnection", function(dbo, name, default) if (name %in% names(dbo@options)) dbo@options[[name]] else default) - #setMethod("dbOption", "JDBCResult", function(dbo, name, default) dbOption(dbo@conn, name, default)) - - #print("dbOption(conn, \"fetch.lossy\", \"?\")") - #print(dbOption(conn, "fetch.lossy", "?")) - - #print("dbOption(r, \"fetch.lossy\", \"?\")") - #print(dbOption(r, "fetch.lossy", "?")) - - out <- RJDBC::fetch(r, -1, block=2048L, use.label=TRUE, lossy=TRUE, tz="", posix.ts=TRUE) - print(tibble::tibble(out)) - DBI::dbClearResult(r) - - dbDisconnect(conn) - - - - devtools::load_all() - # Try to connect - conn <- tryCatch({ - SCDB::get_connection( - drv, - url = "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", - user = "github_ci", - password = "github_ci" - ) - }, error = function(e) { - print(paste("Connection error:", e$message)) - NULL - }) - - if (!is.null(conn)) { - print("Successfully connected to Oracle!") - } - - data <- dplyr::rename_with(mtcars, ~ toupper(gsub(".", "_", .x, fixed = TRUE))) - - DBI::dbWriteTable(conn, "MTCARS", data) - - print(tibble::tibble(DBI::dbReadTable(conn, "MTCARS"))) - - r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM MTCARS")) - print(getMethod(RJDBC::fetch, signature(res = class(r), n = "numeric"))) - - - out <- RJDBC::fetch(r) - print(tibble::tibble(out)) - DBI::dbClearResult(r) - - dbDisconnect(conn) - ' + - name: Test Oracle conection + shell: Rscript {0} + run: | + library(RJDBC) + + # Print Java version and classpath to debug + print(system("java -version", intern = TRUE)) + print(Sys.getenv("CLASSPATH")) + print(Sys.getenv("JAVA_HOME")) + + # Initialize the Oracle driver explicitly + drv <- JDBC("oracle.jdbc.OracleDriver", "/usr/lib/oracle/ojdbc8.jar") + print("JDBC driver initialized successfully") + + + devtools::load_all() + # Try to connect + conn <- tryCatch({ + SCDB::get_connection( + drv, + url = "jdbc:oracle:thin:@${{ env.ORACLEHOST }}:1521/FREEPDB1", + user = "github_ci", + password = "github_ci" + ) + }, error = function(e) { + print(paste("Connection error:", e$message)) + NULL + }) + + if (!is.null(conn)) { + print("Successfully connected to Oracle!") + } + + print("class(conn)") + print(class(conn)) + + data <- dplyr::rename_with(iris, ~ toupper(gsub(".", "_", .x, fixed = TRUE))) + + DBI::dbWriteTable(conn, "IRIS", data) + + print(tibble::tibble(DBI::dbReadTable(conn, "IRIS"))) + + r <- DBI::dbSendQuery(conn, paste0("SELECT * FROM IRIS")) + print("class(r)") + print(class(r)) + + out <- DBI::fetch(r) + print(tibble::tibble(out)) + DBI::dbClearResult(r) + + + # Start with some clean up + purrr::walk( + c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", + "test.SCDB_logs", "test.SCDB_logger", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", + "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2" + ), + ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) + ) + + purrr::walk( + c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), + ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) + ) + + # Copy mtcars to conn + dplyr::copy_to( + conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), + name = id("test.mtcars", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dplyr::copy_to( + conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), + name = id("__mtcars", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dplyr::copy_to( + conn, + mtcars %>% + dplyr::mutate(name = rownames(mtcars)) %>% + digest_to_checksum() %>% + dplyr::mutate( + from_ts = as.POSIXct("2020-01-01 09:00:00"), + until_ts = as.POSIXct(NA) + ), + name = id("__mtcars_historical", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dplyr::copy_to( + conn, + mtcars %>% + dplyr::mutate(name = rownames(mtcars)) %>% + digest_to_checksum() %>% + dplyr::mutate( + from_ts = as.POSIXct("2020-01-01 09:00:00"), + until_ts = as.POSIXct(NA) + ), + name = id("MTCARS", conn), + temporary = FALSE, + overwrite = TRUE, + analyze = FALSE + ) + + dbDisconnect(conn) \ No newline at end of file From 80103ee5529ef9ec5a70252f63ad75ff5fa29092 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 11:21:40 +0100 Subject: [PATCH 111/129] feat(fetch): Implement dev code from RJDBC --- NAMESPACE | 1 - R/backend_oracle.R | 44 ++++++++++++++++++++++++++++++-------------- 2 files changed, 30 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8ed1df93..84da1e29 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -96,7 +96,6 @@ exportMethods(dbFetch) exportMethods(dbGetInfo) exportMethods(dbGetRowsAffected) exportMethods(dbIsValid) -exportMethods(dbQuoteIdentifier) exportMethods(dbRollback) exportMethods(dbSendQuery) exportMethods(dbSendStatement) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 3c5b00ca..1b8f61d0 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -225,10 +225,11 @@ setMethod( function(conn, statement, ...) { res <- DBI::dbSendQuery(conn@jdbc_conn, statement) - result <- new( - "OracleJdbcResult", - jdbc_result = res - ) + result <- new("OracleJdbcResult") + + for (slot_name in slotNames(res)) { + slot(result, slot_name) <- slot(res, slot_name) + } return(result) } @@ -311,10 +312,11 @@ setMethod( function(conn, statement, ...) { res <- DBI::dbSendQuery(conn@jdbc_conn, statement, ...) - result <- new( - "OracleJdbcResult", - jdbc_result = res - ) + result <- new("OracleJdbcResult") + + for (slot_name in slotNames(res)) { + slot(result, slot_name) <- slot(res, slot_name) + } return(result) } @@ -329,7 +331,20 @@ setMethod( n = "numeric" ), function(res, n, ...) { - rjdbc_fetch(res@jdbc_result, n, ...) + rjdbc_fetch(res, n, ...) + } +) + +#' @importMethodsFrom DBI fetch +#' @exportMethod fetch +setMethod( + "fetch", + signature( + res = "OracleJdbcResult", + n = "numeric" + ), + function(res, n, ...) { + rjdbc_fetch(res, n, ...) } ) @@ -341,10 +356,11 @@ setMethod( res = "OracleJdbcResult" ), function(res, ...) { - rjdbc_fetch(res@jdbc_result, ...) + rjdbc_fetch(res, n = -1, ...) } ) + #' @importMethodsFrom DBI dbClearResult #' @exportMethod dbClearResult setMethod( @@ -353,14 +369,14 @@ setMethod( res = "OracleJdbcResult" ), function(res, ...) { - callNextMethod(res@jdbc_result, ...) + callNextMethod(res, ...) } ) # RJDBC has seemingly stopped active development but their latest version of -# `fetch` is needed to retreive results from oracle in a meaningful manor. +# `fetch` is needed to retrieve results from oracle in a meaningful manor. # We implement a minimal (always lossy) version of that function here rjdbc_fetch <- function( res, @@ -380,7 +396,7 @@ rjdbc_fetch <- function( ## possible retrieval: ## getDouble(), getTimestamp() and getString() ## [NOTE: getBigDecimal() is native for all numeric() types] - ## could cehck java.sql.Timestamp which has .getTime() in millis + ## could check java.sql.Timestamp which has .getTime() in millis cts[i] <- ct <- rJava::.jcall(res@md, "I", "getColumnType", i) l[[i]] <- character() ## NOTE: this is also needed in dbColumnInfo() - see also JDBC.types @@ -393,7 +409,7 @@ rjdbc_fetch <- function( ## 16 BOOLEAN, 1.8+: 2013 TIME_WITH_TIMEZONE, ## 2014 TIMESTAMP_WITH_TIMEZONE ## - ## integer-compatible typse + ## integer-compatible types if (ct == 4L || ct == 5L || ct == -6L) { l[[i]] <- integer() rts[i] <- 2L From c8993b55c6bd070cfa29f7f8ed196bde23a87082 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 13:26:16 +0100 Subject: [PATCH 112/129] debug: disable dbQuoteIdentifier --- NAMESPACE | 1 - R/backend_oracle.R | 96 +++++++++++++++++++++++----------------------- 2 files changed, 48 insertions(+), 49 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 84da1e29..a2bdf243 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -120,7 +120,6 @@ importMethodsFrom(DBI,dbFetch) importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbIsValid) -importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbRollback) importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbSendStatement) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1b8f61d0..3a7bf496 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -162,54 +162,54 @@ setMethod( } ) -#' @importMethodsFrom DBI dbQuoteIdentifier -#' @exportMethod dbQuoteIdentifier -setMethod( - "dbQuoteIdentifier", - signature( - conn = "OracleJdbc", - x = "character" - ), - function(conn, x, ...) { - x <- enc2utf8(x) - - reserved_words <- c("DATE", "NUMBER", "VARCHAR") - - needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words - - x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") - - return(DBI::SQL(x, names = names(x))) - } -) - -#' @importMethodsFrom DBI dbQuoteIdentifier -#' @exportMethod dbQuoteIdentifier -setMethod( - "dbQuoteIdentifier", - signature( - conn = "OracleJdbc", - x = "SQL" - ), - function(conn, x, ...) { - return(x) # Remove ambiguity (also assume already quoted) - } -) - -#' @importMethodsFrom DBI dbQuoteIdentifier -#' @exportMethod dbQuoteIdentifier -setMethod( - "dbQuoteIdentifier", - signature( - conn = "OracleJdbc", - x = "Id" - ), - function(conn, x, ...) { - - # For `Id`, run on each non-NA element - return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn@jdbc_conn, purrr::discard(x@name, is.na)), collapse = "."))) - } -) +# #' @importMethodsFrom DBI dbQuoteIdentifier +# #' @exportMethod dbQuoteIdentifier +# setMethod( +# "dbQuoteIdentifier", +# signature( +# conn = "OracleJdbc", +# x = "character" +# ), +# function(conn, x, ...) { +# x <- enc2utf8(x) + +# reserved_words <- c("DATE", "NUMBER", "VARCHAR") + +# needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + +# x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + +# return(DBI::SQL(x, names = names(x))) +# } +# ) + +# #' @importMethodsFrom DBI dbQuoteIdentifier +# #' @exportMethod dbQuoteIdentifier +# setMethod( +# "dbQuoteIdentifier", +# signature( +# conn = "OracleJdbc", +# x = "SQL" +# ), +# function(conn, x, ...) { +# return(x) # Remove ambiguity (also assume already quoted) +# } +# ) + +# #' @importMethodsFrom DBI dbQuoteIdentifier +# #' @exportMethod dbQuoteIdentifier +# setMethod( +# "dbQuoteIdentifier", +# signature( +# conn = "OracleJdbc", +# x = "Id" +# ), +# function(conn, x, ...) { + +# # For `Id`, run on each non-NA element +# return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn@jdbc_conn, purrr::discard(x@name, is.na)), collapse = "."))) +# } +# ) From 9b59a8b43571bde0a961961e172ab892bd67d7d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 14:06:34 +0100 Subject: [PATCH 113/129] Revert "debug: disable dbQuoteIdentifier" This reverts commit 9cbb358c92227225aa57204778a9f57c931737af. --- NAMESPACE | 1 + R/backend_oracle.R | 96 +++++++++++++++++++++++----------------------- 2 files changed, 49 insertions(+), 48 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a2bdf243..84da1e29 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -120,6 +120,7 @@ importMethodsFrom(DBI,dbFetch) importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbIsValid) +importMethodsFrom(DBI,dbQuoteIdentifier) importMethodsFrom(DBI,dbRollback) importMethodsFrom(DBI,dbSendQuery) importMethodsFrom(DBI,dbSendStatement) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 3a7bf496..1b8f61d0 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -162,54 +162,54 @@ setMethod( } ) -# #' @importMethodsFrom DBI dbQuoteIdentifier -# #' @exportMethod dbQuoteIdentifier -# setMethod( -# "dbQuoteIdentifier", -# signature( -# conn = "OracleJdbc", -# x = "character" -# ), -# function(conn, x, ...) { -# x <- enc2utf8(x) - -# reserved_words <- c("DATE", "NUMBER", "VARCHAR") - -# needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words - -# x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") - -# return(DBI::SQL(x, names = names(x))) -# } -# ) - -# #' @importMethodsFrom DBI dbQuoteIdentifier -# #' @exportMethod dbQuoteIdentifier -# setMethod( -# "dbQuoteIdentifier", -# signature( -# conn = "OracleJdbc", -# x = "SQL" -# ), -# function(conn, x, ...) { -# return(x) # Remove ambiguity (also assume already quoted) -# } -# ) - -# #' @importMethodsFrom DBI dbQuoteIdentifier -# #' @exportMethod dbQuoteIdentifier -# setMethod( -# "dbQuoteIdentifier", -# signature( -# conn = "OracleJdbc", -# x = "Id" -# ), -# function(conn, x, ...) { - -# # For `Id`, run on each non-NA element -# return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn@jdbc_conn, purrr::discard(x@name, is.na)), collapse = "."))) -# } -# ) +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleJdbc", + x = "character" + ), + function(conn, x, ...) { + x <- enc2utf8(x) + + reserved_words <- c("DATE", "NUMBER", "VARCHAR") + + needs_escape <- (grepl("^[a-zA-Z_]", x) & toupper(x) != x) | tolower(x) %in% reserved_words + + x[needs_escape] <- paste0("\"", gsub("\"", "\"\"", x[needs_escape]), "\"") + + return(DBI::SQL(x, names = names(x))) + } +) + +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleJdbc", + x = "SQL" + ), + function(conn, x, ...) { + return(x) # Remove ambiguity (also assume already quoted) + } +) + +#' @importMethodsFrom DBI dbQuoteIdentifier +#' @exportMethod dbQuoteIdentifier +setMethod( + "dbQuoteIdentifier", + signature( + conn = "OracleJdbc", + x = "Id" + ), + function(conn, x, ...) { + + # For `Id`, run on each non-NA element + return(DBI::SQL(paste0(DBI::dbQuoteIdentifier(conn@jdbc_conn, purrr::discard(x@name, is.na)), collapse = "."))) + } +) From d130778520c85f5f902d5833ef000a5d860e1d2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 14:11:38 +0100 Subject: [PATCH 114/129] merge JDBCconnection and Oracle --- NAMESPACE | 1 + R/backend_oracle.R | 1 + R/connection.R | 1 + 3 files changed, 3 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 84da1e29..8ed1df93 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -96,6 +96,7 @@ exportMethods(dbFetch) exportMethods(dbGetInfo) exportMethods(dbGetRowsAffected) exportMethods(dbIsValid) +exportMethods(dbQuoteIdentifier) exportMethods(dbRollback) exportMethods(dbSendQuery) exportMethods(dbSendStatement) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 1b8f61d0..e3a2d2f0 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -6,6 +6,7 @@ setClass( "OracleJdbc", slots = list( "jdbc_conn" = "JDBCConnection", + "jc" = "jobjRef", "servername" = "character", "options" = "list" ), diff --git a/R/connection.R b/R/connection.R index 805184b7..8f0cc992 100644 --- a/R/connection.R +++ b/R/connection.R @@ -263,6 +263,7 @@ get_connection.JDBCDriver <- function( conn <- new( "OracleJdbc", jdbc_conn = conn, + jc = conn@jc, servername = url, options = list("fetch.lossy" = TRUE) ) From 29fb3d49e315b1df46996cafedc2b4d3ebaa6810 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 14:29:25 +0100 Subject: [PATCH 115/129] remove unused code from setup.R --- tests/testthat/setup.R | 56 ------------------------------------------ 1 file changed, 56 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index ab02fc24..1da66d00 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -89,62 +89,6 @@ for (conn in get_test_conns()) { analyze = FALSE ) - - f <- getMethod("dbGetQuery", signature(conn="JDBCConnection", statement="character"))@.Data - print('f("SELECT * FROM FROM MTCARS)') - print(f(conn@jdbc_conn, "SELECT * FROM MTCARS")) - print(tibble::as_tibble(f(conn@jdbc_conn, "SELECT * FROM MTCARS"))) - - query <- paste( - "SELECT column_name, data_type, data_length, data_precision, data_scale, nullable", - "FROM ALL_TAB_COLUMNS", - "WHERE table_name = 'MTCARS'" - ) - print(f(conn@jdbc_conn, query)) - - - - - #sql <- DBI::SQL("SELECT * FROM MTCARS") - - #res <- DBI::dbSendQuery(conn, sql) - #print("class(res)") - #print(class(res)) - - #print("dbFetch") - #foo <- DBI::dbFetch(res, n = Inf) - #print(foo) - - #print(tibble::tibble(foo)) - - print("??") - - print("DBI::dbWriteTable(conn@jdbc_conn, \"MTCARS2\", mtcars)") - print(DBI::dbWriteTable(conn@jdbc_conn, "MTCARS2", mtcars)) - - query <- paste( - "SELECT column_name, data_type, data_length, data_precision, data_scale, nullable", - "FROM ALL_TAB_COLUMNS", - "WHERE table_name = 'MTCARS2'" - ) - print(f(conn@jdbc_conn, query)) - - foo <- DBI::dbReadTable(conn@jdbc_conn, "MTCARS2") - print(foo) - print(tibble::tibble(foo)) - - - res <- DBI::dbSendQuery(conn@jdbc_conn, "SELECT * FROM MTCARS2") - class("res") - class(res) - - cts <- purrr::map(1:11, ~ rJava::.jcall(res@md, "I", "getColumnType", .)) - print("cts") - print(cts) - - DBI::dbClearResult(res) - - DBI::dbDisconnect(conn) } From d9b87ead0b1d3f429bdacb763a923fdd383a2335 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Tue, 11 Nov 2025 13:00:05 +0100 Subject: [PATCH 116/129] fix(Oracle): Don't map dbFetch to rjdc_fetch --- NAMESPACE | 2 -- R/backend_oracle.R | 13 ------------- 2 files changed, 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8ed1df93..bf1473b2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -92,7 +92,6 @@ exportMethods(dbBegin) exportMethods(dbClearResult) exportMethods(dbCommit) exportMethods(dbExistsTable) -exportMethods(dbFetch) exportMethods(dbGetInfo) exportMethods(dbGetRowsAffected) exportMethods(dbIsValid) @@ -117,7 +116,6 @@ importMethodsFrom(DBI,dbBegin) importMethodsFrom(DBI,dbClearResult) importMethodsFrom(DBI,dbCommit) importMethodsFrom(DBI,dbExistsTable) -importMethodsFrom(DBI,dbFetch) importMethodsFrom(DBI,dbGetInfo) importMethodsFrom(DBI,dbGetRowsAffected) importMethodsFrom(DBI,dbIsValid) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index e3a2d2f0..893b7445 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -323,19 +323,6 @@ setMethod( } ) -#' @importMethodsFrom DBI dbFetch -#' @exportMethod dbFetch -setMethod( - "dbFetch", - signature( - res = "OracleJdbcResult", - n = "numeric" - ), - function(res, n, ...) { - rjdbc_fetch(res, n, ...) - } -) - #' @importMethodsFrom DBI fetch #' @exportMethod fetch setMethod( From eb22e90c5b42580c1a98d899e3862d8d4d1e3472 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Mon, 10 Nov 2025 14:40:06 +0100 Subject: [PATCH 117/129] debug: _jobjRef_dollar --- .github/workflows/oracle-reprex.yaml | 10 +- R/backend_oracle.R | 10 + tests/testthat/setup.R | 45 +- tests/testthat/test-Logger.R | 544 ---------------- tests/testthat/test-create_logs_if_missing.R | 66 -- tests/testthat/test-db_joins.R | 219 ------- tests/testthat/test-db_timestamp.R | 24 - tests/testthat/test-filter_keys.R | 77 --- tests/testthat/test-getTableSignature.R | 369 ----------- tests/testthat/test-get_table.R | 130 ---- tests/testthat/test-get_tables.R | 163 ----- tests/testthat/test-interlace.R | 53 -- tests/testthat/test-locks.R | 98 --- tests/testthat/test-slice_time.R | 34 - tests/testthat/test-unite.tbl_dbi.R | 63 -- tests/testthat/test-update_snapshot.R | 650 ------------------- tests/testthat/test-zzz.R | 12 - 17 files changed, 37 insertions(+), 2530 deletions(-) delete mode 100644 tests/testthat/test-Logger.R delete mode 100644 tests/testthat/test-create_logs_if_missing.R delete mode 100644 tests/testthat/test-db_joins.R delete mode 100644 tests/testthat/test-db_timestamp.R delete mode 100644 tests/testthat/test-filter_keys.R delete mode 100644 tests/testthat/test-getTableSignature.R delete mode 100644 tests/testthat/test-get_table.R delete mode 100644 tests/testthat/test-get_tables.R delete mode 100644 tests/testthat/test-interlace.R delete mode 100644 tests/testthat/test-locks.R delete mode 100644 tests/testthat/test-slice_time.R delete mode 100644 tests/testthat/test-unite.tbl_dbi.R delete mode 100644 tests/testthat/test-update_snapshot.R delete mode 100644 tests/testthat/test-zzz.R diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index 9e7768a6..e373a270 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -164,6 +164,7 @@ jobs: print(tibble::tibble(out)) DBI::dbClearResult(r) + print("## Debug flag 1") # Start with some clean up purrr::walk( @@ -174,11 +175,13 @@ jobs: ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) ) + print("## Debug flag 2") purrr::walk( c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) ) + print("## Debug flag 3") # Copy mtcars to conn dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), @@ -188,6 +191,7 @@ jobs: analyze = FALSE ) + print("## Debug flag 4") dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), name = id("__mtcars", conn), @@ -196,6 +200,7 @@ jobs: analyze = FALSE ) + print("## Debug flag 5") dplyr::copy_to( conn, mtcars %>% @@ -211,6 +216,7 @@ jobs: analyze = FALSE ) + print("## Debug flag 6") dplyr::copy_to( conn, mtcars %>% @@ -225,5 +231,7 @@ jobs: overwrite = TRUE, analyze = FALSE ) + print("## Debug flag 7") - dbDisconnect(conn) \ No newline at end of file + DBI::dbDisconnect(conn) + print("## Debug flag 8") \ No newline at end of file diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 893b7445..7622f418 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -380,6 +380,7 @@ rjdbc_fetch <- function( l <- vector("list", cols) cts <- rep(0L, cols) ## column type (as per JDBC) rts <- rep(0L, cols) ## retrieval types (0 = string, 1 = double, 2 = integer, 3 = POSIXct) + for (i in 1:cols) { ## possible retrieval: ## getDouble(), getTimestamp() and getString() @@ -414,6 +415,9 @@ rjdbc_fetch <- function( names(l)[i] <- rJava::.jcall(res@md, "S", "getColumnLabel", i) } + print("rts") + print(rts) + rp <- res@env$pull if (rJava::is.jnull(rp)) { rp <- rJava::.jnew( @@ -436,6 +440,12 @@ rjdbc_fetch <- function( stride <- 32768L ## start fairly small to support tiny queries and increase later while ((nrec <- rJava::.jcall(rp, "I", "fetch", stride, block)) > 0L) { for (i in seq.int(cols)) { + print("rts[i] + 1L") + print(rts[i] + 1L) + + print("ret_fn[[rts[i] + 1L]]") + print(ret_fn[[rts[i] + 1L]]) + l[[i]] <- pairlist(l[[i]], ret_fn[[rts[i] + 1L]](i)) } if (nrec < stride) break diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 1da66d00..b5df857f 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1,33 +1,17 @@ -# Ensure the target connections are empty and configured correctly -coll <- checkmate::makeAssertCollection() -conns <- get_test_conns() -for (conn_id in seq_along(conns)) { - - conn <- conns[[conn_id]] - - # Ensure connections are valid - if (is.null(conn) || !DBI::dbIsValid(conn)) { - coll$push(glue::glue("Connection could not be made to backend ({names(conns)[[conn_id]]}).")) - } - - - # Check schemas are configured correctly - if (!schema_exists(conn, "test") && names(conns)[conn_id] != "SQLite") { - coll$push(glue::glue("Tests require the schema 'test' to exist in connection ({names(conns)[[conn_id]]}).")) - } - - if (!schema_exists(conn, "test.one") && names(conns)[conn_id] != "SQLite") { - coll$push(glue::glue("Tests require the schema 'test.one' to exist in connection ({names(conns)[[conn_id]]}).")) - } - - DBI::dbDisconnect(conn) -} -checkmate::reportAssertions(coll) - - # Configure the data bases for (conn in get_test_conns()) { + print("## Debug flag 1") + + # Debug + purrr::map( + c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", + "test.SCDB_logs", "test.SCDB_logger", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", + "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2" + ), + ~ id(., conn) + ) + # Start with some clean up purrr::walk( c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", @@ -37,11 +21,13 @@ for (conn in get_test_conns()) { ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) ) + print("## Debug flag 2") purrr::walk( c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) ) + print("## Debug flag 3") # Copy mtcars to conn dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), @@ -51,6 +37,7 @@ for (conn in get_test_conns()) { analyze = FALSE ) + print("## Debug flag 4") dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), name = id("__mtcars", conn), @@ -59,6 +46,7 @@ for (conn in get_test_conns()) { analyze = FALSE ) + print("## Debug flag 5") dplyr::copy_to( conn, mtcars %>% @@ -74,6 +62,7 @@ for (conn in get_test_conns()) { analyze = FALSE ) + print("## Debug flag 6") dplyr::copy_to( conn, mtcars %>% @@ -88,8 +77,10 @@ for (conn in get_test_conns()) { overwrite = TRUE, analyze = FALSE ) + print("## Debug flag 7") DBI::dbDisconnect(conn) + print("## Debug flag 8") } diff --git a/tests/testthat/test-Logger.R b/tests/testthat/test-Logger.R deleted file mode 100644 index 788d237b..00000000 --- a/tests/testthat/test-Logger.R +++ /dev/null @@ -1,544 +0,0 @@ -# Ensure the options that can be set are NULL for these tests -withr::local_options("SCDB.log_table_id" = NULL, "SCDB.log_path" = NULL) - -test_that("Logger: logging to console works", { - - # Create logger and test configuration - expect_warning( - logger <- Logger$new(), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - expect_null(logger$log_path) - expect_null(logger$log_tbl) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - expect_warning( - logger$log_warn("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") - ) - expect_error( - logger$log_error("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: all (non-warning, non-error) logging to console can be disabled", { - - # Create logger - expect_warning( - logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - # Test INFO-logging to console is disabled - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message(logger$log_info("test", tic = logger$start_time)) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: logging to file works", { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - - - # Create logger and test configuration - # Empty logger should use default value from options - withr::with_options( - list("SCDB.log_path" = "local/path"), - { - logger <- Logger$new(db_table = db_table, warn = FALSE) - expect_identical(logger$log_path, "local/path") - - rm(logger) - invisible(gc()) - } - ) - - # Create logger and test configuration - # Test file logging - with character timestamp - timestamp <- "2022-01-01 09:00:00" - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - output_to_console = FALSE, - warn = FALSE - ) - - expect_identical(logger$log_path, log_path) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{db_table}.log") - ) - - - # Test logging to file has the right formatting and message type - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - tryCatch(logger$log_warn("test filewriting", tic = logger$start_time), warning = function(w) NULL) - tryCatch(logger$log_error("test filewriting", tic = logger$start_time), error = function(e) NULL) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - c( - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test filewriting") - ) - ) - - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) - - - # Create logger and test configuration - # Test file logging - with POSIX timestamp - timestamp <- as.POSIXct("2022-02-01 09:00:00") - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - output_to_console = FALSE, - warn = FALSE - ) - - expect_identical(logger$log_path, log_path) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{db_table}.log") - ) - - - # Test logging to file still works - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - glue::glue( - "{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting" - ) - ) - - # Clean up - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: log_tbl is not set when conn = NULL", { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-03-01 09:00:00" - - # Create logger and test configuration - # Empty logger should use default value - logger <- Logger$new(db_table = db_table, timestamp = timestamp, warn = FALSE) - expect_null(logger$log_tbl) # log_table_id is NOT defined here, despite the option existing - # the logger does not have the connection, so cannot pull the table from conn - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: logging to database works", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-04-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, - timestamp = timestamp, - log_table_id = db_table, - log_conn = conn, - warn = FALSE) - - log_table_id <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical(logger$log_tbl, log_table_id) - - - # Test Logger has pre-filled some information in the logs - db_table_id <- id(db_table, conn) - expect_identical(as.character(dplyr::pull(log_table_id, "date")), timestamp) - if ("catalog" %in% purrr::pluck(db_table_id, "name", names)) { - expect_identical(dplyr::pull(log_table_id, "catalog"), purrr::pluck(db_table_id, "name", "catalog")) - } - expect_identical(dplyr::pull(log_table_id, "schema"), purrr::pluck(db_table_id, "name", "schema")) - expect_identical(dplyr::pull(log_table_id, "table"), purrr::pluck(db_table_id, "name", "table")) - expect_identical( # Transferring start_time to database can have some loss of information that we need to match - format(as.POSIXct(dplyr::pull(log_table_id, "start_time")), "%F %R:%S"), - format(logger$start_time, "%F %R:%S") - ) - - - # Test logging to database writes to the correct fields - logger$log_to_db(n_insertions = 42) - expect_identical(nrow(log_table_id), 1L) - expect_identical(dplyr::pull(log_table_id, "n_insertions"), 42L) - - logger$log_to_db(n_deactivations = 60) - expect_identical(nrow(log_table_id), 1L) - expect_identical(dplyr::pull(log_table_id, "n_deactivations"), 60L) - - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: all logging simultaneously works", { - for (conn in get_test_conns()) { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - timestamp <- "2022-05-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_path = log_path, - log_table_id = db_table, log_conn = conn, warn = FALSE) - - log_table_id <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical(logger$log_path, log_path) - expect_identical(logger$log_tbl, log_table_id) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{id(db_table, conn)}.log") - ) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting") - ) - expect_warning( - logger$log_warn("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting") - ) - expect_error( - logger$log_error("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") - ) - - - # Test logging to file has the right formatting and message type - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - c( - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") - ) - ) - - - # Test logging to database writes to the correct fields - logger$log_to_db(n_insertions = 13) - expect_identical(nrow(log_table_id), 2L) - expect_identical(dplyr::pull(log_table_id, "n_insertions"), c(42L, 13L)) - - logger$log_to_db(n_deactivations = 37) - expect_identical(nrow(log_table_id), 2L) - expect_identical(dplyr::pull(log_table_id, "n_deactivations"), c(60L, 37L)) - - - # Clean up - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: file logging stops if file exists", { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - timestamp <- Sys.time() - - # Create logger1 and logger2 which uses the same file - # Since start_time is the same for both - logger1 <- Logger$new( - db_table = db_table, - timestamp = timestamp, - start_time = timestamp, - log_path = log_path, - output_to_console = FALSE - ) - - logger2 <- Logger$new( - db_table = db_table, - timestamp = timestamp, - start_time = timestamp, - log_path = log_path, - output_to_console = FALSE - ) - - - # logger1 should be able to successfully write - logger1$log_info("test message") - - - # whereas logger2 should fail since the log file now exists - expect_error( - logger2$log_info("test message"), - glue::glue("Log file '{logger1$log_filename}' already exists!") - ) - - # .. and it should do it persistently - expect_error( - logger2$log_info("test message"), - glue::glue("Log file '{logger1$log_filename}' already exists!") - ) - - # Clean up - file.remove(logger1$log_realpath) - rm(logger1, logger2) - invisible(gc()) -}) - - -test_that("Logger: console output may be disabled", { - - # First test cases with output_to_console == FALSE - # Here, only print when explicitly stated - expect_warning( - logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - expect_no_message(logger$log_info("Whoops! This should not have been printed!")) - - expect_no_message(logger$log_info("Whoops! This should not have been printed either!", output_to_console = FALSE)) - - expect_message( - logger$log_info("This line should be printed", output_to_console = TRUE), - "This line should be printed" - ) - - rm(logger) - - # ...and now, only suppress printing when explicitly stated - expect_warning( - logger <- Logger$new(output_to_console = TRUE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - expect_message( - logger$log_info("This line should be printed"), - "This line should be printed" - ) - expect_message( - logger$log_info("This line should also be printed", output_to_console = TRUE), - "This line should also be printed" - ) - - expect_no_message(logger$log_info("Whoops! This should not have been printed at all!", output_to_console = FALSE)) -}) - - -test_that("Logger: log_file is NULL in database if not writing to file", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = "test.SCDB_logger") - - # While logger is active, log_file should be set as the random generated - db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) - expect_length(db_log_file, 1) - expect_match(db_log_file, "^.+$") - - # When finalising, log_file should be set to NULL - logger$.__enclos_env__$private$finalize() - - db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) - expect_length(db_log_file, 0) - - # Test that an error is thrown if the database record has been finalized - expect_error( - logger$log_to_db(message = "This should produce an error"), - "Logger has already been finalized\\. Cannot write to database log table\\." - ) - - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: $finalize() handles log table is at some point deleted", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - log_table_id <- "expendable_log_table" - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = log_table_id) - - DBI::dbRemoveTable(conn, id(log_table_id, conn)) - - expect_no_error(logger$log_to_db(n_insertions = 42)) - - expect_no_error(logger$.__enclos_env__$private$finalize()) - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - -test_that("Logger: custom timestamp_format works", { - - # Create logger and test configuration - expect_warning( - logger <- Logger$new(), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - ts_str <- format(logger$start_time, "%F %R") - expect_message( - logger$log_info("test console", tic = logger$start_time, timestamp_format = "%F %R"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - ts_str <- format(logger$start_time, "%F") - withr::local_options("SCDB.log_timestamp_format" = "%F") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no console logging occurs", { - - # Create logger and test configuration - logger <- expect_no_message(LoggerNull$new()) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message(logger$log_info("test console", tic = logger$start_time)) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message( - logger$log_info("test console", tic = logger$start_time) - ) - expect_warning( - logger$log_warn("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") - ) - expect_error( - logger$log_error("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no file logging occurs", { - withr::local_options("SCDB.log_path" = tempdir()) - - # Create logger and test configuration - logger <- expect_no_message(LoggerNull$new()) - - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - expect_false(logger$log_filename %in% dir(getOption("SCDB.log_path"))) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no database logging occurs", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - # Count entries in log - n_log_entries <- nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))) - - # Create LoggerNull and test configuration - logger <- LoggerNull$new( - db_table = db_table, timestamp = timestamp, - log_conn = conn, log_table_id = "test.SCDB_logger" - ) - - expect_no_message(logger$log_to_db(n_insertions = 42)) - expect_no_message(logger$finalize_db_entry()) - expect_identical(nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))), n_log_entries) - - # Clean up - rm(logger) - invisible(gc()) - - close_connection(conn) - } -}) diff --git a/tests/testthat/test-create_logs_if_missing.R b/tests/testthat/test-create_logs_if_missing.R deleted file mode 100644 index e868d8a4..00000000 --- a/tests/testthat/test-create_logs_if_missing.R +++ /dev/null @@ -1,66 +0,0 @@ -test_that("create_logs_if_missing() can create logs in default and test schema", { - for (conn in get_test_conns()) { - for (schema in list(NULL, "test")) { - - # Generate table in schema that does not exist - k <- 0 - while (k < 100) { - logs_id <- paste(c(schema, paste(sample(letters, size = 16, replace = TRUE), collapse = "")), collapse = ".") - k <- k + 1 - if (DBI::dbExistsTable(conn, id(logs_id, conn))) next - break - } - - if (k < 100) { - - # We know table does not exists - expect_false(table_exists(conn, logs_id)) - - # We create the missing log table - expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) - - # And check it conforms with the requirements - expect_true(table_exists(conn, logs_id)) - expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) - - log_signature <- data.frame( - date = as.POSIXct(character(0)), - catalog = character(0), - schema = character(0), - table = character(0), - n_insertions = integer(0), - n_deactivations = integer(0), - start_time = as.POSIXct(character(0)), - end_time = as.POSIXct(character(0)), - duration = character(0), - success = logical(), - message = character(0), - log_file = character(0) - ) - - if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection", "JBDCConnection"))) { - log_signature <- dplyr::select(log_signature, !"catalog") - } - - log_signature <- log_signature %>% - dplyr::copy_to(conn, df = ., unique_table_name(), analyze = FALSE) %>% - dplyr::collect() - - expect_identical( - dplyr::collect(dplyr::tbl(conn, id(logs_id, conn))), - log_signature - ) - - # Attempting to recreate the logs table should not change anything - expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) - expect_true(table_exists(conn, logs_id)) - expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) - - } else { - warning("Non-existing table in default schema could not be generated!", call. = FALSE) - } - - } - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R deleted file mode 100644 index 263c74e2..00000000 --- a/tests/testthat/test-db_joins.R +++ /dev/null @@ -1,219 +0,0 @@ -test_that("*_join() works with character `by` and `na_by`", { - for (conn in get_test_conns()) { - - # Create two more synthetic test data set with NA data - - # First test case - x <- data.frame(number = c("1", "2", NA), - t = c("strA", NA, "strB")) - - y <- data.frame(letter = c("A", "B", "A", "B"), - number = c(NA, "2", "1", "1")) - - # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - q <- dplyr::left_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_mapequal(q, qr) - - q <- dplyr::right_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_identical(q, qr) - - - # Second test case - x <- data.frame(date = as.Date(c("2022-05-01", "2022-05-01", "2022-05-02", "2022-05-02")), - region_id = c("1", NA, NA, "1"), - n_start = c(3, NA, NA, NA)) - - y <- data.frame(date = as.Date("2022-05-02"), - region_id = "1", - n_add = 4) - - # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - q <- dplyr::full_join(x, y, by = "date", na_by = "region_id") %>% - dplyr::collect() %>% - dplyr::arrange(date, region_id) - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = c("date", "region_id")) %>% - dplyr::arrange(date, region_id) - expect_identical(q, qr) - - - - - # Some other test cases - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - xx <- x %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) - yy <- y %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) - - # Using by should give 1 mismatch - # Using na_by should give no mismatch - expect_identical( - dplyr::left_join(xx, xx, by = "name") %>% - dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter - dplyr::pull(n), - 1 - ) - expect_identical( - dplyr::left_join(xx, xx, na_by = "name") %>% - dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter - dplyr::pull(n), - 0 - ) - - # And they should be identical with the simple case - expect_identical( - dplyr::left_join(xx, xx, na_by = "name") %>% - dplyr::select(!"name") %>% - dplyr::collect(), - dplyr::left_join(x, x, na_by = "name") %>% - dplyr::select(!"name") %>% - dplyr::collect() - ) - - connection_clean_up(conn) - } -}) - - -test_that("*_join() works with `dplyr::join_by()`", { - for (conn in get_test_conns()) { - - # Define two test datasets - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - print("dplyr::show_query(y)") - print(dplyr::show_query(y)) - - print("dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))") - print(dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))) - - print("dplyr::tbl_vars(y)") - print(dplyr::tbl_vars(y)) - - print("make_join_aliases") - print(dbplyr:::make_join_aliases(x$src$con, NULL, NULL, NULL, rlang::caller_env())) - - print("join_inline_select") - by <- dplyr::join_by(x$name == y$name) - print(dbplyr:::join_inline_select(y$lazy_query, by$y, by$on)) - - print("y_lq") - print(inline_result$lq) - - print("table_names_y") - print(dbplyr:::make_table_names(join_alias$y, y_lq)) - - - - # Test the implemented joins - q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - connection_clean_up(conn) - } -}) - - -test_that("*_join() does not break any dplyr joins", { - for (conn in get_test_conns()) { - - # Define two test datasets - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - # Test the standard joins - # left_join - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::left_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # right_join - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::right_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # inner_join - qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::inner_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # full_join - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::full_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::full_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # semi_join - qr <- dplyr::semi_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::semi_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::semi_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # anti_join - qr <- dplyr::anti_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::anti_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::anti_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-db_timestamp.R b/tests/testthat/test-db_timestamp.R deleted file mode 100644 index b95bc509..00000000 --- a/tests/testthat/test-db_timestamp.R +++ /dev/null @@ -1,24 +0,0 @@ -test_that("db_timestamp produce consistent results", { - for (conn in get_test_conns()) { - ts_posix <- Sys.time() - ts_str <- format(ts_posix) - - expect_identical( - db_timestamp(ts_posix, conn), - db_timestamp(ts_str, conn) - ) - - expect_identical( - db_timestamp(ts_posix, conn = NULL), - db_timestamp(ts_str, conn = NULL) - ) - - # Test default fallback - expect_identical( - db_timestamp.default(ts_posix, conn = conn), - db_timestamp.default(ts_str, conn = conn) - ) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-filter_keys.R b/tests/testthat/test-filter_keys.R deleted file mode 100644 index 31f8cab3..00000000 --- a/tests/testthat/test-filter_keys.R +++ /dev/null @@ -1,77 +0,0 @@ -test_that("filter_keys() works", { - for (conn in get_test_conns()) { - - x <- get_table(conn, "__mtcars") - - expect_identical( - x, - x %>% filter_keys(NULL) - ) - - filter <- x %>% utils::head(10) %>% dplyr::select("name") - expect_identical( - x %>% - dplyr::filter(name %in% !!dplyr::pull(filter, "name")) %>% - dplyr::collect(), - x %>% - filter_keys(filter) %>% - dplyr::collect() - ) - - filter <- x %>% utils::head(10) %>% dplyr::select("vs", "am") %>% dplyr::distinct() - expect_identical( - x %>% - dplyr::inner_join(filter, by = c("vs", "am")) %>% - dplyr::collect(), - x %>% - filter_keys(filter) %>% - dplyr::collect() - ) - - # Filtering with null means no filtering is done - m <- mtcars - row.names(m) <- NULL - filter <- NULL - expect_identical(filter_keys(m, filter), m) - - # Filtering by vs = 0 - filter <- data.frame(vs = 0) - expect_mapequal(filter_keys(m, filter), dplyr::filter(m, .data$vs == 0)) - - # Empty filter should result in no rows - expect_identical( - utils::head(x, 0), - x %>% filter_keys(data.frame(vs = numeric(0), am = numeric(0))) - ) - - connection_clean_up(conn) - } -}) - - -test_that("filter_keys() works with copy = TRUE", { - for (conn in get_test_conns()) { - - x <- get_table(conn, "__mtcars") - - filter <- x %>% - utils::head(10) %>% - dplyr::select("name") %>% - dplyr::collect() - - expect_identical( - x %>% - dplyr::filter(.data$name %in% !!dplyr::pull(filter, "name")) %>% - dplyr::collect(), - x %>% - filter_keys(filter, copy = TRUE) %>% - dplyr::collect() - ) - - # The above filter_keys with `copy = TRUE` generates a dbplyr_### table. - # We manually remove this since we expect it. If more arise, we will get an error. - DBI::dbRemoveTable(conn, id(utils::head(get_tables(conn, "dbplyr_"), 1))) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-getTableSignature.R b/tests/testthat/test-getTableSignature.R deleted file mode 100644 index f5859a07..00000000 --- a/tests/testthat/test-getTableSignature.R +++ /dev/null @@ -1,369 +0,0 @@ -withr::local_options("stringsAsFactors" = FALSE) # Compatibility with R < 4.0.0 - -# Generate test datasets with different data types - -# One that follows the structure in update_snapshot() -data_update_snapsnot <- data.frame( - "Date" = Sys.Date(), - "POSIXct" = Sys.time(), - "character" = "test", - "integer" = 1L, - "numeric" = 1, - "logical" = TRUE, - # .. and our special columns - "checksum" = "test", - "from_ts" = Sys.time(), - "until_ts" = Sys.time() -) - -# One that has the special columns of update_snapshot(), but not at the end -data_random <- data.frame( - "Date" = Sys.Date(), - "POSIXct" = Sys.time(), - "character" = "test", - # .. Our special columns, but not at the end - "checksum" = "test", - "from_ts" = Sys.time(), - "until_ts" = Sys.time(), - # .. - "integer" = 1L, - "numeric" = 1, - "logical" = TRUE -) - -for (conn in c(list(NULL), get_test_conns())) { - - if (is.null(conn)) { - test_that("getTableSignature() generates signature for update_snapshot() (conn == NULL)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "Date", - "POSIXct" = "POSIXct", - "character" = "character", - "integer" = "integer", - "numeric" = "numeric", - "logical" = "logical", - # .. - "checksum" = "character", - "from_ts" = "POSIXct", - "until_ts" = "POSIXct" - ) - ) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for update_snapshot() (SQLiteConnection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "TEXT", - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "SMALLINT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for update_snapshot() (PqConnection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN", - # .. - "checksum" = "CHAR(32)", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for update_snapshot() (Microsoft SQL Server)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT", - # .. - "checksum" = "CHAR(64)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for update_snapshot() (duckdb_connection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN", - # .. - "checksum" = "char(32)", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - - if (is.null(conn)) { - test_that("getTableSignature() generates signature for random data (conn == NULL)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "Date", - "POSIXct" = "POSIXct", - "character" = "character", - # .. - "checksum" = "character", - "from_ts" = "POSIXct", - "until_ts" = "POSIXct", - # .. - "integer" = "integer", - "numeric" = "numeric", - "logical" = "logical" - ) - ) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for random data (SQLiteConnection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "SMALLINT" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for random data (PqConnection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMPTZ", - "until_ts" = "TIMESTAMPTZ", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for random data (Microsoft SQL Server)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - # .. - "checksum" = "varchar(255)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME", - # .. - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for random data (duckdb_connection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - # .. - "checksum" = "STRING", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN" - ) - ) - }) - } - - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for random data on remote (SQLiteConnection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DOUBLE", # By copying to SQLite and back, information is changed by - "POSIXct" = "DOUBLE", # dbplyr / DBI so data types are now similar, but different. - "character" = "TEXT", # Dates and timestamps which are normally stored in SQLite - # .. # as internally TEXT are now converted to DOUBLE - "checksum" = "TEXT", # Logical, which have the "SMALLINT" type are now "INT" - "from_ts" = "DOUBLE", # In the next test, we check that this conversion is consistent - "until_ts" = "DOUBLE", # for the user on the local R side. - # .. - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "INT" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for random data on remote (PqConnection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMPTZ", - "until_ts" = "TIMESTAMPTZ", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for random data on remote (Microsoft SQL Server)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - # .. - "checksum" = "varchar(255)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME", - # .. - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for random data on remote (duckdb_connection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - # .. - "checksum" = "STRING", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN" - ) - ) - }) - } - - - if (!is.null(conn)) { - test_that(glue::glue("getTableSignature() generates consistent data types ({class(conn)})"), { - # This tests that the data types are consistent when copying to a remote table with getTableSignature(). - # We first copy the data to a remote table, then copy that table to another remote table on the same connection. - # The - remote_data_1 <- dplyr::copy_to( - conn, - data_random, - name = "remote_data_1", - types = getTableSignature(data_random, conn) - ) - remote_data_2 <- dplyr::copy_to( - conn, - remote_data_1, - name = "remote_data_2", - types = getTableSignature(remote_data_1, conn) - ) - - # The table signatures are not always the same (eg. SQLiteConnection). - if (inherits(conn, "SQLiteConnection")) { - expect_false(identical( # In lieu of expect_not_identical - getTableSignature(data_random, conn), - getTableSignature(remote_data_1, conn) - )) - expect_identical( # nolint: expect_named_linter - names(getTableSignature(data_random, conn)), - names(getTableSignature(remote_data_1, conn)) - ) - } else { - expect_identical( - getTableSignature(data_random, conn), - getTableSignature(remote_data_1, conn) - ) - } - - # But the data, when transfered locally, should be the same - expect_identical(dplyr::collect(remote_data_2), dplyr::collect(remote_data_1)) - }) - } - - if (!is.null(conn)) connection_clean_up(conn) -} diff --git a/tests/testthat/test-get_table.R b/tests/testthat/test-get_table.R deleted file mode 100644 index c2bef1b5..00000000 --- a/tests/testthat/test-get_table.R +++ /dev/null @@ -1,130 +0,0 @@ -test_that("get_table() returns list of tables if no table is requested", { - for (conn in get_test_conns()) { - - expect_message( - get_table(conn), - regexp = "Select one of the following tables:" - ) - - connection_clean_up(conn) - } -}) - - -test_that("get_table() works when tables/view exist", { - for (conn in get_test_conns()) { - - mtcars_t <- tibble::tibble(mtcars %>% dplyr::mutate(name = rownames(mtcars))) - - # Lets try different ways to read __mtcars (added during setup) - expect_mapequal(get_table(conn, "__mtcars") %>% dplyr::collect(), mtcars_t) - expect_identical(get_table(conn, id("__mtcars")) %>% dplyr::collect(), mtcars_t) - t <- "__mtcars" - expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) - t <- id("__mtcars") - expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) - - # And test.mtcars (added during setup) - expect_identical(get_table(conn, "test.mtcars") %>% dplyr::collect(), mtcars_t) - expect_identical(get_table(conn, id("test.mtcars", conn)) %>% dplyr::collect(), mtcars_t) - t <- "test.mtcars" - expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) - t <- id("test.mtcars", conn) - expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) - - - # Check for the existence of views on backends that support it (added here) - if (checkmate::test_multi_class(conn, c("PqConnection", "Microsoft SQL Server"))) { - - if (inherits(conn, "PqConnection")) { - DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT * FROM __mtcars LIMIT 10") - } else if (inherits(conn, "Microsoft SQL Server")) { - DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT TOP 10 * FROM __mtcars") - } - - view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") - - expect_identical(nrow(get_table(conn, view_1)), 10L) - expect_identical( - dplyr::collect(get_table(conn, view_1)), - dplyr::collect(utils::head(get_table(conn, "__mtcars"), 10)) - ) - - DBI::dbExecute(conn, glue::glue("DROP VIEW {view_1}")) - } - - - connection_clean_up(conn) - } -}) - - -test_that("get_table() works when table does not exist in default schema", { - for (conn in get_test_conns()) { - - # Generate table in default schema that does not exist - k <- 0 - while (k < 100) { - invalid_table_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") - k <- k + 1 - if (DBI::dbExistsTable(conn, id(invalid_table_name, conn))) next - break - } - - if (k < 100) { - - expect_error( - get_table(conn, invalid_table_name), - regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") - ) - expect_error( - get_table(conn, id(invalid_table_name, conn)), - regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") - ) - expect_error( - get_table(conn, id(invalid_table_name)), - regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") - ) - - } else { - warning("Non-existing table in default schema could not be generated!", call. = FALSE) - } - - connection_clean_up(conn) - } -}) - - -test_that("get_table() works when table does not exist in non-existing schema", { - for (conn in get_test_conns()) { - - # Generate schema that does not exist - k <- 0 - while (k < 100) { - invalid_schema_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") - k <- k + 1 - if (schema_exists(conn, invalid_schema_name)) next - break - } - - if (k < 100) { - - # Test some malformed inputs - invalid_table_name <- paste(invalid_schema_name, "mtcars", sep = ".") - - expect_error( - get_table(conn, invalid_table_name), - regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") - ) - expect_error( - get_table(conn, id(invalid_table_name, conn)), - regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") - ) - - } else { - warning("Non-existing schema could not be generated!", call. = FALSE) - } - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-get_tables.R b/tests/testthat/test-get_tables.R deleted file mode 100644 index be9656e7..00000000 --- a/tests/testthat/test-get_tables.R +++ /dev/null @@ -1,163 +0,0 @@ -test_that("get_tables() works without pattern", { - for (conn in get_test_conns()) { - - # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) - # For SQLite connections, we don't always have the "test" schema, so we check for its existence - # and use default schema if it does not exist. - table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") - table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") - - # Check for the existence of views on backends that support it (added here) - if (inherits(conn, "PqConnection")) { - - DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT * FROM __mtcars LIMIT 10") - view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") - - } else if (inherits(conn, "Microsoft SQL Server")) { - - DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT TOP 10 * FROM __mtcars") - view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") - - } else { - view_1 <- NULL - } - - - # Pull the tables and compare with expectation - tables <- get_tables(conn) - expect_s3_class(tables, "data.frame") - - db_table_names <- tables %>% - tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% - dplyr::pull(db_table_name) - - # We should not get tables twice - expect_setequal(db_table_names, unique(db_table_names)) - - # Our test tables should be present - checkmate::expect_subset(c(table_1, table_2, view_1), db_table_names) - - - # Drop the view - if (checkmate::test_multi_class(conn, c("PqConnection", "Microsoft SQL Server"))) { - DBI::dbExecute(conn, glue::glue("DROP VIEW {view_1}")) - } - - connection_clean_up(conn) - } -}) - - -test_that("get_tables() works with pattern", { - for (conn in get_test_conns()) { - - # Call with pattern - db_table_names <- get_tables(conn, pattern = "__mt") %>% - tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% - dplyr::pull(db_table_name) - - - # We should not get tables twice - expect_setequal(db_table_names, unique(db_table_names)) - - # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) - # For SQLite connections, we don't always have the "test" schema, so we check for its existence - # and use default schema if it does not exist. - table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") - table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") - - # Our test table that matches the pattern should be present - expect_false(table_1 %in% db_table_names) - expect_true(table_2 %in% db_table_names) - - connection_clean_up(conn) - } -}) - - -test_that("get_tables() works with temporary tables", { - for (conn in get_test_conns()) { - - # Create temporary table - tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) - tmp_id <- id(tmp) - tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") - - db_table_names <- get_tables(conn, show_temporary = TRUE) %>% - tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% - dplyr::pull(db_table_name) - - - # We should not get tables twice - expect_setequal(db_table_names, unique(db_table_names)) - - # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) - # For SQLite connections, we don't always have the "test" schema, so we check for its existence - # and use default schema if it does not exist. - table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") - table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") - - # Our test tables should be present - checkmate::expect_subset(c(table_1, table_2, tmp_name), db_table_names) - - connection_clean_up(conn) - - print("DBI::dbIsValid(conn)") - print(DBI::dbIsValid(conn)) - print("DBI::dbExistsTable(conn, tmp_id)") - print(DBI::dbExistsTable(conn, tmp_id)) - print("DBI::dbRemoveTable(conn, tmp_id)") - print(DBI::dbRemoveTable(conn, tmp_id)) - } -}) - - -test_that("get_tables() works without temporary tables", { - for (conn in get_test_conns()) { - - # Create temporary table - tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) - tmp_id <- id(tmp) - tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") - - db_table_names <- get_tables(conn, show_temporary = FALSE) %>% - tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% - dplyr::pull(db_table_name) - - # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) - # For SQLite connections, we don't always have the "test" schema, so we check for its existence - # and use default schema if it does not exist. - table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") - table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") - - # Our permanent test tables should be present - checkmate::expect_subset(c(table_1, table_2), db_table_names) - - # But not our temporary tables - checkmate::expect_disjunct(tmp_name, db_table_names) - - connection_clean_up(conn) - } -}) - - -test_that("get_tables() matches the pattern of SCDB::id", { - for (conn in get_test_conns()) { - - # Test for both a permanent table and a temporary table - permanent_table <- id("test.mtcars", conn = conn) - - tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) - defer_db_cleanup(tmp) - temporary_table <- id(tmp) - - # Check tables can be found by get_tables with pattern - expect_identical(nrow(get_tables(conn, pattern = paste0("^", as.character(permanent_table)))), 1L) - expect_identical(id(get_tables(conn, pattern = paste0("^", as.character(permanent_table)))), permanent_table) - - expect_identical(nrow(get_tables(conn, pattern = paste0("^", as.character(temporary_table)))), 1L) - expect_identical(id(get_tables(conn, pattern = paste0("^", as.character(temporary_table)))), temporary_table) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-interlace.R b/tests/testthat/test-interlace.R deleted file mode 100644 index a85f1787..00000000 --- a/tests/testthat/test-interlace.R +++ /dev/null @@ -1,53 +0,0 @@ -test_that("interlace.tbl_sql() works", { - for (conn in get_test_conns()) { - - t1 <- data.frame(key = c("A", "A", "B"), - obs_1 = c(1, 2, 2), - valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-01-01")), - valid_until = as.Date(c("2021-02-01", "2021-03-01", NA))) - - - t2 <- data.frame(key = c("A", "B"), - obs_2 = c("a", "b"), - valid_from = as.Date(c("2021-01-01", "2021-01-01")), - valid_until = as.Date(c("2021-04-01", NA))) - - - t_ref <- data.frame(key = c("A", "A", "A", "B"), - obs_1 = c(1, 2, NA, 2), - obs_2 = c("a", "a", "a", "b"), - valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-03-01", "2021-01-01")), - valid_until = as.Date(c("2021-02-01", "2021-03-01", "2021-04-01", NA))) - - - # Copy t1, t2 and t_ref to conn - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE) - t_ref <- dplyr::copy_to(conn, t_ref, name = id("test.SCDB_tmp3", conn), overwrite = TRUE, temporary = FALSE) - - - # Order of records may be different, so we arrange then check if they are identical - expect_identical(interlace(list(t1, t2), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from), - t_ref %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from)) - - # Order of columns will be different, so we only require a mapequal - # .. but order of records can still be different - expect_mapequal(interlace(list(t1, t2), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from), - interlace(list(t2, t1), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from)) - - connection_clean_up(conn) - } -}) - - -test_that("interlace returns early if length(table) == 1", { - expect_identical(mtcars["mpg"], interlace(list(mtcars["mpg"]), by = "mpg")) -}) diff --git a/tests/testthat/test-locks.R b/tests/testthat/test-locks.R deleted file mode 100644 index ed5e2da2..00000000 --- a/tests/testthat/test-locks.R +++ /dev/null @@ -1,98 +0,0 @@ -test_that("lock helpers works in default and test schema", { - for (conn in get_test_conns()) { - for (schema in list(NULL, "test")) { - - # Define the testing tables - test_table_id <- id(paste(c(schema, "mtcars"), collapse = "."), conn) - lock_table_id <- id(paste(c(schema, "locks"), collapse = "."), conn) - - - ## Check we can add locks - expect_true(lock_table(conn, db_table = test_table_id, schema = schema)) - - db_lock_table <- dplyr::tbl(conn, lock_table_id) - expect_identical(colnames(db_lock_table), c("schema", "table", "user", "lock_start", "pid")) - - expect_identical( - dplyr::collect(dplyr::select(db_lock_table, !"lock_start")), - tibble::tibble( - "schema" = purrr::pluck(test_table_id, "name", "schema"), - "table" = purrr::pluck(test_table_id, "name", "table"), - "user" = Sys.info()[["user"]], - "pid" = as.numeric(Sys.getpid()) - ) - ) - - - - ## Check we can remove locks - expect_null(unlock_table(conn, db_table = test_table_id, schema = schema)) - expect_identical(nrow(db_lock_table), 0L) - - - - # Add an invalid lock that we do not own - dplyr::rows_append( - db_lock_table, - tibble::tibble( - "schema" = purrr::pluck(test_table_id, "name", "schema"), - "table" = purrr::pluck(test_table_id, "name", "table"), - "user" = "some_other_user", - "lock_start" = as.numeric(Sys.time()), - "pid" = 0.5 - ), - in_place = TRUE, - copy = TRUE - ) - expect_identical(nrow(db_lock_table), 1L) - - ## Check invalid lock owners are flagged - not_on_cran <- interactive() || identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("CI"), "true") - if (not_on_cran) { # Detection of currently valid PID does not work on CRAN machines, therefore no error is thrown - expect_error( - lock_table(conn, test_table_id, schema = schema), - glue::glue( - "Active lock \\(user = some_other_user, PID = 0.5\\) on table {test_table_id} is no longer a valid PID! ", - "Process likely crashed before completing." - ) - ) - } - - # Remove the lock - unlock_table(conn, db_table = test_table_id, schema = schema, pid = 0.5) - expect_identical(nrow(db_lock_table), 0L) - - - - ## Check that we cannot steal locks - # Get the PID of a background process that will linger for a while - bg_process <- callr::r_bg(function() Sys.sleep(10)) - expect_false(bg_process$get_pid() == Sys.getpid()) - - # Add a valid lock that we do not own - dplyr::rows_append( - db_lock_table, - tibble::tibble( - "schema" = purrr::pluck(test_table_id, "name", "schema"), - "table" = purrr::pluck(test_table_id, "name", "table"), - "user" = "some_other_user", - "lock_start" = as.numeric(Sys.time()), - "pid" = bg_process$get_pid() - ), - in_place = TRUE, - copy = TRUE - ) - - ## Check we cannot achieve table lock - expect_false(lock_table(conn, test_table_id, schema = schema)) - - # Remove the lock - unlock_table(conn, db_table = test_table_id, schema = schema, pid = bg_process$get_pid()) - expect_identical(nrow(db_lock_table), 0L) - - # Clean up - DBI::dbRemoveTable(conn, lock_table_id) - } - close_connection(conn) - } -}) diff --git a/tests/testthat/test-slice_time.R b/tests/testthat/test-slice_time.R deleted file mode 100644 index 10de7437..00000000 --- a/tests/testthat/test-slice_time.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("slice_time() works", { - for (conn in get_test_conns()) { - - # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically - xx <- get_table(conn, "__mtcars") %>% - dplyr::mutate(checksum = dplyr::row_number(), - from_ts = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), - until_ts = NA_character_) - - expect_identical(nrow(slice_time(xx, "2022-05-01")), 0L) - expect_identical(nrow(slice_time(xx, "2022-06-01")), 20L) - expect_identical(nrow(slice_time(xx, "2022-06-15")), nrow(mtcars)) - - connection_clean_up(conn) - } -}) - - -test_that("slice_time() works with non-standard columns", { - for (conn in get_test_conns()) { - - # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically - xx <- get_table(conn, "__mtcars") %>% - dplyr::mutate(checksum = dplyr::row_number(), - valid_from = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), - valid_until = NA_character_) - - expect_identical(nrow(slice_time(xx, "2022-05-01", from_ts = "valid_from", until_ts = "valid_until")), 0L) - expect_identical(nrow(slice_time(xx, "2022-06-01", from_ts = "valid_from", until_ts = "valid_until")), 20L) - expect_identical(nrow(slice_time(xx, "2022-06-15", from_ts = "valid_from", until_ts = "valid_until")), nrow(mtcars)) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-unite.tbl_dbi.R b/tests/testthat/test-unite.tbl_dbi.R deleted file mode 100644 index 9e524adf..00000000 --- a/tests/testthat/test-unite.tbl_dbi.R +++ /dev/null @@ -1,63 +0,0 @@ -test_that("unite.tbl_dbi() works", { - for (conn in get_test_conns()) { - - q <- get_table(conn, "__mtcars") %>% utils::head(1) - qu_remove <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp) %>% - dplyr::compute(name = unique_table_name()) - qu <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp, remove = FALSE) %>% - dplyr::compute(name = unique_table_name()) - qu_alt <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", "mpg", "hp", remove = FALSE) %>% - dplyr::compute(name = unique_table_name()) - - expect_s3_class(qu_remove, "tbl_dbi") - expect_s3_class(qu, "tbl_dbi") - expect_s3_class(qu_alt, "tbl_dbi") - - expect_identical(colnames(qu_remove), "new_column") - expect_identical(colnames(qu), c("new_column", "mpg", "hp")) - expect_identical(colnames(qu_alt), c("new_column", "mpg", "hp")) - - expect_identical(dplyr::collect(qu), dplyr::collect(qu_alt)) - - # tidyr::unite has some quirky (and FUN!!! behavior) that we are forced to match here - # specifically, the input "col" is converted to a symbol, so we have to do escape-bullshit - # NOTE: the line "dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% " - # is to account for SQLite not having integer data-types. If we do not first convert to character, - # there will be differences between the objects that are trivial, so we remove these with this operation - # this way, the test should (hopefully) only fail if there are non-trivial differences - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite("new_col", mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite("new_col", mpg, hp)) - - col <- "new_col" - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite(col, mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite(col, mpg, hp)) - - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite(!!col, mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite(!!col, mpg, hp)) - - # Unite places cols in a particular way, lets be sure we match - qq <- dplyr::mutate(q, dplyr::across(tidyselect::everything(), as.character)) # we convert to character since SQLite - expect_identical(qq %>% tidyr::unite("test_col", vs, am) %>% dplyr::collect(), - qq %>% dplyr::collect() %>% tidyr::unite("test_col", vs, am)) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-update_snapshot.R b/tests/testthat/test-update_snapshot.R deleted file mode 100644 index 0e5cff69..00000000 --- a/tests/testthat/test-update_snapshot.R +++ /dev/null @@ -1,650 +0,0 @@ -test_that("update_snapshot() can handle first snapshot", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - expect_false(table_exists(conn, "test.SCDB_logs")) - - # Use unmodified mtcars as the initial snapshot - .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-01 09:00:00" - log_path <- tempdir() - - # Ensure all logs are removed - dir(log_path) %>% - purrr::keep(~ endsWith(., ".log")) %>% - purrr::walk(~ unlink(file.path(log_path, .))) - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - # Update - update_snapshot(.data, conn, db_table, timestamp, logger = logger) - - # Confirm snapshot is transferred correctly - expect_identical( - get_table(conn, db_table) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - - - ### For this test, we also check that the log output is correct ### - # Check file log outputs exists - log_pattern <- glue::glue("{stringr::str_replace_all(as.Date(timestamp), '-', '_')}.{id(db_table, conn)}.log") - log_file <- purrr::keep(dir(log_path), ~ stringr::str_detect(., log_pattern)) - expect_length(log_file, 1) - expect_gt(file.info(file.path(log_path, log_file))$size, 0) - expect_identical(nrow(get_table(conn, "test.SCDB_logs")), 1L) - - db_logs_with_log_file <- get_table(conn, "test.SCDB_logs") %>% - dplyr::filter(!is.na(.data$log_file)) - expect_identical(nrow(db_logs_with_log_file), 1L) - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% dplyr::collect() - - # The logs should have specified data types - types <- c( - "date" = "POSIXct", - "catalog" = "character", - "schema" = "character", - "table" = "character", - "n_insertions" = "numeric", - "n_deactivations" = "numeric", - "start_time" = "POSIXct", - "end_time" = "POSIXct", - "duration" = "character", - "success" = "logical", - "message" = "character" - ) - - if (inherits(conn, "SQLiteConnection")) { - types <- types %>% - purrr::map_if(~ identical(., "POSIXct"), "character") %>% # SQLite does not support POSIXct - purrr::map_if(~ identical(., "logical"), "numeric") %>% # SQLite does not support logical - as.character() - } - - checkmate::expect_data_frame(logs, nrows = 1, types) - - # Check the content of the log table - expect_identical(as.character(logs$date), as.character(timestamp)) - - db_table_id <- id(db_table, conn) - if ("catalog" %in% colnames(logs)) expect_identical(logs$catalog, purrr::pluck(db_table_id, "name", "catalog")) - expect_identical(logs$schema, purrr::pluck(db_table_id, "name", "schema")) - expect_identical(logs$table, purrr::pluck(db_table_id, "name", "table")) - - expect_identical(logs$n_insertions, nrow(mtcars)) - expect_identical(logs$n_deactivations, 0L) - expect_true(as.logical(logs$success)) - expect_identical(logs$message, NA_character_) - - - # Clean up the logs - unlink(logger$log_realpath) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can add a new snapshot", { - for (conn in get_test_conns()) { - - # Modify snapshot and run update step - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 130, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-03 09:00:00" - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - - # Update - # This is a simple update where 15 rows are replaced with 15 new ones on the given date - update_snapshot(.data, conn, db_table, timestamp, logger = logger) - - # Check the snapshot has updated correctly - target <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::as_tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-03 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-03 09:00:00")), - nrow(mtcars) - ) - - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% - dplyr::collect() %>% - utils::tail(1) - - expect_identical(logs$n_insertions, 15L) - expect_identical(logs$n_deactivations, 15L) - expect_true(as.logical(logs$success)) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can update a snapshot on an existing date", { - for (conn in get_test_conns()) { - - # We now attempt to do another update on the same date - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 100, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-03 09:00:00" - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - - # This is a more complicated update where a further 8 rows are replaced with 8 new ones on the same date as before - update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = logger) - - # Even though we insert twice on the same date, we expect the data to be minimal (compacted) - target <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-03 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-03 09:00:00")), - nrow(mtcars) - ) - - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% - dplyr::collect() %>% - utils::tail(1) - - expect_identical(logs$n_insertions, 8L) - expect_identical(logs$n_deactivations, 8L) - expect_true(as.logical(logs$success)) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can insert a snapshot between existing dates", { - for (conn in get_test_conns()) { - - # We now attempt to an update between these two updates - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 150, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # This should fail if we do not specify "enforce_chronological_order = FALSE" - expect_error( - update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", logger = LoggerNull$new()), - regexp = "Given timestamp 2022-10-02 09:00:00 is earlier" - ) - - # But not with the variable set - update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", - logger = LoggerNull$new(), enforce_chronological_order = FALSE) - - - target <- dplyr::tbl(conn, id("test.SCDB_tmp1", conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-02 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-02 09:00:00")), - nrow(mtcars) - ) - - close_connection(conn) - } -}) - - - -test_that("update_snapshot() works (holistic test 1)", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - - - # Create test data for the test - t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) - t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) - t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) - - # Copy t0, t1, and t2 to conn - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - logger <- LoggerNull$new() - update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01 08:00:00", logger = logger) - expect_identical( - dplyr::collect(t0) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - update_snapshot( - t1, - conn, - "test.SCDB_tmp1", - "2022-01-01 08:10:00", - logger = logger, - collapse_continuous_records = TRUE - ) - expect_identical( - dplyr::collect(t1) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - update_snapshot( - t2, - conn, - "test.SCDB_tmp1", - "2022-01-01 08:10:00", - logger = logger, - collapse_continuous_records = TRUE - ) - expect_identical( - dplyr::collect(t2) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - t <- list(t0, t1, t2) %>% - purrr::reduce(dplyr::union) %>% - dplyr::collect() %>% - dplyr::mutate(col2 = as.character(col2)) %>% - dplyr::arrange(col1, col2) %>% - utils::head(5) - - t_ref <- get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% - dplyr::select(!any_of(c("from_ts", "until_ts", "checksum"))) %>% - dplyr::collect() %>% - dplyr::mutate(col2 = as.character(col2)) %>% - dplyr::arrange(col1, col2) - - expect_identical(t, t_ref) - - close_connection(conn) - } -}) - -test_that("update_snapshot() works (holistic test 2)", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - - - # Create test data for the test - t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) - t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) - t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) - - # Copy t0, t1, and t2 to conn (and suppress check_from message) - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - # Check non-chronological insertion - logger <- LoggerNull$new() - update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01", logger = logger) - expect_identical(dplyr::collect(t0) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) - - update_snapshot(t2, conn, "test.SCDB_tmp1", "2022-03-01", logger = logger) - expect_identical(dplyr::collect(t2) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) - - update_snapshot(t1, conn, "test.SCDB_tmp1", "2022-02-01", logger = logger, enforce_chronological_order = FALSE) - expect_identical( - dplyr::collect(t1) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1", slice_ts = "2022-02-01")) %>% dplyr::arrange(col1) - ) - - t_ref <- - tibble::tibble(col1 = c("A", "B", "A", "C", "B", "C"), - col2 = c(NA_real_, NA_real_, 1, NA_real_, 2, 3), - from_ts = c("2022-01-01", "2022-01-01", "2022-02-01", "2022-02-01", "2022-03-01", "2022-03-01"), - until_ts = c("2022-02-01", "2022-03-01", NA, "2022-03-01", NA, NA)) - - expect_identical( - get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% - dplyr::select(!"checksum") %>% - dplyr::collect() %>% - dplyr::mutate(from_ts = strftime(from_ts), - until_ts = strftime(until_ts)) %>% - dplyr::arrange(col1, from_ts), - t_ref %>% - dplyr::arrange(col1, from_ts) - ) - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() handles 'NULL' updates", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) - - # Use mtcars as the test data set - .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - defer_db_cleanup(.data) - - # This is a simple update where 23 rows are replaced with 23 new ones on the given date - db_table <- "test.SCDB_tmp1" - - create_logger <- function(timestamp) { - Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - } - - # Update the table with update_snapshot() and store the results - update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = create_logger("2022-10-03 09:00:00")) - target_data_1 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() - - # Update the table with the same data again update_snapshot() and store the results - update_snapshot(.data, conn, db_table, "2022-10-04 09:00:00", logger = create_logger("2022-10-04 09:00:00")) - target_data_2 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() - - # Check that the two updates are identical - expect_identical(target_data_1, target_data_2) - - # Confirm with logs that no updates have been made - logs <- get_table(conn, id("test.SCDB_logs", conn)) %>% - dplyr::collect() %>% - dplyr::arrange(date) - - expect_identical(logs$n_insertions, c(nrow(mtcars), 0L)) - expect_identical(logs$n_deactivations, c(0L, 0L)) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() works with Id objects", { - withr::local_options("SCDB.log_path" = NULL) # No file logging - - for (conn in get_test_conns()) { - - target_table <- id("test.mtcars_modified", conn) - - logger <- Logger$new(output_to_console = FALSE, - timestamp = Sys.time(), - db_table = "test.mtcars_modified", - log_conn = NULL, - log_table_id = NULL, - warn = FALSE) - - expect_no_error( - mtcars %>% - dplyr::mutate(disp = sample(mtcars$disp, nrow(mtcars))) %>% - dplyr::copy_to(dest = conn, df = ., name = unique_table_name(), analyze = FALSE) %>% - update_snapshot( - conn = conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() checks table formats", { - - withr::local_options("SCDB.log_path" = tempdir()) - - for (conn in get_test_conns()) { - - mtcars_table <- dplyr::tbl(conn, id("__mtcars_historical", conn = conn)) - timestamp <- Sys.time() - - expect_warning( - logger <- Logger$new(log_path = NULL, log_table_id = NULL, output_to_console = FALSE), # nolint: implicit_assignment_linter - "NO file or database logging will be done." - ) - - # Test columns not matching - broken_table <- dplyr::copy_to(conn, dplyr::select(mtcars, !"mpg"), name = "mtcars_broken", overwrite = TRUE, analyze = FALSE) - - expect_error( - update_snapshot( - .data = broken_table, - conn = conn, - db_table = mtcars_table, - timestamp = timestamp, - logger = logger - ), - "Columns do not match!" - ) - - file.remove(list.files(getOption("SCDB.log_path"), pattern = format(timestamp, "^%Y%m%d.%H%M"), full.names = TRUE)) - - # Test target table not being a historical table - expect_error( - update_snapshot( - dplyr::tbl(conn, id("__mtcars", conn = conn)), - conn, - id("__mtcars", conn = conn), - timestamp = timestamp, - logger = logger - ), - "Table does not seem like a historical table" - ) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() works with across connection", { - skip_if_not_installed("RSQLite") - - withr::local_options("SCDB.log_path" = NULL) # No file logging - - # Test a data transfer from a local SQLite to the test connection - source_conn <- DBI::dbConnect(RSQLite::SQLite()) - - # Create a table for the tests - mtcars_modified <- mtcars %>% - dplyr::mutate(name = rownames(mtcars)) - - # Copy table to the source - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) - - # For each conn, we test if update_snapshot preserves data types - for (target_conn in get_test_conns()) { - - target_table <- id("test.mtcars_modified", target_conn) - if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) - - logger <- LoggerNull$new() - - # Check we can transfer without error - expect_no_error( - update_snapshot( - .data, - conn = target_conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - # Check that if we collect the table, the signature will match the original - table_signature <- get_table(target_conn, target_table) %>% - dplyr::collect() %>% - dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% - as.data.frame() - - expect_identical( - table_signature, - dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) - ) - - - DBI::dbRemoveTable(target_conn, target_table) - connection_clean_up(target_conn) - rm(logger) - invisible(gc()) - } - connection_clean_up(source_conn) - - - ## Now we test the reverse transfer - - # Test a data transfer from the test connection to a local SQLite - target_conn <- DBI::dbConnect(RSQLite::SQLite()) - - # For each conn, we test if update_snapshot preserves data types - for (source_conn in get_test_conns()) { - - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) - - target_table <- id("mtcars_modified", target_conn) - if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) - - logger <- LoggerNull$new() - - # Check we can transfer without error - expect_no_error( - update_snapshot( - .data, - conn = target_conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - # Check that if we collect the table, the signature will match the original - table_signature <- get_table(target_conn, target_table) %>% - dplyr::collect() %>% - dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% - as.data.frame() - - expect_identical( - table_signature, - dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) - ) - - - connection_clean_up(source_conn) - rm(logger) - invisible(gc()) - } - connection_clean_up(target_conn) -}) diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R deleted file mode 100644 index e59aa49b..00000000 --- a/tests/testthat/test-zzz.R +++ /dev/null @@ -1,12 +0,0 @@ -# Do clean up on the connections -for (conn in get_test_conns()) { - purrr::walk(c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", - "test.SCDB_logs", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", - "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2"), - ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn))) - - purrr::walk(c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), - ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .)) - - connection_clean_up(conn) -} From bebc2dd693f99b7a2f3e8bea628e9da68fecd440 Mon Sep 17 00:00:00 2001 From: RasmusSkytte Date: Thu, 13 Nov 2025 22:25:45 +1100 Subject: [PATCH 118/129] chore: Update pak.lock --- pak.lock | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/pak.lock b/pak.lock index e94821d8..06f4fa88 100644 --- a/pak.lock +++ b/pak.lock @@ -3825,7 +3825,7 @@ "RemoteRef": "RSQLite", "RemoteRepos": "https://p3m.dev/cran/__linux__/noble/latest", "RemotePkgPlatform": "x86_64-pc-linux-gnu-ubuntu-24.04", - "RemoteSha": "2.4.3" + "RemoteSha": "2.4.4" }, "needscompilation": false, "package": "RSQLite", @@ -3833,12 +3833,12 @@ "platform": "x86_64-pc-linux-gnu-ubuntu-24.04", "repotype": "cran", "rversion": "4.5", - "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/RSQLite_2.4.3.tar.gz", + "sources": "https://p3m.dev/cran/__linux__/noble/latest/src/contrib/RSQLite_2.4.4.tar.gz", "sysreqs": "", "sysreqs_packages": {}, - "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/RSQLite_2.4.3.tar.gz", + "target": "src/contrib/x86_64-pc-linux-gnu-ubuntu-24.04/4.5/RSQLite_2.4.4.tar.gz", "type": "standard", - "version": "2.4.3", + "version": "2.4.4", "vignettes": false }, { From d270c4dfd6af38fd7808015c49f2d73d594e4986 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 12:39:10 +0100 Subject: [PATCH 119/129] retrieve posix as strings --- R/backend_oracle.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 7622f418..20318723 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -432,7 +432,7 @@ rjdbc_fetch <- function( function(i) rJava::.jcall(rp, "[Ljava/lang/String;", "getStrings", i), function(i) rJava::.jcall(rp, "[D", "getDoubles", i), function(i) rJava::.jcall(rp, "[I", "getIntegers", i), - function(i) rJava::.jcall(rp, "[D", "getDoubles", i), + function(i) rJava::.jcall(rp, "[Ljava/lang/String;", "getStrings", i), function(i) as.logical(rJava::.jcall(rp, "[I", "getIntegers", i)) ) From 24a1b3b0df1cea358a076a99e4dc14fabd6754e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 13:00:04 +0100 Subject: [PATCH 120/129] Revert "debug: _jobjRef_dollar" This reverts commit eb22e90c5b42580c1a98d899e3862d8d4d1e3472. --- .github/workflows/oracle-reprex.yaml | 8 - R/backend_oracle.R | 10 - tests/testthat/setup.R | 45 +- tests/testthat/test-Logger.R | 544 ++++++++++++++++ tests/testthat/test-create_logs_if_missing.R | 66 ++ tests/testthat/test-db_joins.R | 219 +++++++ tests/testthat/test-db_timestamp.R | 24 + tests/testthat/test-filter_keys.R | 77 +++ tests/testthat/test-getTableSignature.R | 369 +++++++++++ tests/testthat/test-get_table.R | 130 ++++ tests/testthat/test-get_tables.R | 163 +++++ tests/testthat/test-interlace.R | 53 ++ tests/testthat/test-locks.R | 98 +++ tests/testthat/test-slice_time.R | 34 + tests/testthat/test-unite.tbl_dbi.R | 63 ++ tests/testthat/test-update_snapshot.R | 650 +++++++++++++++++++ tests/testthat/test-zzz.R | 12 + 17 files changed, 2529 insertions(+), 36 deletions(-) create mode 100644 tests/testthat/test-Logger.R create mode 100644 tests/testthat/test-create_logs_if_missing.R create mode 100644 tests/testthat/test-db_joins.R create mode 100644 tests/testthat/test-db_timestamp.R create mode 100644 tests/testthat/test-filter_keys.R create mode 100644 tests/testthat/test-getTableSignature.R create mode 100644 tests/testthat/test-get_table.R create mode 100644 tests/testthat/test-get_tables.R create mode 100644 tests/testthat/test-interlace.R create mode 100644 tests/testthat/test-locks.R create mode 100644 tests/testthat/test-slice_time.R create mode 100644 tests/testthat/test-unite.tbl_dbi.R create mode 100644 tests/testthat/test-update_snapshot.R create mode 100644 tests/testthat/test-zzz.R diff --git a/.github/workflows/oracle-reprex.yaml b/.github/workflows/oracle-reprex.yaml index e373a270..c7390d5a 100644 --- a/.github/workflows/oracle-reprex.yaml +++ b/.github/workflows/oracle-reprex.yaml @@ -164,7 +164,6 @@ jobs: print(tibble::tibble(out)) DBI::dbClearResult(r) - print("## Debug flag 1") # Start with some clean up purrr::walk( @@ -175,13 +174,11 @@ jobs: ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) ) - print("## Debug flag 2") purrr::walk( c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) ) - print("## Debug flag 3") # Copy mtcars to conn dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), @@ -191,7 +188,6 @@ jobs: analyze = FALSE ) - print("## Debug flag 4") dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), name = id("__mtcars", conn), @@ -200,7 +196,6 @@ jobs: analyze = FALSE ) - print("## Debug flag 5") dplyr::copy_to( conn, mtcars %>% @@ -216,7 +211,6 @@ jobs: analyze = FALSE ) - print("## Debug flag 6") dplyr::copy_to( conn, mtcars %>% @@ -231,7 +225,5 @@ jobs: overwrite = TRUE, analyze = FALSE ) - print("## Debug flag 7") DBI::dbDisconnect(conn) - print("## Debug flag 8") \ No newline at end of file diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 20318723..09a96467 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -380,7 +380,6 @@ rjdbc_fetch <- function( l <- vector("list", cols) cts <- rep(0L, cols) ## column type (as per JDBC) rts <- rep(0L, cols) ## retrieval types (0 = string, 1 = double, 2 = integer, 3 = POSIXct) - for (i in 1:cols) { ## possible retrieval: ## getDouble(), getTimestamp() and getString() @@ -415,9 +414,6 @@ rjdbc_fetch <- function( names(l)[i] <- rJava::.jcall(res@md, "S", "getColumnLabel", i) } - print("rts") - print(rts) - rp <- res@env$pull if (rJava::is.jnull(rp)) { rp <- rJava::.jnew( @@ -440,12 +436,6 @@ rjdbc_fetch <- function( stride <- 32768L ## start fairly small to support tiny queries and increase later while ((nrec <- rJava::.jcall(rp, "I", "fetch", stride, block)) > 0L) { for (i in seq.int(cols)) { - print("rts[i] + 1L") - print(rts[i] + 1L) - - print("ret_fn[[rts[i] + 1L]]") - print(ret_fn[[rts[i] + 1L]]) - l[[i]] <- pairlist(l[[i]], ret_fn[[rts[i] + 1L]](i)) } if (nrec < stride) break diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index b5df857f..1da66d00 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1,16 +1,32 @@ -# Configure the data bases -for (conn in get_test_conns()) { +# Ensure the target connections are empty and configured correctly +coll <- checkmate::makeAssertCollection() +conns <- get_test_conns() +for (conn_id in seq_along(conns)) { - print("## Debug flag 1") + conn <- conns[[conn_id]] - # Debug - purrr::map( - c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", - "test.SCDB_logs", "test.SCDB_logger", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", - "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2" - ), - ~ id(., conn) - ) + # Ensure connections are valid + if (is.null(conn) || !DBI::dbIsValid(conn)) { + coll$push(glue::glue("Connection could not be made to backend ({names(conns)[[conn_id]]}).")) + } + + + # Check schemas are configured correctly + if (!schema_exists(conn, "test") && names(conns)[conn_id] != "SQLite") { + coll$push(glue::glue("Tests require the schema 'test' to exist in connection ({names(conns)[[conn_id]]}).")) + } + + if (!schema_exists(conn, "test.one") && names(conns)[conn_id] != "SQLite") { + coll$push(glue::glue("Tests require the schema 'test.one' to exist in connection ({names(conns)[[conn_id]]}).")) + } + + DBI::dbDisconnect(conn) +} +checkmate::reportAssertions(coll) + + +# Configure the data bases +for (conn in get_test_conns()) { # Start with some clean up purrr::walk( @@ -21,13 +37,11 @@ for (conn in get_test_conns()) { ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn)) ) - print("## Debug flag 2") purrr::walk( c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .) ) - print("## Debug flag 3") # Copy mtcars to conn dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), @@ -37,7 +51,6 @@ for (conn in get_test_conns()) { analyze = FALSE ) - print("## Debug flag 4") dplyr::copy_to( conn, mtcars %>% dplyr::mutate(name = rownames(mtcars)), name = id("__mtcars", conn), @@ -46,7 +59,6 @@ for (conn in get_test_conns()) { analyze = FALSE ) - print("## Debug flag 5") dplyr::copy_to( conn, mtcars %>% @@ -62,7 +74,6 @@ for (conn in get_test_conns()) { analyze = FALSE ) - print("## Debug flag 6") dplyr::copy_to( conn, mtcars %>% @@ -77,10 +88,8 @@ for (conn in get_test_conns()) { overwrite = TRUE, analyze = FALSE ) - print("## Debug flag 7") DBI::dbDisconnect(conn) - print("## Debug flag 8") } diff --git a/tests/testthat/test-Logger.R b/tests/testthat/test-Logger.R new file mode 100644 index 00000000..788d237b --- /dev/null +++ b/tests/testthat/test-Logger.R @@ -0,0 +1,544 @@ +# Ensure the options that can be set are NULL for these tests +withr::local_options("SCDB.log_table_id" = NULL, "SCDB.log_path" = NULL) + +test_that("Logger: logging to console works", { + + # Create logger and test configuration + expect_warning( + logger <- Logger$new(), # nolint: implicit_assignment_linter + regexp = "NO file or database logging will be done." + ) + expect_null(logger$log_path) + expect_null(logger$log_tbl) + + # Test logging to console has the right formatting and message type + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_message( + logger$log_info("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") + ) + expect_warning( + logger$log_warn("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") + ) + expect_error( + logger$log_error("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") + ) + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("Logger: all (non-warning, non-error) logging to console can be disabled", { + + # Create logger + expect_warning( + logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter + regexp = "NO file or database logging will be done." + ) + + # Test INFO-logging to console is disabled + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_no_message(logger$log_info("test", tic = logger$start_time)) + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("Logger: logging to file works", { + + # Set options for the test + log_path <- tempdir(check = TRUE) + db_table <- "test.SCDB_logger" + + + # Create logger and test configuration + # Empty logger should use default value from options + withr::with_options( + list("SCDB.log_path" = "local/path"), + { + logger <- Logger$new(db_table = db_table, warn = FALSE) + expect_identical(logger$log_path, "local/path") + + rm(logger) + invisible(gc()) + } + ) + + # Create logger and test configuration + # Test file logging - with character timestamp + timestamp <- "2022-01-01 09:00:00" + logger <- Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = log_path, + output_to_console = FALSE, + warn = FALSE + ) + + expect_identical(logger$log_path, log_path) + expect_identical( + logger$log_filename, + glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", + "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", + "{db_table}.log") + ) + + + # Test logging to file has the right formatting and message type + expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) + tryCatch(logger$log_warn("test filewriting", tic = logger$start_time), warning = function(w) NULL) + tryCatch(logger$log_error("test filewriting", tic = logger$start_time), error = function(e) NULL) + + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_true(logger$log_filename %in% dir(log_path)) + expect_identical( + readLines(logger$log_realpath), + c( + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting"), + glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test filewriting"), + glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test filewriting") + ) + ) + + file.remove(logger$log_realpath) + rm(logger) + invisible(gc()) + + + # Create logger and test configuration + # Test file logging - with POSIX timestamp + timestamp <- as.POSIXct("2022-02-01 09:00:00") + logger <- Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = log_path, + output_to_console = FALSE, + warn = FALSE + ) + + expect_identical(logger$log_path, log_path) + expect_identical( + logger$log_filename, + glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", + "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", + "{db_table}.log") + ) + + + # Test logging to file still works + expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) + + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_true(logger$log_filename %in% dir(log_path)) + expect_identical( + readLines(logger$log_realpath), + glue::glue( + "{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting" + ) + ) + + # Clean up + file.remove(logger$log_realpath) + rm(logger) + invisible(gc()) +}) + + +test_that("Logger: log_tbl is not set when conn = NULL", { + + # Set options for the test + db_table <- "test.SCDB_logger" + timestamp <- "2022-03-01 09:00:00" + + # Create logger and test configuration + # Empty logger should use default value + logger <- Logger$new(db_table = db_table, timestamp = timestamp, warn = FALSE) + expect_null(logger$log_tbl) # log_table_id is NOT defined here, despite the option existing + # the logger does not have the connection, so cannot pull the table from conn + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("Logger: logging to database works", { + for (conn in get_test_conns()) { + + # Set options for the test + db_table <- "test.SCDB_logger" + timestamp <- "2022-04-01 09:00:00" + + # Create logger and test configuration + logger <- Logger$new(db_table = db_table, + timestamp = timestamp, + log_table_id = db_table, + log_conn = conn, + warn = FALSE) + + log_table_id <- dplyr::tbl(conn, id(db_table, conn)) + expect_identical(logger$log_tbl, log_table_id) + + + # Test Logger has pre-filled some information in the logs + db_table_id <- id(db_table, conn) + expect_identical(as.character(dplyr::pull(log_table_id, "date")), timestamp) + if ("catalog" %in% purrr::pluck(db_table_id, "name", names)) { + expect_identical(dplyr::pull(log_table_id, "catalog"), purrr::pluck(db_table_id, "name", "catalog")) + } + expect_identical(dplyr::pull(log_table_id, "schema"), purrr::pluck(db_table_id, "name", "schema")) + expect_identical(dplyr::pull(log_table_id, "table"), purrr::pluck(db_table_id, "name", "table")) + expect_identical( # Transferring start_time to database can have some loss of information that we need to match + format(as.POSIXct(dplyr::pull(log_table_id, "start_time")), "%F %R:%S"), + format(logger$start_time, "%F %R:%S") + ) + + + # Test logging to database writes to the correct fields + logger$log_to_db(n_insertions = 42) + expect_identical(nrow(log_table_id), 1L) + expect_identical(dplyr::pull(log_table_id, "n_insertions"), 42L) + + logger$log_to_db(n_deactivations = 60) + expect_identical(nrow(log_table_id), 1L) + expect_identical(dplyr::pull(log_table_id, "n_deactivations"), 60L) + + + # Clean up + rm(logger) + invisible(gc()) + + connection_clean_up(conn) + } +}) + + +test_that("Logger: all logging simultaneously works", { + for (conn in get_test_conns()) { + + # Set options for the test + log_path <- tempdir(check = TRUE) + db_table <- "test.SCDB_logger" + timestamp <- "2022-05-01 09:00:00" + + # Create logger and test configuration + logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_path = log_path, + log_table_id = db_table, log_conn = conn, warn = FALSE) + + log_table_id <- dplyr::tbl(conn, id(db_table, conn)) + expect_identical(logger$log_path, log_path) + expect_identical(logger$log_tbl, log_table_id) + expect_identical( + logger$log_filename, + glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", + "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", + "{id(db_table, conn)}.log") + ) + + # Test logging to console has the right formatting and message type + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_message( + logger$log_info("test console and filewriting", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting") + ) + expect_warning( + logger$log_warn("test console and filewriting", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting") + ) + expect_error( + logger$log_error("test console and filewriting", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") + ) + + + # Test logging to file has the right formatting and message type + expect_true(logger$log_filename %in% dir(log_path)) + expect_identical( + readLines(logger$log_realpath), + c( + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting"), + glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting"), + glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") + ) + ) + + + # Test logging to database writes to the correct fields + logger$log_to_db(n_insertions = 13) + expect_identical(nrow(log_table_id), 2L) + expect_identical(dplyr::pull(log_table_id, "n_insertions"), c(42L, 13L)) + + logger$log_to_db(n_deactivations = 37) + expect_identical(nrow(log_table_id), 2L) + expect_identical(dplyr::pull(log_table_id, "n_deactivations"), c(60L, 37L)) + + + # Clean up + file.remove(logger$log_realpath) + rm(logger) + invisible(gc()) + + connection_clean_up(conn) + } +}) + + +test_that("Logger: file logging stops if file exists", { + + # Set options for the test + log_path <- tempdir(check = TRUE) + db_table <- "test.SCDB_logger" + timestamp <- Sys.time() + + # Create logger1 and logger2 which uses the same file + # Since start_time is the same for both + logger1 <- Logger$new( + db_table = db_table, + timestamp = timestamp, + start_time = timestamp, + log_path = log_path, + output_to_console = FALSE + ) + + logger2 <- Logger$new( + db_table = db_table, + timestamp = timestamp, + start_time = timestamp, + log_path = log_path, + output_to_console = FALSE + ) + + + # logger1 should be able to successfully write + logger1$log_info("test message") + + + # whereas logger2 should fail since the log file now exists + expect_error( + logger2$log_info("test message"), + glue::glue("Log file '{logger1$log_filename}' already exists!") + ) + + # .. and it should do it persistently + expect_error( + logger2$log_info("test message"), + glue::glue("Log file '{logger1$log_filename}' already exists!") + ) + + # Clean up + file.remove(logger1$log_realpath) + rm(logger1, logger2) + invisible(gc()) +}) + + +test_that("Logger: console output may be disabled", { + + # First test cases with output_to_console == FALSE + # Here, only print when explicitly stated + expect_warning( + logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter + regexp = "NO file or database logging will be done." + ) + + expect_no_message(logger$log_info("Whoops! This should not have been printed!")) + + expect_no_message(logger$log_info("Whoops! This should not have been printed either!", output_to_console = FALSE)) + + expect_message( + logger$log_info("This line should be printed", output_to_console = TRUE), + "This line should be printed" + ) + + rm(logger) + + # ...and now, only suppress printing when explicitly stated + expect_warning( + logger <- Logger$new(output_to_console = TRUE), # nolint: implicit_assignment_linter + regexp = "NO file or database logging will be done." + ) + + expect_message( + logger$log_info("This line should be printed"), + "This line should be printed" + ) + expect_message( + logger$log_info("This line should also be printed", output_to_console = TRUE), + "This line should also be printed" + ) + + expect_no_message(logger$log_info("Whoops! This should not have been printed at all!", output_to_console = FALSE)) +}) + + +test_that("Logger: log_file is NULL in database if not writing to file", { + for (conn in get_test_conns()) { + + # Set options for the test + db_table <- "test.SCDB_logger" + timestamp <- "2022-06-01 09:00:00" + + # Create logger and test configuration + logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = "test.SCDB_logger") + + # While logger is active, log_file should be set as the random generated + db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) + expect_length(db_log_file, 1) + expect_match(db_log_file, "^.+$") + + # When finalising, log_file should be set to NULL + logger$.__enclos_env__$private$finalize() + + db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) + expect_length(db_log_file, 0) + + # Test that an error is thrown if the database record has been finalized + expect_error( + logger$log_to_db(message = "This should produce an error"), + "Logger has already been finalized\\. Cannot write to database log table\\." + ) + + + # Clean up + rm(logger) + invisible(gc()) + + connection_clean_up(conn) + } +}) + + +test_that("Logger: $finalize() handles log table is at some point deleted", { + for (conn in get_test_conns()) { + + # Set options for the test + db_table <- "test.SCDB_logger" + timestamp <- "2022-06-01 09:00:00" + + log_table_id <- "expendable_log_table" + logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = log_table_id) + + DBI::dbRemoveTable(conn, id(log_table_id, conn)) + + expect_no_error(logger$log_to_db(n_insertions = 42)) + + expect_no_error(logger$.__enclos_env__$private$finalize()) + + # Clean up + rm(logger) + invisible(gc()) + + connection_clean_up(conn) + } +}) + +test_that("Logger: custom timestamp_format works", { + + # Create logger and test configuration + expect_warning( + logger <- Logger$new(), # nolint: implicit_assignment_linter + regexp = "NO file or database logging will be done." + ) + + # Test logging to console has the right formatting and message type + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_message( + logger$log_info("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") + ) + + ts_str <- format(logger$start_time, "%F %R") + expect_message( + logger$log_info("test console", tic = logger$start_time, timestamp_format = "%F %R"), + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") + ) + + ts_str <- format(logger$start_time, "%F") + withr::local_options("SCDB.log_timestamp_format" = "%F") + expect_message( + logger$log_info("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") + ) + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("LoggerNull: no console logging occurs", { + + # Create logger and test configuration + logger <- expect_no_message(LoggerNull$new()) + + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_no_message(logger$log_info("test console", tic = logger$start_time)) + + # Test logging to console has the right formatting and message type + ts_str <- format(logger$start_time, "%F %R:%OS3") + expect_no_message( + logger$log_info("test console", tic = logger$start_time) + ) + expect_warning( + logger$log_warn("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") + ) + expect_error( + logger$log_error("test console", tic = logger$start_time), + glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") + ) + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("LoggerNull: no file logging occurs", { + withr::local_options("SCDB.log_path" = tempdir()) + + # Create logger and test configuration + logger <- expect_no_message(LoggerNull$new()) + + expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) + expect_false(logger$log_filename %in% dir(getOption("SCDB.log_path"))) + + # Clean up + rm(logger) + invisible(gc()) +}) + + +test_that("LoggerNull: no database logging occurs", { + for (conn in get_test_conns()) { + + # Set options for the test + db_table <- "test.SCDB_logger" + timestamp <- "2022-06-01 09:00:00" + + # Count entries in log + n_log_entries <- nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))) + + # Create LoggerNull and test configuration + logger <- LoggerNull$new( + db_table = db_table, timestamp = timestamp, + log_conn = conn, log_table_id = "test.SCDB_logger" + ) + + expect_no_message(logger$log_to_db(n_insertions = 42)) + expect_no_message(logger$finalize_db_entry()) + expect_identical(nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))), n_log_entries) + + # Clean up + rm(logger) + invisible(gc()) + + close_connection(conn) + } +}) diff --git a/tests/testthat/test-create_logs_if_missing.R b/tests/testthat/test-create_logs_if_missing.R new file mode 100644 index 00000000..e868d8a4 --- /dev/null +++ b/tests/testthat/test-create_logs_if_missing.R @@ -0,0 +1,66 @@ +test_that("create_logs_if_missing() can create logs in default and test schema", { + for (conn in get_test_conns()) { + for (schema in list(NULL, "test")) { + + # Generate table in schema that does not exist + k <- 0 + while (k < 100) { + logs_id <- paste(c(schema, paste(sample(letters, size = 16, replace = TRUE), collapse = "")), collapse = ".") + k <- k + 1 + if (DBI::dbExistsTable(conn, id(logs_id, conn))) next + break + } + + if (k < 100) { + + # We know table does not exists + expect_false(table_exists(conn, logs_id)) + + # We create the missing log table + expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) + + # And check it conforms with the requirements + expect_true(table_exists(conn, logs_id)) + expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) + + log_signature <- data.frame( + date = as.POSIXct(character(0)), + catalog = character(0), + schema = character(0), + table = character(0), + n_insertions = integer(0), + n_deactivations = integer(0), + start_time = as.POSIXct(character(0)), + end_time = as.POSIXct(character(0)), + duration = character(0), + success = logical(), + message = character(0), + log_file = character(0) + ) + + if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection", "JBDCConnection"))) { + log_signature <- dplyr::select(log_signature, !"catalog") + } + + log_signature <- log_signature %>% + dplyr::copy_to(conn, df = ., unique_table_name(), analyze = FALSE) %>% + dplyr::collect() + + expect_identical( + dplyr::collect(dplyr::tbl(conn, id(logs_id, conn))), + log_signature + ) + + # Attempting to recreate the logs table should not change anything + expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) + expect_true(table_exists(conn, logs_id)) + expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) + + } else { + warning("Non-existing table in default schema could not be generated!", call. = FALSE) + } + + } + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R new file mode 100644 index 00000000..263c74e2 --- /dev/null +++ b/tests/testthat/test-db_joins.R @@ -0,0 +1,219 @@ +test_that("*_join() works with character `by` and `na_by`", { + for (conn in get_test_conns()) { + + # Create two more synthetic test data set with NA data + + # First test case + x <- data.frame(number = c("1", "2", NA), + t = c("strA", NA, "strB")) + + y <- data.frame(letter = c("A", "B", "A", "B"), + number = c(NA, "2", "1", "1")) + + # Copy x and y to conn + x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + + q <- dplyr::left_join(x, y, na_by = "number") %>% + dplyr::collect() %>% + dplyr::arrange(number, t, letter) + qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% + dplyr::arrange(number, t, letter) + expect_mapequal(q, qr) + + q <- dplyr::right_join(x, y, na_by = "number") %>% + dplyr::collect() %>% + dplyr::arrange(number, t, letter) + qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% + dplyr::arrange(number, t, letter) + expect_identical(q, qr) + + q <- dplyr::inner_join(x, y, na_by = "number") %>% + dplyr::collect() %>% + dplyr::arrange(number, t, letter) + qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% + dplyr::arrange(number, t, letter) + expect_identical(q, qr) + + + # Second test case + x <- data.frame(date = as.Date(c("2022-05-01", "2022-05-01", "2022-05-02", "2022-05-02")), + region_id = c("1", NA, NA, "1"), + n_start = c(3, NA, NA, NA)) + + y <- data.frame(date = as.Date("2022-05-02"), + region_id = "1", + n_add = 4) + + # Copy x and y to conn + x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + + q <- dplyr::full_join(x, y, by = "date", na_by = "region_id") %>% + dplyr::collect() %>% + dplyr::arrange(date, region_id) + qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = c("date", "region_id")) %>% + dplyr::arrange(date, region_id) + expect_identical(q, qr) + + + + + # Some other test cases + x <- get_table(conn, "__mtcars") %>% + dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) + + y <- get_table(conn, "__mtcars") %>% + dplyr::select(name, drat, wt, qsec) + + xx <- x %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) + yy <- y %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) + + # Using by should give 1 mismatch + # Using na_by should give no mismatch + expect_identical( + dplyr::left_join(xx, xx, by = "name") %>% + dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter + dplyr::pull(n), + 1 + ) + expect_identical( + dplyr::left_join(xx, xx, na_by = "name") %>% + dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter + dplyr::pull(n), + 0 + ) + + # And they should be identical with the simple case + expect_identical( + dplyr::left_join(xx, xx, na_by = "name") %>% + dplyr::select(!"name") %>% + dplyr::collect(), + dplyr::left_join(x, x, na_by = "name") %>% + dplyr::select(!"name") %>% + dplyr::collect() + ) + + connection_clean_up(conn) + } +}) + + +test_that("*_join() works with `dplyr::join_by()`", { + for (conn in get_test_conns()) { + + # Define two test datasets + x <- get_table(conn, "__mtcars") %>% + dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) + + y <- get_table(conn, "__mtcars") %>% + dplyr::select(name, drat, wt, qsec) + + print("dplyr::show_query(y)") + print(dplyr::show_query(y)) + + print("dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))") + print(dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))) + + print("dplyr::tbl_vars(y)") + print(dplyr::tbl_vars(y)) + + print("make_join_aliases") + print(dbplyr:::make_join_aliases(x$src$con, NULL, NULL, NULL, rlang::caller_env())) + + print("join_inline_select") + by <- dplyr::join_by(x$name == y$name) + print(dbplyr:::join_inline_select(y$lazy_query, by$y, by$on)) + + print("y_lq") + print(inline_result$lq) + + print("table_names_y") + print(dbplyr:::make_table_names(join_alias$y, y_lq)) + + + + # Test the implemented joins + q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) + expect_identical(q, qr) + + q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) + expect_identical(q, qr) + + q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) + expect_identical(q, qr) + + connection_clean_up(conn) + } +}) + + +test_that("*_join() does not break any dplyr joins", { + for (conn in get_test_conns()) { + + # Define two test datasets + x <- get_table(conn, "__mtcars") %>% + dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) + + y <- get_table(conn, "__mtcars") %>% + dplyr::select(name, drat, wt, qsec) + + # Test the standard joins + # left_join + qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::left_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + # right_join + qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::right_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + # inner_join + qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::inner_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + # full_join + qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::full_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::full_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + # semi_join + qr <- dplyr::semi_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::semi_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::semi_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + # anti_join + qr <- dplyr::anti_join(dplyr::collect(x), dplyr::collect(y), by = "name") + q <- dplyr::anti_join(x, y, by = "name") %>% dplyr::collect() + expect_identical(q, qr) + + q <- dplyr::anti_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() + expect_identical(q, qr) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-db_timestamp.R b/tests/testthat/test-db_timestamp.R new file mode 100644 index 00000000..b95bc509 --- /dev/null +++ b/tests/testthat/test-db_timestamp.R @@ -0,0 +1,24 @@ +test_that("db_timestamp produce consistent results", { + for (conn in get_test_conns()) { + ts_posix <- Sys.time() + ts_str <- format(ts_posix) + + expect_identical( + db_timestamp(ts_posix, conn), + db_timestamp(ts_str, conn) + ) + + expect_identical( + db_timestamp(ts_posix, conn = NULL), + db_timestamp(ts_str, conn = NULL) + ) + + # Test default fallback + expect_identical( + db_timestamp.default(ts_posix, conn = conn), + db_timestamp.default(ts_str, conn = conn) + ) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-filter_keys.R b/tests/testthat/test-filter_keys.R new file mode 100644 index 00000000..31f8cab3 --- /dev/null +++ b/tests/testthat/test-filter_keys.R @@ -0,0 +1,77 @@ +test_that("filter_keys() works", { + for (conn in get_test_conns()) { + + x <- get_table(conn, "__mtcars") + + expect_identical( + x, + x %>% filter_keys(NULL) + ) + + filter <- x %>% utils::head(10) %>% dplyr::select("name") + expect_identical( + x %>% + dplyr::filter(name %in% !!dplyr::pull(filter, "name")) %>% + dplyr::collect(), + x %>% + filter_keys(filter) %>% + dplyr::collect() + ) + + filter <- x %>% utils::head(10) %>% dplyr::select("vs", "am") %>% dplyr::distinct() + expect_identical( + x %>% + dplyr::inner_join(filter, by = c("vs", "am")) %>% + dplyr::collect(), + x %>% + filter_keys(filter) %>% + dplyr::collect() + ) + + # Filtering with null means no filtering is done + m <- mtcars + row.names(m) <- NULL + filter <- NULL + expect_identical(filter_keys(m, filter), m) + + # Filtering by vs = 0 + filter <- data.frame(vs = 0) + expect_mapequal(filter_keys(m, filter), dplyr::filter(m, .data$vs == 0)) + + # Empty filter should result in no rows + expect_identical( + utils::head(x, 0), + x %>% filter_keys(data.frame(vs = numeric(0), am = numeric(0))) + ) + + connection_clean_up(conn) + } +}) + + +test_that("filter_keys() works with copy = TRUE", { + for (conn in get_test_conns()) { + + x <- get_table(conn, "__mtcars") + + filter <- x %>% + utils::head(10) %>% + dplyr::select("name") %>% + dplyr::collect() + + expect_identical( + x %>% + dplyr::filter(.data$name %in% !!dplyr::pull(filter, "name")) %>% + dplyr::collect(), + x %>% + filter_keys(filter, copy = TRUE) %>% + dplyr::collect() + ) + + # The above filter_keys with `copy = TRUE` generates a dbplyr_### table. + # We manually remove this since we expect it. If more arise, we will get an error. + DBI::dbRemoveTable(conn, id(utils::head(get_tables(conn, "dbplyr_"), 1))) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-getTableSignature.R b/tests/testthat/test-getTableSignature.R new file mode 100644 index 00000000..f5859a07 --- /dev/null +++ b/tests/testthat/test-getTableSignature.R @@ -0,0 +1,369 @@ +withr::local_options("stringsAsFactors" = FALSE) # Compatibility with R < 4.0.0 + +# Generate test datasets with different data types + +# One that follows the structure in update_snapshot() +data_update_snapsnot <- data.frame( + "Date" = Sys.Date(), + "POSIXct" = Sys.time(), + "character" = "test", + "integer" = 1L, + "numeric" = 1, + "logical" = TRUE, + # .. and our special columns + "checksum" = "test", + "from_ts" = Sys.time(), + "until_ts" = Sys.time() +) + +# One that has the special columns of update_snapshot(), but not at the end +data_random <- data.frame( + "Date" = Sys.Date(), + "POSIXct" = Sys.time(), + "character" = "test", + # .. Our special columns, but not at the end + "checksum" = "test", + "from_ts" = Sys.time(), + "until_ts" = Sys.time(), + # .. + "integer" = 1L, + "numeric" = 1, + "logical" = TRUE +) + +for (conn in c(list(NULL), get_test_conns())) { + + if (is.null(conn)) { + test_that("getTableSignature() generates signature for update_snapshot() (conn == NULL)", { + expect_identical( + getTableSignature(data_update_snapsnot, conn), + c( + "Date" = "Date", + "POSIXct" = "POSIXct", + "character" = "character", + "integer" = "integer", + "numeric" = "numeric", + "logical" = "logical", + # .. + "checksum" = "character", + "from_ts" = "POSIXct", + "until_ts" = "POSIXct" + ) + ) + }) + } + + if (inherits(conn, "SQLiteConnection")) { + test_that("getTableSignature() generates signature for update_snapshot() (SQLiteConnection)", { + expect_identical( + getTableSignature(data_update_snapsnot, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMP", + "character" = "TEXT", + "integer" = "INT", + "numeric" = "DOUBLE", + "logical" = "SMALLINT", + # .. + "checksum" = "TEXT", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP" + ) + ) + }) + } + + if (inherits(conn, "PqConnection")) { + test_that("getTableSignature() generates signature for update_snapshot() (PqConnection)", { + expect_identical( + getTableSignature(data_update_snapsnot, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMPTZ", + "character" = "TEXT", + "integer" = "INTEGER", + "numeric" = "DOUBLE PRECISION", + "logical" = "BOOLEAN", + # .. + "checksum" = "CHAR(32)", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP" + ) + ) + }) + } + + if (inherits(conn, "Microsoft SQL Server")) { + test_that("getTableSignature() generates signature for update_snapshot() (Microsoft SQL Server)", { + expect_identical( + getTableSignature(data_update_snapsnot, conn), + c( + "Date" = "DATE", + "POSIXct" = "DATETIME", + "character" = "varchar(255)", + "integer" = "INT", + "numeric" = "FLOAT", + "logical" = "BIT", + # .. + "checksum" = "CHAR(64)", + "from_ts" = "DATETIME", + "until_ts" = "DATETIME" + ) + ) + }) + } + + if (inherits(conn, "duckdb_connection")) { + test_that("getTableSignature() generates signature for update_snapshot() (duckdb_connection)", { + expect_identical( + getTableSignature(data_update_snapsnot, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMP", + "character" = "STRING", + "integer" = "INTEGER", + "numeric" = "DOUBLE", + "logical" = "BOOLEAN", + # .. + "checksum" = "char(32)", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP" + ) + ) + }) + } + + + if (is.null(conn)) { + test_that("getTableSignature() generates signature for random data (conn == NULL)", { + expect_identical( + getTableSignature(data_random, conn), + c( + "Date" = "Date", + "POSIXct" = "POSIXct", + "character" = "character", + # .. + "checksum" = "character", + "from_ts" = "POSIXct", + "until_ts" = "POSIXct", + # .. + "integer" = "integer", + "numeric" = "numeric", + "logical" = "logical" + ) + ) + }) + } + + if (inherits(conn, "SQLiteConnection")) { + test_that("getTableSignature() generates signature for random data (SQLiteConnection)", { + expect_identical( + getTableSignature(data_random, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMP", + "character" = "TEXT", + # .. + "checksum" = "TEXT", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP", + # .. + "integer" = "INT", + "numeric" = "DOUBLE", + "logical" = "SMALLINT" + ) + ) + }) + } + + if (inherits(conn, "PqConnection")) { + test_that("getTableSignature() generates signature for random data (PqConnection)", { + expect_identical( + getTableSignature(data_random, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMPTZ", + "character" = "TEXT", + # .. + "checksum" = "TEXT", + "from_ts" = "TIMESTAMPTZ", + "until_ts" = "TIMESTAMPTZ", + # .. + "integer" = "INTEGER", + "numeric" = "DOUBLE PRECISION", + "logical" = "BOOLEAN" + ) + ) + }) + } + + if (inherits(conn, "Microsoft SQL Server")) { + test_that("getTableSignature() generates signature for random data (Microsoft SQL Server)", { + expect_identical( + getTableSignature(data_random, conn), + c( + "Date" = "DATE", + "POSIXct" = "DATETIME", + "character" = "varchar(255)", + # .. + "checksum" = "varchar(255)", + "from_ts" = "DATETIME", + "until_ts" = "DATETIME", + # .. + "integer" = "INT", + "numeric" = "FLOAT", + "logical" = "BIT" + ) + ) + }) + } + + if (inherits(conn, "duckdb_connection")) { + test_that("getTableSignature() generates signature for random data (duckdb_connection)", { + expect_identical( + getTableSignature(data_random, conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMP", + "character" = "STRING", + # .. + "checksum" = "STRING", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP", + # .. + "integer" = "INTEGER", + "numeric" = "DOUBLE", + "logical" = "BOOLEAN" + ) + ) + }) + } + + + if (inherits(conn, "SQLiteConnection")) { + test_that("getTableSignature() generates signature for random data on remote (SQLiteConnection)", { + expect_identical( + getTableSignature(dplyr::copy_to(conn, data_random), conn), + c( + "Date" = "DOUBLE", # By copying to SQLite and back, information is changed by + "POSIXct" = "DOUBLE", # dbplyr / DBI so data types are now similar, but different. + "character" = "TEXT", # Dates and timestamps which are normally stored in SQLite + # .. # as internally TEXT are now converted to DOUBLE + "checksum" = "TEXT", # Logical, which have the "SMALLINT" type are now "INT" + "from_ts" = "DOUBLE", # In the next test, we check that this conversion is consistent + "until_ts" = "DOUBLE", # for the user on the local R side. + # .. + "integer" = "INT", + "numeric" = "DOUBLE", + "logical" = "INT" + ) + ) + }) + } + + if (inherits(conn, "PqConnection")) { + test_that("getTableSignature() generates signature for random data on remote (PqConnection)", { + expect_identical( + getTableSignature(dplyr::copy_to(conn, data_random), conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMPTZ", + "character" = "TEXT", + # .. + "checksum" = "TEXT", + "from_ts" = "TIMESTAMPTZ", + "until_ts" = "TIMESTAMPTZ", + # .. + "integer" = "INTEGER", + "numeric" = "DOUBLE PRECISION", + "logical" = "BOOLEAN" + ) + ) + }) + } + + if (inherits(conn, "Microsoft SQL Server")) { + test_that("getTableSignature() generates signature for random data on remote (Microsoft SQL Server)", { + expect_identical( + getTableSignature(dplyr::copy_to(conn, data_random), conn), + c( + "Date" = "DATE", + "POSIXct" = "DATETIME", + "character" = "varchar(255)", + # .. + "checksum" = "varchar(255)", + "from_ts" = "DATETIME", + "until_ts" = "DATETIME", + # .. + "integer" = "INT", + "numeric" = "FLOAT", + "logical" = "BIT" + ) + ) + }) + } + + if (inherits(conn, "duckdb_connection")) { + test_that("getTableSignature() generates signature for random data on remote (duckdb_connection)", { + expect_identical( + getTableSignature(dplyr::copy_to(conn, data_random), conn), + c( + "Date" = "DATE", + "POSIXct" = "TIMESTAMP", + "character" = "STRING", + # .. + "checksum" = "STRING", + "from_ts" = "TIMESTAMP", + "until_ts" = "TIMESTAMP", + # .. + "integer" = "INTEGER", + "numeric" = "DOUBLE", + "logical" = "BOOLEAN" + ) + ) + }) + } + + + if (!is.null(conn)) { + test_that(glue::glue("getTableSignature() generates consistent data types ({class(conn)})"), { + # This tests that the data types are consistent when copying to a remote table with getTableSignature(). + # We first copy the data to a remote table, then copy that table to another remote table on the same connection. + # The + remote_data_1 <- dplyr::copy_to( + conn, + data_random, + name = "remote_data_1", + types = getTableSignature(data_random, conn) + ) + remote_data_2 <- dplyr::copy_to( + conn, + remote_data_1, + name = "remote_data_2", + types = getTableSignature(remote_data_1, conn) + ) + + # The table signatures are not always the same (eg. SQLiteConnection). + if (inherits(conn, "SQLiteConnection")) { + expect_false(identical( # In lieu of expect_not_identical + getTableSignature(data_random, conn), + getTableSignature(remote_data_1, conn) + )) + expect_identical( # nolint: expect_named_linter + names(getTableSignature(data_random, conn)), + names(getTableSignature(remote_data_1, conn)) + ) + } else { + expect_identical( + getTableSignature(data_random, conn), + getTableSignature(remote_data_1, conn) + ) + } + + # But the data, when transfered locally, should be the same + expect_identical(dplyr::collect(remote_data_2), dplyr::collect(remote_data_1)) + }) + } + + if (!is.null(conn)) connection_clean_up(conn) +} diff --git a/tests/testthat/test-get_table.R b/tests/testthat/test-get_table.R new file mode 100644 index 00000000..c2bef1b5 --- /dev/null +++ b/tests/testthat/test-get_table.R @@ -0,0 +1,130 @@ +test_that("get_table() returns list of tables if no table is requested", { + for (conn in get_test_conns()) { + + expect_message( + get_table(conn), + regexp = "Select one of the following tables:" + ) + + connection_clean_up(conn) + } +}) + + +test_that("get_table() works when tables/view exist", { + for (conn in get_test_conns()) { + + mtcars_t <- tibble::tibble(mtcars %>% dplyr::mutate(name = rownames(mtcars))) + + # Lets try different ways to read __mtcars (added during setup) + expect_mapequal(get_table(conn, "__mtcars") %>% dplyr::collect(), mtcars_t) + expect_identical(get_table(conn, id("__mtcars")) %>% dplyr::collect(), mtcars_t) + t <- "__mtcars" + expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) + t <- id("__mtcars") + expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) + + # And test.mtcars (added during setup) + expect_identical(get_table(conn, "test.mtcars") %>% dplyr::collect(), mtcars_t) + expect_identical(get_table(conn, id("test.mtcars", conn)) %>% dplyr::collect(), mtcars_t) + t <- "test.mtcars" + expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) + t <- id("test.mtcars", conn) + expect_identical(get_table(conn, t) %>% dplyr::collect(), mtcars_t) + + + # Check for the existence of views on backends that support it (added here) + if (checkmate::test_multi_class(conn, c("PqConnection", "Microsoft SQL Server"))) { + + if (inherits(conn, "PqConnection")) { + DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT * FROM __mtcars LIMIT 10") + } else if (inherits(conn, "Microsoft SQL Server")) { + DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT TOP 10 * FROM __mtcars") + } + + view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") + + expect_identical(nrow(get_table(conn, view_1)), 10L) + expect_identical( + dplyr::collect(get_table(conn, view_1)), + dplyr::collect(utils::head(get_table(conn, "__mtcars"), 10)) + ) + + DBI::dbExecute(conn, glue::glue("DROP VIEW {view_1}")) + } + + + connection_clean_up(conn) + } +}) + + +test_that("get_table() works when table does not exist in default schema", { + for (conn in get_test_conns()) { + + # Generate table in default schema that does not exist + k <- 0 + while (k < 100) { + invalid_table_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") + k <- k + 1 + if (DBI::dbExistsTable(conn, id(invalid_table_name, conn))) next + break + } + + if (k < 100) { + + expect_error( + get_table(conn, invalid_table_name), + regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") + ) + expect_error( + get_table(conn, id(invalid_table_name, conn)), + regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") + ) + expect_error( + get_table(conn, id(invalid_table_name)), + regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") + ) + + } else { + warning("Non-existing table in default schema could not be generated!", call. = FALSE) + } + + connection_clean_up(conn) + } +}) + + +test_that("get_table() works when table does not exist in non-existing schema", { + for (conn in get_test_conns()) { + + # Generate schema that does not exist + k <- 0 + while (k < 100) { + invalid_schema_name <- paste(sample(letters, size = 16, replace = TRUE), collapse = "") + k <- k + 1 + if (schema_exists(conn, invalid_schema_name)) next + break + } + + if (k < 100) { + + # Test some malformed inputs + invalid_table_name <- paste(invalid_schema_name, "mtcars", sep = ".") + + expect_error( + get_table(conn, invalid_table_name), + regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") + ) + expect_error( + get_table(conn, id(invalid_table_name, conn)), + regexp = glue::glue("Table {as.character(id(invalid_table_name, conn))} could not be found!") + ) + + } else { + warning("Non-existing schema could not be generated!", call. = FALSE) + } + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-get_tables.R b/tests/testthat/test-get_tables.R new file mode 100644 index 00000000..be9656e7 --- /dev/null +++ b/tests/testthat/test-get_tables.R @@ -0,0 +1,163 @@ +test_that("get_tables() works without pattern", { + for (conn in get_test_conns()) { + + # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) + # For SQLite connections, we don't always have the "test" schema, so we check for its existence + # and use default schema if it does not exist. + table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") + table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") + + # Check for the existence of views on backends that support it (added here) + if (inherits(conn, "PqConnection")) { + + DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT * FROM __mtcars LIMIT 10") + view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") + + } else if (inherits(conn, "Microsoft SQL Server")) { + + DBI::dbExecute(conn, "CREATE VIEW __mtcars_view AS SELECT TOP 10 * FROM __mtcars") + view_1 <- paste(c(get_schema(conn), "__mtcars_view"), collapse = ".") + + } else { + view_1 <- NULL + } + + + # Pull the tables and compare with expectation + tables <- get_tables(conn) + expect_s3_class(tables, "data.frame") + + db_table_names <- tables %>% + tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% + dplyr::pull(db_table_name) + + # We should not get tables twice + expect_setequal(db_table_names, unique(db_table_names)) + + # Our test tables should be present + checkmate::expect_subset(c(table_1, table_2, view_1), db_table_names) + + + # Drop the view + if (checkmate::test_multi_class(conn, c("PqConnection", "Microsoft SQL Server"))) { + DBI::dbExecute(conn, glue::glue("DROP VIEW {view_1}")) + } + + connection_clean_up(conn) + } +}) + + +test_that("get_tables() works with pattern", { + for (conn in get_test_conns()) { + + # Call with pattern + db_table_names <- get_tables(conn, pattern = "__mt") %>% + tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% + dplyr::pull(db_table_name) + + + # We should not get tables twice + expect_setequal(db_table_names, unique(db_table_names)) + + # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) + # For SQLite connections, we don't always have the "test" schema, so we check for its existence + # and use default schema if it does not exist. + table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") + table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") + + # Our test table that matches the pattern should be present + expect_false(table_1 %in% db_table_names) + expect_true(table_2 %in% db_table_names) + + connection_clean_up(conn) + } +}) + + +test_that("get_tables() works with temporary tables", { + for (conn in get_test_conns()) { + + # Create temporary table + tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) + tmp_id <- id(tmp) + tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") + + db_table_names <- get_tables(conn, show_temporary = TRUE) %>% + tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% + dplyr::pull(db_table_name) + + + # We should not get tables twice + expect_setequal(db_table_names, unique(db_table_names)) + + # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) + # For SQLite connections, we don't always have the "test" schema, so we check for its existence + # and use default schema if it does not exist. + table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") + table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") + + # Our test tables should be present + checkmate::expect_subset(c(table_1, table_2, tmp_name), db_table_names) + + connection_clean_up(conn) + + print("DBI::dbIsValid(conn)") + print(DBI::dbIsValid(conn)) + print("DBI::dbExistsTable(conn, tmp_id)") + print(DBI::dbExistsTable(conn, tmp_id)) + print("DBI::dbRemoveTable(conn, tmp_id)") + print(DBI::dbRemoveTable(conn, tmp_id)) + } +}) + + +test_that("get_tables() works without temporary tables", { + for (conn in get_test_conns()) { + + # Create temporary table + tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) + tmp_id <- id(tmp) + tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") + + db_table_names <- get_tables(conn, show_temporary = FALSE) %>% + tidyr::unite("db_table_name", "schema", "table", sep = ".", na.rm = TRUE) %>% + dplyr::pull(db_table_name) + + # Check for the existence of "test.mtcars" and "__mtcars" (added during test setup) + # For SQLite connections, we don't always have the "test" schema, so we check for its existence + # and use default schema if it does not exist. + table_1 <- paste(c(switch(!schema_exists(conn, "test"), get_schema(conn)), "test.mtcars"), collapse = ".") + table_2 <- paste(c(get_schema(conn), "__mtcars"), collapse = ".") + + # Our permanent test tables should be present + checkmate::expect_subset(c(table_1, table_2), db_table_names) + + # But not our temporary tables + checkmate::expect_disjunct(tmp_name, db_table_names) + + connection_clean_up(conn) + } +}) + + +test_that("get_tables() matches the pattern of SCDB::id", { + for (conn in get_test_conns()) { + + # Test for both a permanent table and a temporary table + permanent_table <- id("test.mtcars", conn = conn) + + tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) + defer_db_cleanup(tmp) + temporary_table <- id(tmp) + + # Check tables can be found by get_tables with pattern + expect_identical(nrow(get_tables(conn, pattern = paste0("^", as.character(permanent_table)))), 1L) + expect_identical(id(get_tables(conn, pattern = paste0("^", as.character(permanent_table)))), permanent_table) + + expect_identical(nrow(get_tables(conn, pattern = paste0("^", as.character(temporary_table)))), 1L) + expect_identical(id(get_tables(conn, pattern = paste0("^", as.character(temporary_table)))), temporary_table) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-interlace.R b/tests/testthat/test-interlace.R new file mode 100644 index 00000000..a85f1787 --- /dev/null +++ b/tests/testthat/test-interlace.R @@ -0,0 +1,53 @@ +test_that("interlace.tbl_sql() works", { + for (conn in get_test_conns()) { + + t1 <- data.frame(key = c("A", "A", "B"), + obs_1 = c(1, 2, 2), + valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-01-01")), + valid_until = as.Date(c("2021-02-01", "2021-03-01", NA))) + + + t2 <- data.frame(key = c("A", "B"), + obs_2 = c("a", "b"), + valid_from = as.Date(c("2021-01-01", "2021-01-01")), + valid_until = as.Date(c("2021-04-01", NA))) + + + t_ref <- data.frame(key = c("A", "A", "A", "B"), + obs_1 = c(1, 2, NA, 2), + obs_2 = c("a", "a", "a", "b"), + valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-03-01", "2021-01-01")), + valid_until = as.Date(c("2021-02-01", "2021-03-01", "2021-04-01", NA))) + + + # Copy t1, t2 and t_ref to conn + t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) + t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE) + t_ref <- dplyr::copy_to(conn, t_ref, name = id("test.SCDB_tmp3", conn), overwrite = TRUE, temporary = FALSE) + + + # Order of records may be different, so we arrange then check if they are identical + expect_identical(interlace(list(t1, t2), by = "key") %>% + dplyr::collect() %>% + dplyr::arrange(.data$key, .data$valid_from), + t_ref %>% + dplyr::collect() %>% + dplyr::arrange(.data$key, .data$valid_from)) + + # Order of columns will be different, so we only require a mapequal + # .. but order of records can still be different + expect_mapequal(interlace(list(t1, t2), by = "key") %>% + dplyr::collect() %>% + dplyr::arrange(.data$key, .data$valid_from), + interlace(list(t2, t1), by = "key") %>% + dplyr::collect() %>% + dplyr::arrange(.data$key, .data$valid_from)) + + connection_clean_up(conn) + } +}) + + +test_that("interlace returns early if length(table) == 1", { + expect_identical(mtcars["mpg"], interlace(list(mtcars["mpg"]), by = "mpg")) +}) diff --git a/tests/testthat/test-locks.R b/tests/testthat/test-locks.R new file mode 100644 index 00000000..ed5e2da2 --- /dev/null +++ b/tests/testthat/test-locks.R @@ -0,0 +1,98 @@ +test_that("lock helpers works in default and test schema", { + for (conn in get_test_conns()) { + for (schema in list(NULL, "test")) { + + # Define the testing tables + test_table_id <- id(paste(c(schema, "mtcars"), collapse = "."), conn) + lock_table_id <- id(paste(c(schema, "locks"), collapse = "."), conn) + + + ## Check we can add locks + expect_true(lock_table(conn, db_table = test_table_id, schema = schema)) + + db_lock_table <- dplyr::tbl(conn, lock_table_id) + expect_identical(colnames(db_lock_table), c("schema", "table", "user", "lock_start", "pid")) + + expect_identical( + dplyr::collect(dplyr::select(db_lock_table, !"lock_start")), + tibble::tibble( + "schema" = purrr::pluck(test_table_id, "name", "schema"), + "table" = purrr::pluck(test_table_id, "name", "table"), + "user" = Sys.info()[["user"]], + "pid" = as.numeric(Sys.getpid()) + ) + ) + + + + ## Check we can remove locks + expect_null(unlock_table(conn, db_table = test_table_id, schema = schema)) + expect_identical(nrow(db_lock_table), 0L) + + + + # Add an invalid lock that we do not own + dplyr::rows_append( + db_lock_table, + tibble::tibble( + "schema" = purrr::pluck(test_table_id, "name", "schema"), + "table" = purrr::pluck(test_table_id, "name", "table"), + "user" = "some_other_user", + "lock_start" = as.numeric(Sys.time()), + "pid" = 0.5 + ), + in_place = TRUE, + copy = TRUE + ) + expect_identical(nrow(db_lock_table), 1L) + + ## Check invalid lock owners are flagged + not_on_cran <- interactive() || identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("CI"), "true") + if (not_on_cran) { # Detection of currently valid PID does not work on CRAN machines, therefore no error is thrown + expect_error( + lock_table(conn, test_table_id, schema = schema), + glue::glue( + "Active lock \\(user = some_other_user, PID = 0.5\\) on table {test_table_id} is no longer a valid PID! ", + "Process likely crashed before completing." + ) + ) + } + + # Remove the lock + unlock_table(conn, db_table = test_table_id, schema = schema, pid = 0.5) + expect_identical(nrow(db_lock_table), 0L) + + + + ## Check that we cannot steal locks + # Get the PID of a background process that will linger for a while + bg_process <- callr::r_bg(function() Sys.sleep(10)) + expect_false(bg_process$get_pid() == Sys.getpid()) + + # Add a valid lock that we do not own + dplyr::rows_append( + db_lock_table, + tibble::tibble( + "schema" = purrr::pluck(test_table_id, "name", "schema"), + "table" = purrr::pluck(test_table_id, "name", "table"), + "user" = "some_other_user", + "lock_start" = as.numeric(Sys.time()), + "pid" = bg_process$get_pid() + ), + in_place = TRUE, + copy = TRUE + ) + + ## Check we cannot achieve table lock + expect_false(lock_table(conn, test_table_id, schema = schema)) + + # Remove the lock + unlock_table(conn, db_table = test_table_id, schema = schema, pid = bg_process$get_pid()) + expect_identical(nrow(db_lock_table), 0L) + + # Clean up + DBI::dbRemoveTable(conn, lock_table_id) + } + close_connection(conn) + } +}) diff --git a/tests/testthat/test-slice_time.R b/tests/testthat/test-slice_time.R new file mode 100644 index 00000000..10de7437 --- /dev/null +++ b/tests/testthat/test-slice_time.R @@ -0,0 +1,34 @@ +test_that("slice_time() works", { + for (conn in get_test_conns()) { + + # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically + xx <- get_table(conn, "__mtcars") %>% + dplyr::mutate(checksum = dplyr::row_number(), + from_ts = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), + until_ts = NA_character_) + + expect_identical(nrow(slice_time(xx, "2022-05-01")), 0L) + expect_identical(nrow(slice_time(xx, "2022-06-01")), 20L) + expect_identical(nrow(slice_time(xx, "2022-06-15")), nrow(mtcars)) + + connection_clean_up(conn) + } +}) + + +test_that("slice_time() works with non-standard columns", { + for (conn in get_test_conns()) { + + # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically + xx <- get_table(conn, "__mtcars") %>% + dplyr::mutate(checksum = dplyr::row_number(), + valid_from = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), + valid_until = NA_character_) + + expect_identical(nrow(slice_time(xx, "2022-05-01", from_ts = "valid_from", until_ts = "valid_until")), 0L) + expect_identical(nrow(slice_time(xx, "2022-06-01", from_ts = "valid_from", until_ts = "valid_until")), 20L) + expect_identical(nrow(slice_time(xx, "2022-06-15", from_ts = "valid_from", until_ts = "valid_until")), nrow(mtcars)) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-unite.tbl_dbi.R b/tests/testthat/test-unite.tbl_dbi.R new file mode 100644 index 00000000..9e524adf --- /dev/null +++ b/tests/testthat/test-unite.tbl_dbi.R @@ -0,0 +1,63 @@ +test_that("unite.tbl_dbi() works", { + for (conn in get_test_conns()) { + + q <- get_table(conn, "__mtcars") %>% utils::head(1) + qu_remove <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp) %>% + dplyr::compute(name = unique_table_name()) + qu <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp, remove = FALSE) %>% + dplyr::compute(name = unique_table_name()) + qu_alt <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", "mpg", "hp", remove = FALSE) %>% + dplyr::compute(name = unique_table_name()) + + expect_s3_class(qu_remove, "tbl_dbi") + expect_s3_class(qu, "tbl_dbi") + expect_s3_class(qu_alt, "tbl_dbi") + + expect_identical(colnames(qu_remove), "new_column") + expect_identical(colnames(qu), c("new_column", "mpg", "hp")) + expect_identical(colnames(qu_alt), c("new_column", "mpg", "hp")) + + expect_identical(dplyr::collect(qu), dplyr::collect(qu_alt)) + + # tidyr::unite has some quirky (and FUN!!! behavior) that we are forced to match here + # specifically, the input "col" is converted to a symbol, so we have to do escape-bullshit + # NOTE: the line "dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% " + # is to account for SQLite not having integer data-types. If we do not first convert to character, + # there will be differences between the objects that are trivial, so we remove these with this operation + # this way, the test should (hopefully) only fail if there are non-trivial differences + expect_mapequal(get_table(conn, "__mtcars") %>% + tidyr::unite("new_col", mpg, hp) %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect(), + get_table(conn, "__mtcars") %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect() %>% + tidyr::unite("new_col", mpg, hp)) + + col <- "new_col" + expect_mapequal(get_table(conn, "__mtcars") %>% + tidyr::unite(col, mpg, hp) %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect(), + get_table(conn, "__mtcars") %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect() %>% + tidyr::unite(col, mpg, hp)) + + expect_mapequal(get_table(conn, "__mtcars") %>% + tidyr::unite(!!col, mpg, hp) %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect(), + get_table(conn, "__mtcars") %>% + dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% + dplyr::collect() %>% + tidyr::unite(!!col, mpg, hp)) + + # Unite places cols in a particular way, lets be sure we match + qq <- dplyr::mutate(q, dplyr::across(tidyselect::everything(), as.character)) # we convert to character since SQLite + expect_identical(qq %>% tidyr::unite("test_col", vs, am) %>% dplyr::collect(), + qq %>% dplyr::collect() %>% tidyr::unite("test_col", vs, am)) + + connection_clean_up(conn) + } +}) diff --git a/tests/testthat/test-update_snapshot.R b/tests/testthat/test-update_snapshot.R new file mode 100644 index 00000000..0e5cff69 --- /dev/null +++ b/tests/testthat/test-update_snapshot.R @@ -0,0 +1,650 @@ +test_that("update_snapshot() can handle first snapshot", { + for (conn in get_test_conns()) { + + if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) + if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) + expect_false(table_exists(conn, "test.SCDB_tmp1")) + expect_false(table_exists(conn, "test.SCDB_logs")) + + # Use unmodified mtcars as the initial snapshot + .data <- mtcars %>% + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) + + # Configure the logger for this update + db_table <- "test.SCDB_tmp1" + timestamp <- "2022-10-01 09:00:00" + log_path <- tempdir() + + # Ensure all logs are removed + dir(log_path) %>% + purrr::keep(~ endsWith(., ".log")) %>% + purrr::walk(~ unlink(file.path(log_path, .))) + + logger <- Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = log_path, + log_table_id = "test.SCDB_logs", + log_conn = conn, + output_to_console = FALSE + ) + + # Update + update_snapshot(.data, conn, db_table, timestamp, logger = logger) + + # Confirm snapshot is transferred correctly + expect_identical( + get_table(conn, db_table) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + .data %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec) + ) + + + ### For this test, we also check that the log output is correct ### + # Check file log outputs exists + log_pattern <- glue::glue("{stringr::str_replace_all(as.Date(timestamp), '-', '_')}.{id(db_table, conn)}.log") + log_file <- purrr::keep(dir(log_path), ~ stringr::str_detect(., log_pattern)) + expect_length(log_file, 1) + expect_gt(file.info(file.path(log_path, log_file))$size, 0) + expect_identical(nrow(get_table(conn, "test.SCDB_logs")), 1L) + + db_logs_with_log_file <- get_table(conn, "test.SCDB_logs") %>% + dplyr::filter(!is.na(.data$log_file)) + expect_identical(nrow(db_logs_with_log_file), 1L) + + # Check database log output + logs <- get_table(conn, "test.SCDB_logs") %>% dplyr::collect() + + # The logs should have specified data types + types <- c( + "date" = "POSIXct", + "catalog" = "character", + "schema" = "character", + "table" = "character", + "n_insertions" = "numeric", + "n_deactivations" = "numeric", + "start_time" = "POSIXct", + "end_time" = "POSIXct", + "duration" = "character", + "success" = "logical", + "message" = "character" + ) + + if (inherits(conn, "SQLiteConnection")) { + types <- types %>% + purrr::map_if(~ identical(., "POSIXct"), "character") %>% # SQLite does not support POSIXct + purrr::map_if(~ identical(., "logical"), "numeric") %>% # SQLite does not support logical + as.character() + } + + checkmate::expect_data_frame(logs, nrows = 1, types) + + # Check the content of the log table + expect_identical(as.character(logs$date), as.character(timestamp)) + + db_table_id <- id(db_table, conn) + if ("catalog" %in% colnames(logs)) expect_identical(logs$catalog, purrr::pluck(db_table_id, "name", "catalog")) + expect_identical(logs$schema, purrr::pluck(db_table_id, "name", "schema")) + expect_identical(logs$table, purrr::pluck(db_table_id, "name", "table")) + + expect_identical(logs$n_insertions, nrow(mtcars)) + expect_identical(logs$n_deactivations, 0L) + expect_true(as.logical(logs$success)) + expect_identical(logs$message, NA_character_) + + + # Clean up the logs + unlink(logger$log_realpath) + + close_connection(conn) + } +}) + +test_that("update_snapshot() can add a new snapshot", { + for (conn in get_test_conns()) { + + # Modify snapshot and run update step + .data <- mtcars %>% + dplyr::mutate(hp = dplyr::if_else(hp > 130, hp - 10, hp)) %>% + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) + + # Configure the logger for this update + db_table <- "test.SCDB_tmp1" + timestamp <- "2022-10-03 09:00:00" + + logger <- Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = NULL, + log_table_id = "test.SCDB_logs", + log_conn = conn, + output_to_console = FALSE + ) + + + # Update + # This is a simple update where 15 rows are replaced with 15 new ones on the given date + update_snapshot(.data, conn, db_table, timestamp, logger = logger) + + # Check the snapshot has updated correctly + target <- dplyr::tbl(conn, id(db_table, conn)) + expect_identical( + slice_time(target, "2022-10-01 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + mtcars %>% + dplyr::arrange(wt, qsec) %>% + tibble::as_tibble() + ) + expect_identical( + nrow(slice_time(target, "2022-10-01 09:00:00")), + nrow(mtcars) + ) + + expect_identical( + slice_time(target, "2022-10-03 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + .data %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec) + ) + expect_identical( + nrow(slice_time(target, "2022-10-03 09:00:00")), + nrow(mtcars) + ) + + + # Check database log output + logs <- get_table(conn, "test.SCDB_logs") %>% + dplyr::collect() %>% + utils::tail(1) + + expect_identical(logs$n_insertions, 15L) + expect_identical(logs$n_deactivations, 15L) + expect_true(as.logical(logs$success)) + + close_connection(conn) + } +}) + +test_that("update_snapshot() can update a snapshot on an existing date", { + for (conn in get_test_conns()) { + + # We now attempt to do another update on the same date + .data <- mtcars %>% + dplyr::mutate(hp = dplyr::if_else(hp > 100, hp - 10, hp)) %>% + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) + + # Configure the logger for this update + db_table <- "test.SCDB_tmp1" + timestamp <- "2022-10-03 09:00:00" + + logger <- Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = NULL, + log_table_id = "test.SCDB_logs", + log_conn = conn, + output_to_console = FALSE + ) + + + # This is a more complicated update where a further 8 rows are replaced with 8 new ones on the same date as before + update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = logger) + + # Even though we insert twice on the same date, we expect the data to be minimal (compacted) + target <- dplyr::tbl(conn, id(db_table, conn)) + expect_identical( + slice_time(target, "2022-10-01 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + mtcars %>% + dplyr::arrange(wt, qsec) %>% + tibble::tibble() + ) + expect_identical( + nrow(slice_time(target, "2022-10-01 09:00:00")), + nrow(mtcars) + ) + + expect_identical( + slice_time(target, "2022-10-03 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + .data %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec) + ) + expect_identical( + nrow(slice_time(target, "2022-10-03 09:00:00")), + nrow(mtcars) + ) + + + # Check database log output + logs <- get_table(conn, "test.SCDB_logs") %>% + dplyr::collect() %>% + utils::tail(1) + + expect_identical(logs$n_insertions, 8L) + expect_identical(logs$n_deactivations, 8L) + expect_true(as.logical(logs$success)) + + close_connection(conn) + } +}) + +test_that("update_snapshot() can insert a snapshot between existing dates", { + for (conn in get_test_conns()) { + + # We now attempt to an update between these two updates + .data <- mtcars %>% + dplyr::mutate(hp = dplyr::if_else(hp > 150, hp - 10, hp)) %>% + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) + + # This should fail if we do not specify "enforce_chronological_order = FALSE" + expect_error( + update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", logger = LoggerNull$new()), + regexp = "Given timestamp 2022-10-02 09:00:00 is earlier" + ) + + # But not with the variable set + update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", + logger = LoggerNull$new(), enforce_chronological_order = FALSE) + + + target <- dplyr::tbl(conn, id("test.SCDB_tmp1", conn)) + expect_identical( + slice_time(target, "2022-10-01 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + mtcars %>% + dplyr::arrange(wt, qsec) %>% + tibble::tibble() + ) + expect_identical( + nrow(slice_time(target, "2022-10-01 09:00:00")), + nrow(mtcars) + ) + + expect_identical( + slice_time(target, "2022-10-02 09:00:00") %>% + dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec), + .data %>% + dplyr::collect() %>% + dplyr::arrange(wt, qsec) + ) + expect_identical( + nrow(slice_time(target, "2022-10-02 09:00:00")), + nrow(mtcars) + ) + + close_connection(conn) + } +}) + + + +test_that("update_snapshot() works (holistic test 1)", { + for (conn in get_test_conns()) { + + if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) + expect_false(table_exists(conn, "test.SCDB_tmp1")) + + + # Create test data for the test + t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) + t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) + t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) + + # Copy t0, t1, and t2 to conn + t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + logger <- LoggerNull$new() + update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01 08:00:00", logger = logger) + expect_identical( + dplyr::collect(t0) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) + ) + + update_snapshot( + t1, + conn, + "test.SCDB_tmp1", + "2022-01-01 08:10:00", + logger = logger, + collapse_continuous_records = TRUE + ) + expect_identical( + dplyr::collect(t1) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) + ) + + update_snapshot( + t2, + conn, + "test.SCDB_tmp1", + "2022-01-01 08:10:00", + logger = logger, + collapse_continuous_records = TRUE + ) + expect_identical( + dplyr::collect(t2) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) + ) + + t <- list(t0, t1, t2) %>% + purrr::reduce(dplyr::union) %>% + dplyr::collect() %>% + dplyr::mutate(col2 = as.character(col2)) %>% + dplyr::arrange(col1, col2) %>% + utils::head(5) + + t_ref <- get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% + dplyr::select(!any_of(c("from_ts", "until_ts", "checksum"))) %>% + dplyr::collect() %>% + dplyr::mutate(col2 = as.character(col2)) %>% + dplyr::arrange(col1, col2) + + expect_identical(t, t_ref) + + close_connection(conn) + } +}) + +test_that("update_snapshot() works (holistic test 2)", { + for (conn in get_test_conns()) { + + if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) + expect_false(table_exists(conn, "test.SCDB_tmp1")) + + + # Create test data for the test + t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) + t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) + t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) + + # Copy t0, t1, and t2 to conn (and suppress check_from message) + t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) + + + # Check non-chronological insertion + logger <- LoggerNull$new() + update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01", logger = logger) + expect_identical(dplyr::collect(t0) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) + + update_snapshot(t2, conn, "test.SCDB_tmp1", "2022-03-01", logger = logger) + expect_identical(dplyr::collect(t2) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) + + update_snapshot(t1, conn, "test.SCDB_tmp1", "2022-02-01", logger = logger, enforce_chronological_order = FALSE) + expect_identical( + dplyr::collect(t1) %>% dplyr::arrange(col1), + dplyr::collect(get_table(conn, "test.SCDB_tmp1", slice_ts = "2022-02-01")) %>% dplyr::arrange(col1) + ) + + t_ref <- + tibble::tibble(col1 = c("A", "B", "A", "C", "B", "C"), + col2 = c(NA_real_, NA_real_, 1, NA_real_, 2, 3), + from_ts = c("2022-01-01", "2022-01-01", "2022-02-01", "2022-02-01", "2022-03-01", "2022-03-01"), + until_ts = c("2022-02-01", "2022-03-01", NA, "2022-03-01", NA, NA)) + + expect_identical( + get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% + dplyr::select(!"checksum") %>% + dplyr::collect() %>% + dplyr::mutate(from_ts = strftime(from_ts), + until_ts = strftime(until_ts)) %>% + dplyr::arrange(col1, from_ts), + t_ref %>% + dplyr::arrange(col1, from_ts) + ) + + if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) + + connection_clean_up(conn) + } +}) + + +test_that("update_snapshot() handles 'NULL' updates", { + for (conn in get_test_conns()) { + + if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) + if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) + + # Use mtcars as the test data set + .data <- mtcars %>% + dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) + defer_db_cleanup(.data) + + # This is a simple update where 23 rows are replaced with 23 new ones on the given date + db_table <- "test.SCDB_tmp1" + + create_logger <- function(timestamp) { + Logger$new( + db_table = db_table, + timestamp = timestamp, + log_path = NULL, + log_table_id = "test.SCDB_logs", + log_conn = conn, + output_to_console = FALSE + ) + } + + # Update the table with update_snapshot() and store the results + update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = create_logger("2022-10-03 09:00:00")) + target_data_1 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() + + # Update the table with the same data again update_snapshot() and store the results + update_snapshot(.data, conn, db_table, "2022-10-04 09:00:00", logger = create_logger("2022-10-04 09:00:00")) + target_data_2 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() + + # Check that the two updates are identical + expect_identical(target_data_1, target_data_2) + + # Confirm with logs that no updates have been made + logs <- get_table(conn, id("test.SCDB_logs", conn)) %>% + dplyr::collect() %>% + dplyr::arrange(date) + + expect_identical(logs$n_insertions, c(nrow(mtcars), 0L)) + expect_identical(logs$n_deactivations, c(0L, 0L)) + + connection_clean_up(conn) + } +}) + + +test_that("update_snapshot() works with Id objects", { + withr::local_options("SCDB.log_path" = NULL) # No file logging + + for (conn in get_test_conns()) { + + target_table <- id("test.mtcars_modified", conn) + + logger <- Logger$new(output_to_console = FALSE, + timestamp = Sys.time(), + db_table = "test.mtcars_modified", + log_conn = NULL, + log_table_id = NULL, + warn = FALSE) + + expect_no_error( + mtcars %>% + dplyr::mutate(disp = sample(mtcars$disp, nrow(mtcars))) %>% + dplyr::copy_to(dest = conn, df = ., name = unique_table_name(), analyze = FALSE) %>% + update_snapshot( + conn = conn, + db_table = target_table, + logger = logger, + timestamp = format(Sys.time()) + ) + ) + + connection_clean_up(conn) + } +}) + + +test_that("update_snapshot() checks table formats", { + + withr::local_options("SCDB.log_path" = tempdir()) + + for (conn in get_test_conns()) { + + mtcars_table <- dplyr::tbl(conn, id("__mtcars_historical", conn = conn)) + timestamp <- Sys.time() + + expect_warning( + logger <- Logger$new(log_path = NULL, log_table_id = NULL, output_to_console = FALSE), # nolint: implicit_assignment_linter + "NO file or database logging will be done." + ) + + # Test columns not matching + broken_table <- dplyr::copy_to(conn, dplyr::select(mtcars, !"mpg"), name = "mtcars_broken", overwrite = TRUE, analyze = FALSE) + + expect_error( + update_snapshot( + .data = broken_table, + conn = conn, + db_table = mtcars_table, + timestamp = timestamp, + logger = logger + ), + "Columns do not match!" + ) + + file.remove(list.files(getOption("SCDB.log_path"), pattern = format(timestamp, "^%Y%m%d.%H%M"), full.names = TRUE)) + + # Test target table not being a historical table + expect_error( + update_snapshot( + dplyr::tbl(conn, id("__mtcars", conn = conn)), + conn, + id("__mtcars", conn = conn), + timestamp = timestamp, + logger = logger + ), + "Table does not seem like a historical table" + ) + + connection_clean_up(conn) + } +}) + + +test_that("update_snapshot() works with across connection", { + skip_if_not_installed("RSQLite") + + withr::local_options("SCDB.log_path" = NULL) # No file logging + + # Test a data transfer from a local SQLite to the test connection + source_conn <- DBI::dbConnect(RSQLite::SQLite()) + + # Create a table for the tests + mtcars_modified <- mtcars %>% + dplyr::mutate(name = rownames(mtcars)) + + # Copy table to the source + .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) + + # For each conn, we test if update_snapshot preserves data types + for (target_conn in get_test_conns()) { + + target_table <- id("test.mtcars_modified", target_conn) + if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) + + logger <- LoggerNull$new() + + # Check we can transfer without error + expect_no_error( + update_snapshot( + .data, + conn = target_conn, + db_table = target_table, + logger = logger, + timestamp = format(Sys.time()) + ) + ) + + # Check that if we collect the table, the signature will match the original + table_signature <- get_table(target_conn, target_table) %>% + dplyr::collect() %>% + dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% + as.data.frame() + + expect_identical( + table_signature, + dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) + ) + + + DBI::dbRemoveTable(target_conn, target_table) + connection_clean_up(target_conn) + rm(logger) + invisible(gc()) + } + connection_clean_up(source_conn) + + + ## Now we test the reverse transfer + + # Test a data transfer from the test connection to a local SQLite + target_conn <- DBI::dbConnect(RSQLite::SQLite()) + + # For each conn, we test if update_snapshot preserves data types + for (source_conn in get_test_conns()) { + + .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) + + target_table <- id("mtcars_modified", target_conn) + if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) + + logger <- LoggerNull$new() + + # Check we can transfer without error + expect_no_error( + update_snapshot( + .data, + conn = target_conn, + db_table = target_table, + logger = logger, + timestamp = format(Sys.time()) + ) + ) + + # Check that if we collect the table, the signature will match the original + table_signature <- get_table(target_conn, target_table) %>% + dplyr::collect() %>% + dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% + as.data.frame() + + expect_identical( + table_signature, + dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) + ) + + + connection_clean_up(source_conn) + rm(logger) + invisible(gc()) + } + connection_clean_up(target_conn) +}) diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R new file mode 100644 index 00000000..e59aa49b --- /dev/null +++ b/tests/testthat/test-zzz.R @@ -0,0 +1,12 @@ +# Do clean up on the connections +for (conn in get_test_conns()) { + purrr::walk(c("test.mtcars", "__mtcars", "__mtcars_historical", "test.mtcars_modified", "mtcars_modified", + "test.SCDB_logs", "test.SCDB_tmp1", "test.SCDB_tmp2", "test.SCDB_tmp3", + "test.SCDB_t0", "test.SCDB_t1", "test.SCDB_t2"), + ~ if (DBI::dbExistsTable(conn, id(., conn))) DBI::dbRemoveTable(conn, id(., conn))) + + purrr::walk(c(DBI::Id(schema = "test", table = "one.two"), DBI::Id(schema = "test.one", table = "two")), + ~ if (schema_exists(conn, .@name[["schema"]]) && DBI::dbExistsTable(conn, .)) DBI::dbRemoveTable(conn, .)) + + connection_clean_up(conn) +} From 12ec194314dba13fe0e0470b355f706b207fc763 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 13:42:50 +0100 Subject: [PATCH 121/129] debug: remove half the tests --- tests/testthat/test-Logger.R | 544 ---------------- tests/testthat/test-create_logs_if_missing.R | 66 -- tests/testthat/test-db_joins.R | 219 ------- tests/testthat/test-filter_keys.R | 77 --- tests/testthat/test-getTableSignature.R | 369 ----------- tests/testthat/test-interlace.R | 53 -- tests/testthat/test-slice_time.R | 34 - tests/testthat/test-unite.tbl_dbi.R | 63 -- tests/testthat/test-update_snapshot.R | 650 ------------------- 9 files changed, 2075 deletions(-) delete mode 100644 tests/testthat/test-Logger.R delete mode 100644 tests/testthat/test-create_logs_if_missing.R delete mode 100644 tests/testthat/test-db_joins.R delete mode 100644 tests/testthat/test-filter_keys.R delete mode 100644 tests/testthat/test-getTableSignature.R delete mode 100644 tests/testthat/test-interlace.R delete mode 100644 tests/testthat/test-slice_time.R delete mode 100644 tests/testthat/test-unite.tbl_dbi.R delete mode 100644 tests/testthat/test-update_snapshot.R diff --git a/tests/testthat/test-Logger.R b/tests/testthat/test-Logger.R deleted file mode 100644 index 788d237b..00000000 --- a/tests/testthat/test-Logger.R +++ /dev/null @@ -1,544 +0,0 @@ -# Ensure the options that can be set are NULL for these tests -withr::local_options("SCDB.log_table_id" = NULL, "SCDB.log_path" = NULL) - -test_that("Logger: logging to console works", { - - # Create logger and test configuration - expect_warning( - logger <- Logger$new(), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - expect_null(logger$log_path) - expect_null(logger$log_tbl) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - expect_warning( - logger$log_warn("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") - ) - expect_error( - logger$log_error("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: all (non-warning, non-error) logging to console can be disabled", { - - # Create logger - expect_warning( - logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - # Test INFO-logging to console is disabled - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message(logger$log_info("test", tic = logger$start_time)) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: logging to file works", { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - - - # Create logger and test configuration - # Empty logger should use default value from options - withr::with_options( - list("SCDB.log_path" = "local/path"), - { - logger <- Logger$new(db_table = db_table, warn = FALSE) - expect_identical(logger$log_path, "local/path") - - rm(logger) - invisible(gc()) - } - ) - - # Create logger and test configuration - # Test file logging - with character timestamp - timestamp <- "2022-01-01 09:00:00" - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - output_to_console = FALSE, - warn = FALSE - ) - - expect_identical(logger$log_path, log_path) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{db_table}.log") - ) - - - # Test logging to file has the right formatting and message type - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - tryCatch(logger$log_warn("test filewriting", tic = logger$start_time), warning = function(w) NULL) - tryCatch(logger$log_error("test filewriting", tic = logger$start_time), error = function(e) NULL) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - c( - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test filewriting") - ) - ) - - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) - - - # Create logger and test configuration - # Test file logging - with POSIX timestamp - timestamp <- as.POSIXct("2022-02-01 09:00:00") - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - output_to_console = FALSE, - warn = FALSE - ) - - expect_identical(logger$log_path, log_path) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{db_table}.log") - ) - - - # Test logging to file still works - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - glue::glue( - "{ts_str} - {Sys.info()[['user']]} - INFO - test filewriting" - ) - ) - - # Clean up - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: log_tbl is not set when conn = NULL", { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-03-01 09:00:00" - - # Create logger and test configuration - # Empty logger should use default value - logger <- Logger$new(db_table = db_table, timestamp = timestamp, warn = FALSE) - expect_null(logger$log_tbl) # log_table_id is NOT defined here, despite the option existing - # the logger does not have the connection, so cannot pull the table from conn - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("Logger: logging to database works", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-04-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, - timestamp = timestamp, - log_table_id = db_table, - log_conn = conn, - warn = FALSE) - - log_table_id <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical(logger$log_tbl, log_table_id) - - - # Test Logger has pre-filled some information in the logs - db_table_id <- id(db_table, conn) - expect_identical(as.character(dplyr::pull(log_table_id, "date")), timestamp) - if ("catalog" %in% purrr::pluck(db_table_id, "name", names)) { - expect_identical(dplyr::pull(log_table_id, "catalog"), purrr::pluck(db_table_id, "name", "catalog")) - } - expect_identical(dplyr::pull(log_table_id, "schema"), purrr::pluck(db_table_id, "name", "schema")) - expect_identical(dplyr::pull(log_table_id, "table"), purrr::pluck(db_table_id, "name", "table")) - expect_identical( # Transferring start_time to database can have some loss of information that we need to match - format(as.POSIXct(dplyr::pull(log_table_id, "start_time")), "%F %R:%S"), - format(logger$start_time, "%F %R:%S") - ) - - - # Test logging to database writes to the correct fields - logger$log_to_db(n_insertions = 42) - expect_identical(nrow(log_table_id), 1L) - expect_identical(dplyr::pull(log_table_id, "n_insertions"), 42L) - - logger$log_to_db(n_deactivations = 60) - expect_identical(nrow(log_table_id), 1L) - expect_identical(dplyr::pull(log_table_id, "n_deactivations"), 60L) - - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: all logging simultaneously works", { - for (conn in get_test_conns()) { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - timestamp <- "2022-05-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_path = log_path, - log_table_id = db_table, log_conn = conn, warn = FALSE) - - log_table_id <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical(logger$log_path, log_path) - expect_identical(logger$log_tbl, log_table_id) - expect_identical( - logger$log_filename, - glue::glue("{format(logger$start_time, '%Y%m%d.%H%M')}.", - "{format(as.POSIXct(timestamp), '%Y_%m_%d')}.", - "{id(db_table, conn)}.log") - ) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting") - ) - expect_warning( - logger$log_warn("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting") - ) - expect_error( - logger$log_error("test console and filewriting", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") - ) - - - # Test logging to file has the right formatting and message type - expect_true(logger$log_filename %in% dir(log_path)) - expect_identical( - readLines(logger$log_realpath), - c( - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console and filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console and filewriting"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console and filewriting") - ) - ) - - - # Test logging to database writes to the correct fields - logger$log_to_db(n_insertions = 13) - expect_identical(nrow(log_table_id), 2L) - expect_identical(dplyr::pull(log_table_id, "n_insertions"), c(42L, 13L)) - - logger$log_to_db(n_deactivations = 37) - expect_identical(nrow(log_table_id), 2L) - expect_identical(dplyr::pull(log_table_id, "n_deactivations"), c(60L, 37L)) - - - # Clean up - file.remove(logger$log_realpath) - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: file logging stops if file exists", { - - # Set options for the test - log_path <- tempdir(check = TRUE) - db_table <- "test.SCDB_logger" - timestamp <- Sys.time() - - # Create logger1 and logger2 which uses the same file - # Since start_time is the same for both - logger1 <- Logger$new( - db_table = db_table, - timestamp = timestamp, - start_time = timestamp, - log_path = log_path, - output_to_console = FALSE - ) - - logger2 <- Logger$new( - db_table = db_table, - timestamp = timestamp, - start_time = timestamp, - log_path = log_path, - output_to_console = FALSE - ) - - - # logger1 should be able to successfully write - logger1$log_info("test message") - - - # whereas logger2 should fail since the log file now exists - expect_error( - logger2$log_info("test message"), - glue::glue("Log file '{logger1$log_filename}' already exists!") - ) - - # .. and it should do it persistently - expect_error( - logger2$log_info("test message"), - glue::glue("Log file '{logger1$log_filename}' already exists!") - ) - - # Clean up - file.remove(logger1$log_realpath) - rm(logger1, logger2) - invisible(gc()) -}) - - -test_that("Logger: console output may be disabled", { - - # First test cases with output_to_console == FALSE - # Here, only print when explicitly stated - expect_warning( - logger <- Logger$new(output_to_console = FALSE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - expect_no_message(logger$log_info("Whoops! This should not have been printed!")) - - expect_no_message(logger$log_info("Whoops! This should not have been printed either!", output_to_console = FALSE)) - - expect_message( - logger$log_info("This line should be printed", output_to_console = TRUE), - "This line should be printed" - ) - - rm(logger) - - # ...and now, only suppress printing when explicitly stated - expect_warning( - logger <- Logger$new(output_to_console = TRUE), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - expect_message( - logger$log_info("This line should be printed"), - "This line should be printed" - ) - expect_message( - logger$log_info("This line should also be printed", output_to_console = TRUE), - "This line should also be printed" - ) - - expect_no_message(logger$log_info("Whoops! This should not have been printed at all!", output_to_console = FALSE)) -}) - - -test_that("Logger: log_file is NULL in database if not writing to file", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - # Create logger and test configuration - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = "test.SCDB_logger") - - # While logger is active, log_file should be set as the random generated - db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) - expect_length(db_log_file, 1) - expect_match(db_log_file, "^.+$") - - # When finalising, log_file should be set to NULL - logger$.__enclos_env__$private$finalize() - - db_log_file <- dplyr::pull(dplyr::filter(logger$log_tbl, log_file == !!logger$log_filename)) - expect_length(db_log_file, 0) - - # Test that an error is thrown if the database record has been finalized - expect_error( - logger$log_to_db(message = "This should produce an error"), - "Logger has already been finalized\\. Cannot write to database log table\\." - ) - - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - - -test_that("Logger: $finalize() handles log table is at some point deleted", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - log_table_id <- "expendable_log_table" - logger <- Logger$new(db_table = db_table, timestamp = timestamp, log_conn = conn, log_table_id = log_table_id) - - DBI::dbRemoveTable(conn, id(log_table_id, conn)) - - expect_no_error(logger$log_to_db(n_insertions = 42)) - - expect_no_error(logger$.__enclos_env__$private$finalize()) - - # Clean up - rm(logger) - invisible(gc()) - - connection_clean_up(conn) - } -}) - -test_that("Logger: custom timestamp_format works", { - - # Create logger and test configuration - expect_warning( - logger <- Logger$new(), # nolint: implicit_assignment_linter - regexp = "NO file or database logging will be done." - ) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - ts_str <- format(logger$start_time, "%F %R") - expect_message( - logger$log_info("test console", tic = logger$start_time, timestamp_format = "%F %R"), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - ts_str <- format(logger$start_time, "%F") - withr::local_options("SCDB.log_timestamp_format" = "%F") - expect_message( - logger$log_info("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - INFO - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no console logging occurs", { - - # Create logger and test configuration - logger <- expect_no_message(LoggerNull$new()) - - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message(logger$log_info("test console", tic = logger$start_time)) - - # Test logging to console has the right formatting and message type - ts_str <- format(logger$start_time, "%F %R:%OS3") - expect_no_message( - logger$log_info("test console", tic = logger$start_time) - ) - expect_warning( - logger$log_warn("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - WARNING - test console") - ) - expect_error( - logger$log_error("test console", tic = logger$start_time), - glue::glue("{ts_str} - {Sys.info()[['user']]} - ERROR - test console") - ) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no file logging occurs", { - withr::local_options("SCDB.log_path" = tempdir()) - - # Create logger and test configuration - logger <- expect_no_message(LoggerNull$new()) - - expect_no_message(logger$log_info("test filewriting", tic = logger$start_time)) - expect_false(logger$log_filename %in% dir(getOption("SCDB.log_path"))) - - # Clean up - rm(logger) - invisible(gc()) -}) - - -test_that("LoggerNull: no database logging occurs", { - for (conn in get_test_conns()) { - - # Set options for the test - db_table <- "test.SCDB_logger" - timestamp <- "2022-06-01 09:00:00" - - # Count entries in log - n_log_entries <- nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))) - - # Create LoggerNull and test configuration - logger <- LoggerNull$new( - db_table = db_table, timestamp = timestamp, - log_conn = conn, log_table_id = "test.SCDB_logger" - ) - - expect_no_message(logger$log_to_db(n_insertions = 42)) - expect_no_message(logger$finalize_db_entry()) - expect_identical(nrow(dplyr::tbl(conn, id("test.SCDB_logger", conn))), n_log_entries) - - # Clean up - rm(logger) - invisible(gc()) - - close_connection(conn) - } -}) diff --git a/tests/testthat/test-create_logs_if_missing.R b/tests/testthat/test-create_logs_if_missing.R deleted file mode 100644 index e868d8a4..00000000 --- a/tests/testthat/test-create_logs_if_missing.R +++ /dev/null @@ -1,66 +0,0 @@ -test_that("create_logs_if_missing() can create logs in default and test schema", { - for (conn in get_test_conns()) { - for (schema in list(NULL, "test")) { - - # Generate table in schema that does not exist - k <- 0 - while (k < 100) { - logs_id <- paste(c(schema, paste(sample(letters, size = 16, replace = TRUE), collapse = "")), collapse = ".") - k <- k + 1 - if (DBI::dbExistsTable(conn, id(logs_id, conn))) next - break - } - - if (k < 100) { - - # We know table does not exists - expect_false(table_exists(conn, logs_id)) - - # We create the missing log table - expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) - - # And check it conforms with the requirements - expect_true(table_exists(conn, logs_id)) - expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) - - log_signature <- data.frame( - date = as.POSIXct(character(0)), - catalog = character(0), - schema = character(0), - table = character(0), - n_insertions = integer(0), - n_deactivations = integer(0), - start_time = as.POSIXct(character(0)), - end_time = as.POSIXct(character(0)), - duration = character(0), - success = logical(), - message = character(0), - log_file = character(0) - ) - - if (!checkmate::test_multi_class(conn, c("Microsoft SQL Server", "duckdb_connection", "JBDCConnection"))) { - log_signature <- dplyr::select(log_signature, !"catalog") - } - - log_signature <- log_signature %>% - dplyr::copy_to(conn, df = ., unique_table_name(), analyze = FALSE) %>% - dplyr::collect() - - expect_identical( - dplyr::collect(dplyr::tbl(conn, id(logs_id, conn))), - log_signature - ) - - # Attempting to recreate the logs table should not change anything - expect_no_error(create_logs_if_missing(conn, log_table = logs_id)) - expect_true(table_exists(conn, logs_id)) - expect_identical(nrow(dplyr::tbl(conn, id(logs_id, conn))), 0L) - - } else { - warning("Non-existing table in default schema could not be generated!", call. = FALSE) - } - - } - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-db_joins.R b/tests/testthat/test-db_joins.R deleted file mode 100644 index 263c74e2..00000000 --- a/tests/testthat/test-db_joins.R +++ /dev/null @@ -1,219 +0,0 @@ -test_that("*_join() works with character `by` and `na_by`", { - for (conn in get_test_conns()) { - - # Create two more synthetic test data set with NA data - - # First test case - x <- data.frame(number = c("1", "2", NA), - t = c("strA", NA, "strB")) - - y <- data.frame(letter = c("A", "B", "A", "B"), - number = c(NA, "2", "1", "1")) - - # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - q <- dplyr::left_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_mapequal(q, qr) - - q <- dplyr::right_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, na_by = "number") %>% - dplyr::collect() %>% - dplyr::arrange(number, t, letter) - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "number", multiple = "all") %>% - dplyr::arrange(number, t, letter) - expect_identical(q, qr) - - - # Second test case - x <- data.frame(date = as.Date(c("2022-05-01", "2022-05-01", "2022-05-02", "2022-05-02")), - region_id = c("1", NA, NA, "1"), - n_start = c(3, NA, NA, NA)) - - y <- data.frame(date = as.Date("2022-05-02"), - region_id = "1", - n_add = 4) - - # Copy x and y to conn - x <- dplyr::copy_to(conn, x, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - y <- dplyr::copy_to(conn, y, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - q <- dplyr::full_join(x, y, by = "date", na_by = "region_id") %>% - dplyr::collect() %>% - dplyr::arrange(date, region_id) - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = c("date", "region_id")) %>% - dplyr::arrange(date, region_id) - expect_identical(q, qr) - - - - - # Some other test cases - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - xx <- x %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) - yy <- y %>% dplyr::mutate(name = dplyr::if_else(dplyr::row_number() == 1, NA, name)) - - # Using by should give 1 mismatch - # Using na_by should give no mismatch - expect_identical( - dplyr::left_join(xx, xx, by = "name") %>% - dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter - dplyr::pull(n), - 1 - ) - expect_identical( - dplyr::left_join(xx, xx, na_by = "name") %>% - dplyr::summarize(n = sum(dplyr::if_else(is.na(cyl.y), 1, 0), na.rm = TRUE)) %>% # nolint: redundant_ifelse_linter - dplyr::pull(n), - 0 - ) - - # And they should be identical with the simple case - expect_identical( - dplyr::left_join(xx, xx, na_by = "name") %>% - dplyr::select(!"name") %>% - dplyr::collect(), - dplyr::left_join(x, x, na_by = "name") %>% - dplyr::select(!"name") %>% - dplyr::collect() - ) - - connection_clean_up(conn) - } -}) - - -test_that("*_join() works with `dplyr::join_by()`", { - for (conn in get_test_conns()) { - - # Define two test datasets - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - print("dplyr::show_query(y)") - print(dplyr::show_query(y)) - - print("dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))") - print(dplyr::show_query(dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)))) - - print("dplyr::tbl_vars(y)") - print(dplyr::tbl_vars(y)) - - print("make_join_aliases") - print(dbplyr:::make_join_aliases(x$src$con, NULL, NULL, NULL, rlang::caller_env())) - - print("join_inline_select") - by <- dplyr::join_by(x$name == y$name) - print(dbplyr:::join_inline_select(y$lazy_query, by$y, by$on)) - - print("y_lq") - print(inline_result$lq) - - print("table_names_y") - print(dbplyr:::make_table_names(join_alias$y, y_lq)) - - - - # Test the implemented joins - q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = dplyr::join_by(x$name == y$name)) - expect_identical(q, qr) - - connection_clean_up(conn) - } -}) - - -test_that("*_join() does not break any dplyr joins", { - for (conn in get_test_conns()) { - - # Define two test datasets - x <- get_table(conn, "__mtcars") %>% - dplyr::select(name, mpg, cyl, hp, vs, am, gear, carb) - - y <- get_table(conn, "__mtcars") %>% - dplyr::select(name, drat, wt, qsec) - - # Test the standard joins - # left_join - qr <- dplyr::left_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::left_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::left_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # right_join - qr <- dplyr::right_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::right_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::right_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # inner_join - qr <- dplyr::inner_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::inner_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::inner_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # full_join - qr <- dplyr::full_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::full_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::full_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # semi_join - qr <- dplyr::semi_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::semi_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::semi_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - # anti_join - qr <- dplyr::anti_join(dplyr::collect(x), dplyr::collect(y), by = "name") - q <- dplyr::anti_join(x, y, by = "name") %>% dplyr::collect() - expect_identical(q, qr) - - q <- dplyr::anti_join(x, y, by = dplyr::join_by(x$name == y$name)) %>% dplyr::collect() - expect_identical(q, qr) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-filter_keys.R b/tests/testthat/test-filter_keys.R deleted file mode 100644 index 31f8cab3..00000000 --- a/tests/testthat/test-filter_keys.R +++ /dev/null @@ -1,77 +0,0 @@ -test_that("filter_keys() works", { - for (conn in get_test_conns()) { - - x <- get_table(conn, "__mtcars") - - expect_identical( - x, - x %>% filter_keys(NULL) - ) - - filter <- x %>% utils::head(10) %>% dplyr::select("name") - expect_identical( - x %>% - dplyr::filter(name %in% !!dplyr::pull(filter, "name")) %>% - dplyr::collect(), - x %>% - filter_keys(filter) %>% - dplyr::collect() - ) - - filter <- x %>% utils::head(10) %>% dplyr::select("vs", "am") %>% dplyr::distinct() - expect_identical( - x %>% - dplyr::inner_join(filter, by = c("vs", "am")) %>% - dplyr::collect(), - x %>% - filter_keys(filter) %>% - dplyr::collect() - ) - - # Filtering with null means no filtering is done - m <- mtcars - row.names(m) <- NULL - filter <- NULL - expect_identical(filter_keys(m, filter), m) - - # Filtering by vs = 0 - filter <- data.frame(vs = 0) - expect_mapequal(filter_keys(m, filter), dplyr::filter(m, .data$vs == 0)) - - # Empty filter should result in no rows - expect_identical( - utils::head(x, 0), - x %>% filter_keys(data.frame(vs = numeric(0), am = numeric(0))) - ) - - connection_clean_up(conn) - } -}) - - -test_that("filter_keys() works with copy = TRUE", { - for (conn in get_test_conns()) { - - x <- get_table(conn, "__mtcars") - - filter <- x %>% - utils::head(10) %>% - dplyr::select("name") %>% - dplyr::collect() - - expect_identical( - x %>% - dplyr::filter(.data$name %in% !!dplyr::pull(filter, "name")) %>% - dplyr::collect(), - x %>% - filter_keys(filter, copy = TRUE) %>% - dplyr::collect() - ) - - # The above filter_keys with `copy = TRUE` generates a dbplyr_### table. - # We manually remove this since we expect it. If more arise, we will get an error. - DBI::dbRemoveTable(conn, id(utils::head(get_tables(conn, "dbplyr_"), 1))) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-getTableSignature.R b/tests/testthat/test-getTableSignature.R deleted file mode 100644 index f5859a07..00000000 --- a/tests/testthat/test-getTableSignature.R +++ /dev/null @@ -1,369 +0,0 @@ -withr::local_options("stringsAsFactors" = FALSE) # Compatibility with R < 4.0.0 - -# Generate test datasets with different data types - -# One that follows the structure in update_snapshot() -data_update_snapsnot <- data.frame( - "Date" = Sys.Date(), - "POSIXct" = Sys.time(), - "character" = "test", - "integer" = 1L, - "numeric" = 1, - "logical" = TRUE, - # .. and our special columns - "checksum" = "test", - "from_ts" = Sys.time(), - "until_ts" = Sys.time() -) - -# One that has the special columns of update_snapshot(), but not at the end -data_random <- data.frame( - "Date" = Sys.Date(), - "POSIXct" = Sys.time(), - "character" = "test", - # .. Our special columns, but not at the end - "checksum" = "test", - "from_ts" = Sys.time(), - "until_ts" = Sys.time(), - # .. - "integer" = 1L, - "numeric" = 1, - "logical" = TRUE -) - -for (conn in c(list(NULL), get_test_conns())) { - - if (is.null(conn)) { - test_that("getTableSignature() generates signature for update_snapshot() (conn == NULL)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "Date", - "POSIXct" = "POSIXct", - "character" = "character", - "integer" = "integer", - "numeric" = "numeric", - "logical" = "logical", - # .. - "checksum" = "character", - "from_ts" = "POSIXct", - "until_ts" = "POSIXct" - ) - ) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for update_snapshot() (SQLiteConnection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "TEXT", - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "SMALLINT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for update_snapshot() (PqConnection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN", - # .. - "checksum" = "CHAR(32)", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for update_snapshot() (Microsoft SQL Server)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT", - # .. - "checksum" = "CHAR(64)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for update_snapshot() (duckdb_connection)", { - expect_identical( - getTableSignature(data_update_snapsnot, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN", - # .. - "checksum" = "char(32)", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP" - ) - ) - }) - } - - - if (is.null(conn)) { - test_that("getTableSignature() generates signature for random data (conn == NULL)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "Date", - "POSIXct" = "POSIXct", - "character" = "character", - # .. - "checksum" = "character", - "from_ts" = "POSIXct", - "until_ts" = "POSIXct", - # .. - "integer" = "integer", - "numeric" = "numeric", - "logical" = "logical" - ) - ) - }) - } - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for random data (SQLiteConnection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "SMALLINT" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for random data (PqConnection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMPTZ", - "until_ts" = "TIMESTAMPTZ", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for random data (Microsoft SQL Server)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - # .. - "checksum" = "varchar(255)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME", - # .. - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for random data (duckdb_connection)", { - expect_identical( - getTableSignature(data_random, conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - # .. - "checksum" = "STRING", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN" - ) - ) - }) - } - - - if (inherits(conn, "SQLiteConnection")) { - test_that("getTableSignature() generates signature for random data on remote (SQLiteConnection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DOUBLE", # By copying to SQLite and back, information is changed by - "POSIXct" = "DOUBLE", # dbplyr / DBI so data types are now similar, but different. - "character" = "TEXT", # Dates and timestamps which are normally stored in SQLite - # .. # as internally TEXT are now converted to DOUBLE - "checksum" = "TEXT", # Logical, which have the "SMALLINT" type are now "INT" - "from_ts" = "DOUBLE", # In the next test, we check that this conversion is consistent - "until_ts" = "DOUBLE", # for the user on the local R side. - # .. - "integer" = "INT", - "numeric" = "DOUBLE", - "logical" = "INT" - ) - ) - }) - } - - if (inherits(conn, "PqConnection")) { - test_that("getTableSignature() generates signature for random data on remote (PqConnection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMPTZ", - "character" = "TEXT", - # .. - "checksum" = "TEXT", - "from_ts" = "TIMESTAMPTZ", - "until_ts" = "TIMESTAMPTZ", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE PRECISION", - "logical" = "BOOLEAN" - ) - ) - }) - } - - if (inherits(conn, "Microsoft SQL Server")) { - test_that("getTableSignature() generates signature for random data on remote (Microsoft SQL Server)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "DATETIME", - "character" = "varchar(255)", - # .. - "checksum" = "varchar(255)", - "from_ts" = "DATETIME", - "until_ts" = "DATETIME", - # .. - "integer" = "INT", - "numeric" = "FLOAT", - "logical" = "BIT" - ) - ) - }) - } - - if (inherits(conn, "duckdb_connection")) { - test_that("getTableSignature() generates signature for random data on remote (duckdb_connection)", { - expect_identical( - getTableSignature(dplyr::copy_to(conn, data_random), conn), - c( - "Date" = "DATE", - "POSIXct" = "TIMESTAMP", - "character" = "STRING", - # .. - "checksum" = "STRING", - "from_ts" = "TIMESTAMP", - "until_ts" = "TIMESTAMP", - # .. - "integer" = "INTEGER", - "numeric" = "DOUBLE", - "logical" = "BOOLEAN" - ) - ) - }) - } - - - if (!is.null(conn)) { - test_that(glue::glue("getTableSignature() generates consistent data types ({class(conn)})"), { - # This tests that the data types are consistent when copying to a remote table with getTableSignature(). - # We first copy the data to a remote table, then copy that table to another remote table on the same connection. - # The - remote_data_1 <- dplyr::copy_to( - conn, - data_random, - name = "remote_data_1", - types = getTableSignature(data_random, conn) - ) - remote_data_2 <- dplyr::copy_to( - conn, - remote_data_1, - name = "remote_data_2", - types = getTableSignature(remote_data_1, conn) - ) - - # The table signatures are not always the same (eg. SQLiteConnection). - if (inherits(conn, "SQLiteConnection")) { - expect_false(identical( # In lieu of expect_not_identical - getTableSignature(data_random, conn), - getTableSignature(remote_data_1, conn) - )) - expect_identical( # nolint: expect_named_linter - names(getTableSignature(data_random, conn)), - names(getTableSignature(remote_data_1, conn)) - ) - } else { - expect_identical( - getTableSignature(data_random, conn), - getTableSignature(remote_data_1, conn) - ) - } - - # But the data, when transfered locally, should be the same - expect_identical(dplyr::collect(remote_data_2), dplyr::collect(remote_data_1)) - }) - } - - if (!is.null(conn)) connection_clean_up(conn) -} diff --git a/tests/testthat/test-interlace.R b/tests/testthat/test-interlace.R deleted file mode 100644 index a85f1787..00000000 --- a/tests/testthat/test-interlace.R +++ /dev/null @@ -1,53 +0,0 @@ -test_that("interlace.tbl_sql() works", { - for (conn in get_test_conns()) { - - t1 <- data.frame(key = c("A", "A", "B"), - obs_1 = c(1, 2, 2), - valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-01-01")), - valid_until = as.Date(c("2021-02-01", "2021-03-01", NA))) - - - t2 <- data.frame(key = c("A", "B"), - obs_2 = c("a", "b"), - valid_from = as.Date(c("2021-01-01", "2021-01-01")), - valid_until = as.Date(c("2021-04-01", NA))) - - - t_ref <- data.frame(key = c("A", "A", "A", "B"), - obs_1 = c(1, 2, NA, 2), - obs_2 = c("a", "a", "a", "b"), - valid_from = as.Date(c("2021-01-01", "2021-02-01", "2021-03-01", "2021-01-01")), - valid_until = as.Date(c("2021-02-01", "2021-03-01", "2021-04-01", NA))) - - - # Copy t1, t2 and t_ref to conn - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_tmp1", conn), overwrite = TRUE, temporary = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_tmp2", conn), overwrite = TRUE, temporary = FALSE) - t_ref <- dplyr::copy_to(conn, t_ref, name = id("test.SCDB_tmp3", conn), overwrite = TRUE, temporary = FALSE) - - - # Order of records may be different, so we arrange then check if they are identical - expect_identical(interlace(list(t1, t2), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from), - t_ref %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from)) - - # Order of columns will be different, so we only require a mapequal - # .. but order of records can still be different - expect_mapequal(interlace(list(t1, t2), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from), - interlace(list(t2, t1), by = "key") %>% - dplyr::collect() %>% - dplyr::arrange(.data$key, .data$valid_from)) - - connection_clean_up(conn) - } -}) - - -test_that("interlace returns early if length(table) == 1", { - expect_identical(mtcars["mpg"], interlace(list(mtcars["mpg"]), by = "mpg")) -}) diff --git a/tests/testthat/test-slice_time.R b/tests/testthat/test-slice_time.R deleted file mode 100644 index 10de7437..00000000 --- a/tests/testthat/test-slice_time.R +++ /dev/null @@ -1,34 +0,0 @@ -test_that("slice_time() works", { - for (conn in get_test_conns()) { - - # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically - xx <- get_table(conn, "__mtcars") %>% - dplyr::mutate(checksum = dplyr::row_number(), - from_ts = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), - until_ts = NA_character_) - - expect_identical(nrow(slice_time(xx, "2022-05-01")), 0L) - expect_identical(nrow(slice_time(xx, "2022-06-01")), 20L) - expect_identical(nrow(slice_time(xx, "2022-06-15")), nrow(mtcars)) - - connection_clean_up(conn) - } -}) - - -test_that("slice_time() works with non-standard columns", { - for (conn in get_test_conns()) { - - # SQLite does not work with dates. But since we use ISO 8601 for dates, we can compare lexicographically - xx <- get_table(conn, "__mtcars") %>% - dplyr::mutate(checksum = dplyr::row_number(), - valid_from = dplyr::if_else(checksum <= 20, "2022-06-01", "2022-06-15"), - valid_until = NA_character_) - - expect_identical(nrow(slice_time(xx, "2022-05-01", from_ts = "valid_from", until_ts = "valid_until")), 0L) - expect_identical(nrow(slice_time(xx, "2022-06-01", from_ts = "valid_from", until_ts = "valid_until")), 20L) - expect_identical(nrow(slice_time(xx, "2022-06-15", from_ts = "valid_from", until_ts = "valid_until")), nrow(mtcars)) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-unite.tbl_dbi.R b/tests/testthat/test-unite.tbl_dbi.R deleted file mode 100644 index 9e524adf..00000000 --- a/tests/testthat/test-unite.tbl_dbi.R +++ /dev/null @@ -1,63 +0,0 @@ -test_that("unite.tbl_dbi() works", { - for (conn in get_test_conns()) { - - q <- get_table(conn, "__mtcars") %>% utils::head(1) - qu_remove <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp) %>% - dplyr::compute(name = unique_table_name()) - qu <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", mpg, hp, remove = FALSE) %>% - dplyr::compute(name = unique_table_name()) - qu_alt <- tidyr::unite(dplyr::select(q, mpg, hp), "new_column", "mpg", "hp", remove = FALSE) %>% - dplyr::compute(name = unique_table_name()) - - expect_s3_class(qu_remove, "tbl_dbi") - expect_s3_class(qu, "tbl_dbi") - expect_s3_class(qu_alt, "tbl_dbi") - - expect_identical(colnames(qu_remove), "new_column") - expect_identical(colnames(qu), c("new_column", "mpg", "hp")) - expect_identical(colnames(qu_alt), c("new_column", "mpg", "hp")) - - expect_identical(dplyr::collect(qu), dplyr::collect(qu_alt)) - - # tidyr::unite has some quirky (and FUN!!! behavior) that we are forced to match here - # specifically, the input "col" is converted to a symbol, so we have to do escape-bullshit - # NOTE: the line "dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% " - # is to account for SQLite not having integer data-types. If we do not first convert to character, - # there will be differences between the objects that are trivial, so we remove these with this operation - # this way, the test should (hopefully) only fail if there are non-trivial differences - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite("new_col", mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite("new_col", mpg, hp)) - - col <- "new_col" - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite(col, mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite(col, mpg, hp)) - - expect_mapequal(get_table(conn, "__mtcars") %>% - tidyr::unite(!!col, mpg, hp) %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect(), - get_table(conn, "__mtcars") %>% - dplyr::mutate(dplyr::across(tidyselect::everything(), as.character)) %>% - dplyr::collect() %>% - tidyr::unite(!!col, mpg, hp)) - - # Unite places cols in a particular way, lets be sure we match - qq <- dplyr::mutate(q, dplyr::across(tidyselect::everything(), as.character)) # we convert to character since SQLite - expect_identical(qq %>% tidyr::unite("test_col", vs, am) %>% dplyr::collect(), - qq %>% dplyr::collect() %>% tidyr::unite("test_col", vs, am)) - - connection_clean_up(conn) - } -}) diff --git a/tests/testthat/test-update_snapshot.R b/tests/testthat/test-update_snapshot.R deleted file mode 100644 index 0e5cff69..00000000 --- a/tests/testthat/test-update_snapshot.R +++ /dev/null @@ -1,650 +0,0 @@ -test_that("update_snapshot() can handle first snapshot", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - expect_false(table_exists(conn, "test.SCDB_logs")) - - # Use unmodified mtcars as the initial snapshot - .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-01 09:00:00" - log_path <- tempdir() - - # Ensure all logs are removed - dir(log_path) %>% - purrr::keep(~ endsWith(., ".log")) %>% - purrr::walk(~ unlink(file.path(log_path, .))) - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = log_path, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - # Update - update_snapshot(.data, conn, db_table, timestamp, logger = logger) - - # Confirm snapshot is transferred correctly - expect_identical( - get_table(conn, db_table) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - - - ### For this test, we also check that the log output is correct ### - # Check file log outputs exists - log_pattern <- glue::glue("{stringr::str_replace_all(as.Date(timestamp), '-', '_')}.{id(db_table, conn)}.log") - log_file <- purrr::keep(dir(log_path), ~ stringr::str_detect(., log_pattern)) - expect_length(log_file, 1) - expect_gt(file.info(file.path(log_path, log_file))$size, 0) - expect_identical(nrow(get_table(conn, "test.SCDB_logs")), 1L) - - db_logs_with_log_file <- get_table(conn, "test.SCDB_logs") %>% - dplyr::filter(!is.na(.data$log_file)) - expect_identical(nrow(db_logs_with_log_file), 1L) - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% dplyr::collect() - - # The logs should have specified data types - types <- c( - "date" = "POSIXct", - "catalog" = "character", - "schema" = "character", - "table" = "character", - "n_insertions" = "numeric", - "n_deactivations" = "numeric", - "start_time" = "POSIXct", - "end_time" = "POSIXct", - "duration" = "character", - "success" = "logical", - "message" = "character" - ) - - if (inherits(conn, "SQLiteConnection")) { - types <- types %>% - purrr::map_if(~ identical(., "POSIXct"), "character") %>% # SQLite does not support POSIXct - purrr::map_if(~ identical(., "logical"), "numeric") %>% # SQLite does not support logical - as.character() - } - - checkmate::expect_data_frame(logs, nrows = 1, types) - - # Check the content of the log table - expect_identical(as.character(logs$date), as.character(timestamp)) - - db_table_id <- id(db_table, conn) - if ("catalog" %in% colnames(logs)) expect_identical(logs$catalog, purrr::pluck(db_table_id, "name", "catalog")) - expect_identical(logs$schema, purrr::pluck(db_table_id, "name", "schema")) - expect_identical(logs$table, purrr::pluck(db_table_id, "name", "table")) - - expect_identical(logs$n_insertions, nrow(mtcars)) - expect_identical(logs$n_deactivations, 0L) - expect_true(as.logical(logs$success)) - expect_identical(logs$message, NA_character_) - - - # Clean up the logs - unlink(logger$log_realpath) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can add a new snapshot", { - for (conn in get_test_conns()) { - - # Modify snapshot and run update step - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 130, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-03 09:00:00" - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - - # Update - # This is a simple update where 15 rows are replaced with 15 new ones on the given date - update_snapshot(.data, conn, db_table, timestamp, logger = logger) - - # Check the snapshot has updated correctly - target <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::as_tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-03 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-03 09:00:00")), - nrow(mtcars) - ) - - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% - dplyr::collect() %>% - utils::tail(1) - - expect_identical(logs$n_insertions, 15L) - expect_identical(logs$n_deactivations, 15L) - expect_true(as.logical(logs$success)) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can update a snapshot on an existing date", { - for (conn in get_test_conns()) { - - # We now attempt to do another update on the same date - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 100, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # Configure the logger for this update - db_table <- "test.SCDB_tmp1" - timestamp <- "2022-10-03 09:00:00" - - logger <- Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - - - # This is a more complicated update where a further 8 rows are replaced with 8 new ones on the same date as before - update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = logger) - - # Even though we insert twice on the same date, we expect the data to be minimal (compacted) - target <- dplyr::tbl(conn, id(db_table, conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-03 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-03 09:00:00")), - nrow(mtcars) - ) - - - # Check database log output - logs <- get_table(conn, "test.SCDB_logs") %>% - dplyr::collect() %>% - utils::tail(1) - - expect_identical(logs$n_insertions, 8L) - expect_identical(logs$n_deactivations, 8L) - expect_true(as.logical(logs$success)) - - close_connection(conn) - } -}) - -test_that("update_snapshot() can insert a snapshot between existing dates", { - for (conn in get_test_conns()) { - - # We now attempt to an update between these two updates - .data <- mtcars %>% - dplyr::mutate(hp = dplyr::if_else(hp > 150, hp - 10, hp)) %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - - # This should fail if we do not specify "enforce_chronological_order = FALSE" - expect_error( - update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", logger = LoggerNull$new()), - regexp = "Given timestamp 2022-10-02 09:00:00 is earlier" - ) - - # But not with the variable set - update_snapshot(.data, conn, "test.SCDB_tmp1", "2022-10-02 09:00:00", - logger = LoggerNull$new(), enforce_chronological_order = FALSE) - - - target <- dplyr::tbl(conn, id("test.SCDB_tmp1", conn)) - expect_identical( - slice_time(target, "2022-10-01 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - mtcars %>% - dplyr::arrange(wt, qsec) %>% - tibble::tibble() - ) - expect_identical( - nrow(slice_time(target, "2022-10-01 09:00:00")), - nrow(mtcars) - ) - - expect_identical( - slice_time(target, "2022-10-02 09:00:00") %>% - dplyr::select(!c("from_ts", "until_ts", "checksum")) %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec), - .data %>% - dplyr::collect() %>% - dplyr::arrange(wt, qsec) - ) - expect_identical( - nrow(slice_time(target, "2022-10-02 09:00:00")), - nrow(mtcars) - ) - - close_connection(conn) - } -}) - - - -test_that("update_snapshot() works (holistic test 1)", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - - - # Create test data for the test - t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) - t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) - t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) - - # Copy t0, t1, and t2 to conn - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - logger <- LoggerNull$new() - update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01 08:00:00", logger = logger) - expect_identical( - dplyr::collect(t0) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - update_snapshot( - t1, - conn, - "test.SCDB_tmp1", - "2022-01-01 08:10:00", - logger = logger, - collapse_continuous_records = TRUE - ) - expect_identical( - dplyr::collect(t1) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - update_snapshot( - t2, - conn, - "test.SCDB_tmp1", - "2022-01-01 08:10:00", - logger = logger, - collapse_continuous_records = TRUE - ) - expect_identical( - dplyr::collect(t2) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1) - ) - - t <- list(t0, t1, t2) %>% - purrr::reduce(dplyr::union) %>% - dplyr::collect() %>% - dplyr::mutate(col2 = as.character(col2)) %>% - dplyr::arrange(col1, col2) %>% - utils::head(5) - - t_ref <- get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% - dplyr::select(!any_of(c("from_ts", "until_ts", "checksum"))) %>% - dplyr::collect() %>% - dplyr::mutate(col2 = as.character(col2)) %>% - dplyr::arrange(col1, col2) - - expect_identical(t, t_ref) - - close_connection(conn) - } -}) - -test_that("update_snapshot() works (holistic test 2)", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - expect_false(table_exists(conn, "test.SCDB_tmp1")) - - - # Create test data for the test - t0 <- data.frame(col1 = c("A", "B"), col2 = c(NA_real_, NA_real_)) - t1 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, NA_real_, NA_real_)) - t2 <- data.frame(col1 = c("A", "B", "C"), col2 = c(1, 2, 3)) - - # Copy t0, t1, and t2 to conn (and suppress check_from message) - t0 <- dplyr::copy_to(conn, t0, name = id("test.SCDB_t0", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t1 <- dplyr::copy_to(conn, t1, name = id("test.SCDB_t1", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - t2 <- dplyr::copy_to(conn, t2, name = id("test.SCDB_t2", conn), overwrite = TRUE, temporary = FALSE, analyze = FALSE) - - - # Check non-chronological insertion - logger <- LoggerNull$new() - update_snapshot(t0, conn, "test.SCDB_tmp1", "2022-01-01", logger = logger) - expect_identical(dplyr::collect(t0) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) - - update_snapshot(t2, conn, "test.SCDB_tmp1", "2022-03-01", logger = logger) - expect_identical(dplyr::collect(t2) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1")) %>% dplyr::arrange(col1)) - - update_snapshot(t1, conn, "test.SCDB_tmp1", "2022-02-01", logger = logger, enforce_chronological_order = FALSE) - expect_identical( - dplyr::collect(t1) %>% dplyr::arrange(col1), - dplyr::collect(get_table(conn, "test.SCDB_tmp1", slice_ts = "2022-02-01")) %>% dplyr::arrange(col1) - ) - - t_ref <- - tibble::tibble(col1 = c("A", "B", "A", "C", "B", "C"), - col2 = c(NA_real_, NA_real_, 1, NA_real_, 2, 3), - from_ts = c("2022-01-01", "2022-01-01", "2022-02-01", "2022-02-01", "2022-03-01", "2022-03-01"), - until_ts = c("2022-02-01", "2022-03-01", NA, "2022-03-01", NA, NA)) - - expect_identical( - get_table(conn, "test.SCDB_tmp1", slice_ts = NULL) %>% - dplyr::select(!"checksum") %>% - dplyr::collect() %>% - dplyr::mutate(from_ts = strftime(from_ts), - until_ts = strftime(until_ts)) %>% - dplyr::arrange(col1, from_ts), - t_ref %>% - dplyr::arrange(col1, from_ts) - ) - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() handles 'NULL' updates", { - for (conn in get_test_conns()) { - - if (DBI::dbExistsTable(conn, id("test.SCDB_tmp1", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_tmp1", conn)) - if (DBI::dbExistsTable(conn, id("test.SCDB_logs", conn))) DBI::dbRemoveTable(conn, id("test.SCDB_logs", conn)) - - # Use mtcars as the test data set - .data <- mtcars %>% - dplyr::copy_to(conn, df = ., name = unique_table_name(), analyze = FALSE) - defer_db_cleanup(.data) - - # This is a simple update where 23 rows are replaced with 23 new ones on the given date - db_table <- "test.SCDB_tmp1" - - create_logger <- function(timestamp) { - Logger$new( - db_table = db_table, - timestamp = timestamp, - log_path = NULL, - log_table_id = "test.SCDB_logs", - log_conn = conn, - output_to_console = FALSE - ) - } - - # Update the table with update_snapshot() and store the results - update_snapshot(.data, conn, db_table, "2022-10-03 09:00:00", logger = create_logger("2022-10-03 09:00:00")) - target_data_1 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() - - # Update the table with the same data again update_snapshot() and store the results - update_snapshot(.data, conn, db_table, "2022-10-04 09:00:00", logger = create_logger("2022-10-04 09:00:00")) - target_data_2 <- get_table(conn, db_table, slice_ts = NULL) %>% dplyr::collect() - - # Check that the two updates are identical - expect_identical(target_data_1, target_data_2) - - # Confirm with logs that no updates have been made - logs <- get_table(conn, id("test.SCDB_logs", conn)) %>% - dplyr::collect() %>% - dplyr::arrange(date) - - expect_identical(logs$n_insertions, c(nrow(mtcars), 0L)) - expect_identical(logs$n_deactivations, c(0L, 0L)) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() works with Id objects", { - withr::local_options("SCDB.log_path" = NULL) # No file logging - - for (conn in get_test_conns()) { - - target_table <- id("test.mtcars_modified", conn) - - logger <- Logger$new(output_to_console = FALSE, - timestamp = Sys.time(), - db_table = "test.mtcars_modified", - log_conn = NULL, - log_table_id = NULL, - warn = FALSE) - - expect_no_error( - mtcars %>% - dplyr::mutate(disp = sample(mtcars$disp, nrow(mtcars))) %>% - dplyr::copy_to(dest = conn, df = ., name = unique_table_name(), analyze = FALSE) %>% - update_snapshot( - conn = conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() checks table formats", { - - withr::local_options("SCDB.log_path" = tempdir()) - - for (conn in get_test_conns()) { - - mtcars_table <- dplyr::tbl(conn, id("__mtcars_historical", conn = conn)) - timestamp <- Sys.time() - - expect_warning( - logger <- Logger$new(log_path = NULL, log_table_id = NULL, output_to_console = FALSE), # nolint: implicit_assignment_linter - "NO file or database logging will be done." - ) - - # Test columns not matching - broken_table <- dplyr::copy_to(conn, dplyr::select(mtcars, !"mpg"), name = "mtcars_broken", overwrite = TRUE, analyze = FALSE) - - expect_error( - update_snapshot( - .data = broken_table, - conn = conn, - db_table = mtcars_table, - timestamp = timestamp, - logger = logger - ), - "Columns do not match!" - ) - - file.remove(list.files(getOption("SCDB.log_path"), pattern = format(timestamp, "^%Y%m%d.%H%M"), full.names = TRUE)) - - # Test target table not being a historical table - expect_error( - update_snapshot( - dplyr::tbl(conn, id("__mtcars", conn = conn)), - conn, - id("__mtcars", conn = conn), - timestamp = timestamp, - logger = logger - ), - "Table does not seem like a historical table" - ) - - connection_clean_up(conn) - } -}) - - -test_that("update_snapshot() works with across connection", { - skip_if_not_installed("RSQLite") - - withr::local_options("SCDB.log_path" = NULL) # No file logging - - # Test a data transfer from a local SQLite to the test connection - source_conn <- DBI::dbConnect(RSQLite::SQLite()) - - # Create a table for the tests - mtcars_modified <- mtcars %>% - dplyr::mutate(name = rownames(mtcars)) - - # Copy table to the source - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) - - # For each conn, we test if update_snapshot preserves data types - for (target_conn in get_test_conns()) { - - target_table <- id("test.mtcars_modified", target_conn) - if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) - - logger <- LoggerNull$new() - - # Check we can transfer without error - expect_no_error( - update_snapshot( - .data, - conn = target_conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - # Check that if we collect the table, the signature will match the original - table_signature <- get_table(target_conn, target_table) %>% - dplyr::collect() %>% - dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% - as.data.frame() - - expect_identical( - table_signature, - dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) - ) - - - DBI::dbRemoveTable(target_conn, target_table) - connection_clean_up(target_conn) - rm(logger) - invisible(gc()) - } - connection_clean_up(source_conn) - - - ## Now we test the reverse transfer - - # Test a data transfer from the test connection to a local SQLite - target_conn <- DBI::dbConnect(RSQLite::SQLite()) - - # For each conn, we test if update_snapshot preserves data types - for (source_conn in get_test_conns()) { - - .data <- dplyr::copy_to(dest = source_conn, df = mtcars_modified, name = unique_table_name(), analyze = FALSE) - - target_table <- id("mtcars_modified", target_conn) - if (DBI::dbExistsTable(target_conn, target_table)) DBI::dbRemoveTable(target_conn, target_table) - - logger <- LoggerNull$new() - - # Check we can transfer without error - expect_no_error( - update_snapshot( - .data, - conn = target_conn, - db_table = target_table, - logger = logger, - timestamp = format(Sys.time()) - ) - ) - - # Check that if we collect the table, the signature will match the original - table_signature <- get_table(target_conn, target_table) %>% - dplyr::collect() %>% - dplyr::summarise(dplyr::across(tidyselect::everything(), ~ class(.)[1])) %>% - as.data.frame() - - expect_identical( - table_signature, - dplyr::summarise(mtcars_modified, dplyr::across(tidyselect::everything(), ~ class(.)[1])) - ) - - - connection_clean_up(source_conn) - rm(logger) - invisible(gc()) - } - connection_clean_up(target_conn) -}) From df96ce31872b1d61d9aac41b7ffc890a35a5579e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 14:21:09 +0100 Subject: [PATCH 122/129] remove printing statements --- tests/testthat/test-get_tables.R | 7 ------- 1 file changed, 7 deletions(-) diff --git a/tests/testthat/test-get_tables.R b/tests/testthat/test-get_tables.R index be9656e7..2b09c446 100644 --- a/tests/testthat/test-get_tables.R +++ b/tests/testthat/test-get_tables.R @@ -101,13 +101,6 @@ test_that("get_tables() works with temporary tables", { checkmate::expect_subset(c(table_1, table_2, tmp_name), db_table_names) connection_clean_up(conn) - - print("DBI::dbIsValid(conn)") - print(DBI::dbIsValid(conn)) - print("DBI::dbExistsTable(conn, tmp_id)") - print(DBI::dbExistsTable(conn, tmp_id)) - print("DBI::dbRemoveTable(conn, tmp_id)") - print(DBI::dbRemoveTable(conn, tmp_id)) } }) From 36330f764875459de3d123ace7dbff0abc4a7704 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 14:29:53 +0100 Subject: [PATCH 123/129] fix(test-get_tables): Add additional clean-up --- tests/testthat/test-get_tables.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-get_tables.R b/tests/testthat/test-get_tables.R index 2b09c446..633cd433 100644 --- a/tests/testthat/test-get_tables.R +++ b/tests/testthat/test-get_tables.R @@ -80,6 +80,7 @@ test_that("get_tables() works with temporary tables", { # Create temporary table tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) + defer_db_cleanup(tmp) tmp_id <- id(tmp) tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") @@ -110,6 +111,7 @@ test_that("get_tables() works without temporary tables", { # Create temporary table tmp <- dplyr::copy_to(conn, mtcars, "__mtcars_2", temporary = TRUE) + defer_db_cleanup(tmp) tmp_id <- id(tmp) tmp_name <- paste(tmp_id@name["schema"], tmp_id@name["table"], sep = ".") From a9a8409709b7f4cae2b804617990f7b5008061eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 14:33:28 +0100 Subject: [PATCH 124/129] debug locks --- tests/testthat/test-locks.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-locks.R b/tests/testthat/test-locks.R index ed5e2da2..7dacdc3d 100644 --- a/tests/testthat/test-locks.R +++ b/tests/testthat/test-locks.R @@ -5,7 +5,7 @@ test_that("lock helpers works in default and test schema", { # Define the testing tables test_table_id <- id(paste(c(schema, "mtcars"), collapse = "."), conn) lock_table_id <- id(paste(c(schema, "locks"), collapse = "."), conn) - + stop(lock_table_id) ## Check we can add locks expect_true(lock_table(conn, db_table = test_table_id, schema = schema)) From f98f168a1956aad95fd3bdfe5c1ed2f18704ce12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 14:58:30 +0100 Subject: [PATCH 125/129] add visible binding to db_collect() --- R/backend_oracle.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/backend_oracle.R b/R/backend_oracle.R index 09a96467..94262953 100644 --- a/R/backend_oracle.R +++ b/R/backend_oracle.R @@ -62,7 +62,7 @@ setClass( #' @export db_collect.OracleJdbc <- function(con, sql, n = -1, ...) { - dbGetQuery(con, sql, n, ...) + DBI::dbGetQuery(con, sql, n, ...) } From ef7b636fc54bc54bb24ec46d3f401dffa8685538 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 14:59:13 +0100 Subject: [PATCH 126/129] Revert "debug locks" This reverts commit a9a8409709b7f4cae2b804617990f7b5008061eb. --- tests/testthat/test-locks.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-locks.R b/tests/testthat/test-locks.R index 7dacdc3d..ed5e2da2 100644 --- a/tests/testthat/test-locks.R +++ b/tests/testthat/test-locks.R @@ -5,7 +5,7 @@ test_that("lock helpers works in default and test schema", { # Define the testing tables test_table_id <- id(paste(c(schema, "mtcars"), collapse = "."), conn) lock_table_id <- id(paste(c(schema, "locks"), collapse = "."), conn) - stop(lock_table_id) + ## Check we can add locks expect_true(lock_table(conn, db_table = test_table_id, schema = schema)) From 3c63510da4c9e3a3d96478e99a037f084b383346 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 15:03:37 +0100 Subject: [PATCH 127/129] test: Create test for `defer_db_cleanup` --- tests/testthat/test-defer_db_cleanup.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 tests/testthat/test-defer_db_cleanup.R diff --git a/tests/testthat/test-defer_db_cleanup.R b/tests/testthat/test-defer_db_cleanup.R new file mode 100644 index 00000000..f1f2aaa8 --- /dev/null +++ b/tests/testthat/test-defer_db_cleanup.R @@ -0,0 +1,19 @@ +test_that("`defer_db_cleanup()` deletes tables", { + for (conn in get_test_conns()) { + table <- dplyr::copy_to(conn, mtcars, "__mtcars_defer_db_cleanup") + table_id <- id(table, conn) + + # Table exists + expect_true(DBI::dbExistsTable(conn, table_id)) + + # Marking for deletion does not delete the table + defer_db_cleanup(table_id) + expect_true(DBI::dbExistsTable(conn, table_id)) + + # Manually triggering deletion deletes the table + withr::deferred_run() + expect_false(DBI::dbExistsTable(conn, table_id)) + + connection_clean_up(conn) + } +}) From 69eb339ab15ead0f24f6e2fc674bd1b58ca532b8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 15:23:35 +0100 Subject: [PATCH 128/129] debug defer_db_cleanup --- tests/testthat/test-defer_db_cleanup.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-defer_db_cleanup.R b/tests/testthat/test-defer_db_cleanup.R index f1f2aaa8..245e4beb 100644 --- a/tests/testthat/test-defer_db_cleanup.R +++ b/tests/testthat/test-defer_db_cleanup.R @@ -2,6 +2,7 @@ test_that("`defer_db_cleanup()` deletes tables", { for (conn in get_test_conns()) { table <- dplyr::copy_to(conn, mtcars, "__mtcars_defer_db_cleanup") table_id <- id(table, conn) + stop(table_id) # Table exists expect_true(DBI::dbExistsTable(conn, table_id)) From a9017e01858cb88cede414bc231a2ea6c9192f19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rasmus=20Skytte=20Randl=C3=B8v?= Date: Thu, 13 Nov 2025 15:24:12 +0100 Subject: [PATCH 129/129] debug defer_db_cleanup --- tests/testthat/test-defer_db_cleanup.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-defer_db_cleanup.R b/tests/testthat/test-defer_db_cleanup.R index 245e4beb..6797bb60 100644 --- a/tests/testthat/test-defer_db_cleanup.R +++ b/tests/testthat/test-defer_db_cleanup.R @@ -5,6 +5,7 @@ test_that("`defer_db_cleanup()` deletes tables", { stop(table_id) # Table exists + expect_true(DBI::dbExistsTable(conn, "__mtcars_defer_db_cleanup")) expect_true(DBI::dbExistsTable(conn, table_id)) # Marking for deletion does not delete the table