From b93d3b1ddaa54379aec4a26504ba3d9b01c178fc Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 09:37:23 +0200 Subject: [PATCH 1/9] update setup to run tests --- tests/testthat/setup.R | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 4a227c2f..59887fd1 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -170,29 +170,30 @@ if (.Platform$OS.type == "windows") { } # BigQuery ------------------------------------------------------------------ -if (Sys.getenv("CDM_BIG_QUERY_CONNECTION_STRING") != "") { +if (Sys.getenv("CDM_BIG_QUERY_PROJECT") != "" & Sys.getenv("CDM_BIG_QUERY_BILLING") != "") { # To avoid rate limit on BigQuery, only test on 1 OS: - if (.Platform$OS.type == "windows") { + #if (.Platform$OS.type == "windows") { bqKeyFile <- tempfile(fileext = ".json") writeLines(Sys.getenv("CDM_BIG_QUERY_KEY_FILE"), bqKeyFile) if (testthat::is_testing()) { withr::defer(unlink(bqKeyFile, force = TRUE), testthat::teardown_env()) } - bqConnectionString <- gsub("", - normalizePath(bqKeyFile, winslash = "/"), - Sys.getenv("CDM_BIG_QUERY_CONNECTION_STRING")) + + bigrquery::bq_auth(path = bqKeyFile) + testServers[[length(testServers) + 1]] <- list( - connectionDetails = details <- createConnectionDetails( + connectionDetails = details <- DatabaseConnector::createDbiConnectionDetails( dbms = "bigquery", - user = "", - password = "", - connectionString = !!bqConnectionString + drv = bigrquery::bigquery(), + project = Sys.getenv("CDM_BIG_QUERY_PROJECT"), + billing = Sys.getenv("CDM_BIG_QUERY_BILLING"), + bigint = "integer64" ), NULL, cdmDatabaseSchema = Sys.getenv("CDM_BIG_QUERY_CDM_SCHEMA"), tempEmulationSchema = Sys.getenv("CDM_BIG_QUERY_OHDSI_SCHEMA") ) - } + #} } # InterSystems IRIS ----------------------------------------------------------------- From 86f797d9faf34c472c938fa2118a729ea1694251 Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 10:13:46 +0200 Subject: [PATCH 2/9] ListTables.R: if dbms is 'bigquery' uses bigrquery:: function to list tables --- R/ListTables.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/R/ListTables.R b/R/ListTables.R index c2c1efe6..21522a16 100644 --- a/R/ListTables.R +++ b/R/ListTables.R @@ -44,6 +44,17 @@ setMethod( } sql <- sprintf("SELECT table_name FROM information_schema.tables WHERE table_schema = '%s';", databaseSchema) tables <- querySql(conn, sql)[[1]] + } else if (!is.null(databaseSchema) && dbms(conn) == "bigquery") { + if (!grepl("\\.", databaseSchema)) { + abort("databaseSchema must contain full path when using bigquery as .") + } + bq_list_tables <- bigrquery::bq_dataset_tables(databaseSchema) + tables <- c() + for (table in bq_list_tables) { + if (table$type == "TABLE") { + tables <- c(tables, table$table) + } + } } else { tables <- DBI::dbListTables(conn@dbiConnection, schema = databaseSchema) } From 3b95a86e67eb714a6c52684a35c95b9ccb26f4b8 Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 10:46:14 +0200 Subject: [PATCH 3/9] skip some test if postgress not set --- tests/testthat/test-DBItest.R | 3 +++ tests/testthat/test-connection.R | 1 + tests/testthat/test-getTableNames.R | 4 ++-- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-DBItest.R b/tests/testthat/test-DBItest.R index 0c216fbf..8ddb16b4 100644 --- a/tests/testthat/test-DBItest.R +++ b/tests/testthat/test-DBItest.R @@ -1,4 +1,7 @@ # Run only DBI tests with testthat::test_file("tests/testthat/test-DBItest.R") +if(Sys.getenv("CDM5_POSTGRESQL_USER") == "" || Sys.getenv("CDM5_POSTGRESQL_SERVER") == "") { + testthat::skip("PostgreSQL environment variables not set") +} port <- Sys.getenv("CDM5_POSTGRESQL_PORT") if (port == "") port <- "5432" diff --git a/tests/testthat/test-connection.R b/tests/testthat/test-connection.R index 9fb1efa6..62025ec3 100644 --- a/tests/testthat/test-connection.R +++ b/tests/testthat/test-connection.R @@ -30,6 +30,7 @@ test_that("getAvailableJavaHeapSpace returns a positive number", { }) test_that("Error is thrown when forgetting password", { + testthat::skip_if(Sys.getenv("CDM5_POSTGRESQL_USER") == "" || Sys.getenv("CDM5_POSTGRESQL_SERVER") == "", "PostgreSQL environment variables not set") details <- createConnectionDetails( dbms = "postgresql", user = Sys.getenv("CDM5_POSTGRESQL_USER"), diff --git a/tests/testthat/test-getTableNames.R b/tests/testthat/test-getTableNames.R index c5001138..159f83d7 100644 --- a/tests/testthat/test-getTableNames.R +++ b/tests/testthat/test-getTableNames.R @@ -7,8 +7,8 @@ for (testServer in testServers) { tables <- getTableNames(connection, testServer$cdmDatabaseSchema) expect_true("person" %in% tables) expect_true(existsTable(connection, testServer$cdmDatabaseSchema, "person")) - # This does not work on SQL Server: - if (testServer$connectionDetails$dbms != "sql server") { + # This does not work on SQL Server or BigQuery: + if (testServer$connectionDetails$dbms != "sql server" && testServer$connectionDetails$dbms != "bigquery") { expect_true(DBI::dbExistsTable(connection, "person")) } From 7cec4d2e118a9ce89161b96e2ba674c758de9830 Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 12:14:54 +0200 Subject: [PATCH 4/9] Added InsertTable changes. Addapted test --- R/InsertTable.R | 32 +++++++++++++++++++++++++++++++ R/RStudio.R | 6 +++++- tests/testthat/test-insertTable.R | 20 +++++++++++++------ 3 files changed, 51 insertions(+), 7 deletions(-) diff --git a/R/InsertTable.R b/R/InsertTable.R index 99a5f702..286ac6b2 100644 --- a/R/InsertTable.R +++ b/R/InsertTable.R @@ -471,6 +471,7 @@ insertTable.default <- function(connection, } } } + if (dbms(connection) == "spark") { # Spark automatically converts table names to lowercase, but will throw an error # that the table already exists when using dbWriteTable to append, and the table @@ -485,6 +486,37 @@ insertTable.default <- function(connection, } } + + if (dbms(connection) == "bigquery") { + if (tempTable) { + #BigQuery does not support temp tables, so emulate + databaseSchema = tempEmulationSchema + tableName <- SqlRender::translate(sprintf("#%s", tableName), targetDialect = "bigquery", tempEmulationSchema = NULL) + tempTable <- FALSE + } + if (dropTableIfExists) { + # bigrquery::bq_table_upload is not dropping tables, so we need to do it manually + sql <- "DROP TABLE IF EXISTS @databaseSchema.@tableName;" + renderTranslateExecuteSql( + connection = connection, + sql = sql, + databaseSchema = databaseSchema, + tableName = tableName, + tempEmulationSchema = tempEmulationSchema, + progressBar = FALSE, + reportOverallTime = FALSE + ) + dropTableIfExists <- FALSE + } + # Convert datetime to UTC to avoid timezone issues + for (i in 1:ncol(data)) { + column <- data[[i]] + if (inherits(column, "POSIXct")) { + # Force timezone to UTC before insertion + attr(data[[i]], "tzone") <- "UTC" + } + } + } logTrace(sprintf("Inserting %d rows into table '%s' ", nrow(data), tableName)) if (!is.null(databaseSchema)) { diff --git a/R/RStudio.R b/R/RStudio.R index 8390b7b2..03dd4d83 100644 --- a/R/RStudio.R +++ b/R/RStudio.R @@ -71,7 +71,11 @@ unregisterWithRStudio <- function(connection) { displayName <- registeredDisplayNames$displayName[registeredDisplayNames$uuid == connection@uuid] registeredDisplayNames <- registeredDisplayNames[registeredDisplayNames$uuid != connection@uuid, ] options(registeredDisplayNames = registeredDisplayNames) - observer$connectionClosed(compileTypeLabel(connection), displayName) + # Only call connectionClosed if we have exactly one displayName + # (handles both RStudio and Positron gracefully) + if (length(displayName) == 1) { + observer$connectionClosed(compileTypeLabel(connection), displayName) + } } } diff --git a/tests/testthat/test-insertTable.R b/tests/testthat/test-insertTable.R index 58f4c04a..fc4b7f57 100644 --- a/tests/testthat/test-insertTable.R +++ b/tests/testthat/test-insertTable.R @@ -50,8 +50,8 @@ data$booleans[c(3,9)] <- NA for (testServer in testServers) { test_that(addDbmsToLabel("Insert data", testServer), { # skip_if(testServer$connectionDetails$dbms == "oracle") # Booleans are passed to and from Oracle but NAs are not persevered. still need to fix that. - if (testServer$connectionDetails$dbms %in% c("redshift", "bigquery")) { - # Inserting on RedShift or BigQuery is slow (Without bulk upload), so + if (testServer$connectionDetails$dbms %in% c("redshift")) { + # Inserting on RedShift is slow (Without bulk upload), so # taking subset: dataCopy1 <- data[1:10, ] } else { @@ -85,7 +85,9 @@ for (testServer in testServers) { ) # Check data on server is same as local - dataCopy2 <- renderTranslateQuerySql(connection, "SELECT * FROM #temp;", integer64AsNumeric = FALSE) + columnsOrder = paste(colnames(dataCopy1), collapse = ", ") + dataCopy2 <- renderTranslateQuerySql(connection, "SELECT @columnsOrder FROM #temp;", integer64AsNumeric = FALSE, columnsOrder = columnsOrder) + names(dataCopy2) <- tolower(names(dataCopy2)) dataCopy1 <- dataCopy1[order(dataCopy1$person_id), ] dataCopy2 <- dataCopy2[order(dataCopy2$person_id), ] @@ -93,9 +95,15 @@ for (testServer in testServers) { row.names(dataCopy2) <- NULL attr(dataCopy1$some_datetime, "tzone") <- NULL attr(dataCopy2$some_datetime, "tzone") <- NULL - expect_equal(dataCopy1, dataCopy2, check.attributes = FALSE, tolerance = 1e-7) - sql <- SqlRender::translate("SELECT * FROM #temp;", targetDialect = dbms(connection)) + tolerance <- 1e-7 + if(testServer$connectionDetails$dbms == "bigquery") { + tolerance <- 5e-6 # BigQuery has lower precision for floats, so need to use higher tolerance + } + expect_equal(dataCopy1, dataCopy2, check.attributes = FALSE, tolerance = tolerance) + + sql <- SqlRender::render("SELECT @columnsOrder FROM #temp;", columnsOrder = columnsOrder) + sql <- SqlRender::translate(sql, targetDialect = dbms(connection)) # Check data types res <- dbSendQuery(connection, sql, translate = FALSE) columnInfo <- dbColumnInfo(res) @@ -118,7 +126,7 @@ for (testServer in testServers) { } else if (dbms == "spark") { expect_equal(as.character(columnInfo$field.type), c("DATE", "TIMESTAMP", "INT", "DOUBLE", "STRING", "BIGINT", "BOOLEAN")) } else if (dbms == "bigquery") { - expect_equal(as.character(columnInfo$field.type), c("DATE", "DATETIME", "INT64", "FLOAT64", "STRING", "INT64", "BOOLEAN")) + expect_equal(as.character(columnInfo$type), c("DATE", "TIMESTAMP", "INTEGER", "FLOAT", "STRING", "INTEGER", "BOOLEAN")) } else if (dbms == "iris") { expect_equal(as.character(columnInfo$field.type), c("DATE", "TIMESTAMP", "INTEGER", "DOUBLE", "VARCHAR", "BIGINT")) } else { From 684e1ab201dd40555590759035a695e08c81083a Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 12:24:00 +0200 Subject: [PATCH 5/9] tests: skip slice_sample relocation test on BigQuery (uses RAND()) --- tests/testthat/dbplyrTestFunction.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/tests/testthat/dbplyrTestFunction.R b/tests/testthat/dbplyrTestFunction.R index 1a0ef95f..39f98412 100644 --- a/tests/testthat/dbplyrTestFunction.R +++ b/tests/testthat/dbplyrTestFunction.R @@ -73,12 +73,15 @@ testDbplyrFunctions <- function(connectionDetails, cdmDatabaseSchema) { } # Test slicing --------------------------------------------------------------- - personSample <- person %>% - slice_sample(n = 10) %>% - relocate(care_site_id) %>% - collect() - expect_equal(nrow(personSample), 10) - expect_equal(which(names(personSample) == "care_site_id"), 1) + # BigQuery uses RAND() not RANDOM() for random sampling - ?? + if (!(dbms(connection) %in% c("bigquery"))) { + personSample <- person %>% + slice_sample(n = 10) %>% + relocate(care_site_id) %>% + collect() + expect_equal(nrow(personSample), 10) + expect_equal(which(names(personSample) == "care_site_id"), 1) + } # Test ifelse ---------------------------------------------------------------- sexString <- person %>% From 05230c52d0e6d395e395c114b1404d642f66c9e9 Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 12:28:05 +0200 Subject: [PATCH 6/9] DBI.R: for a DatabaseConnectorDbiConnection if dbms is 'bigquery' uses delayIfNecessaryForDdl and delayIfNecessaryForInsert, just like it does for JDBC --- R/DBI.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/DBI.R b/R/DBI.R index 66a2a044..ac9559ef 100644 --- a/R/DBI.R +++ b/R/DBI.R @@ -443,6 +443,10 @@ setMethod( signature("DatabaseConnectorDbiConnection", "character"), function(conn, statement, ...) { rowsAffected <- DBI::dbExecute(conn@dbiConnection, statement) + if (conn@dbms == "bigquery") { + delayIfNecessaryForDdl(statement) + delayIfNecessaryForInsert(statement) + } return(rowsAffected) } ) From b914515e9d0601f0222c9a72b160b0033df421e1 Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 12:37:12 +0200 Subject: [PATCH 7/9] Sql.R: On the above delay function I had to fix the regex so that It works also when using . If there is an error and dbms is 'bigquery' take the error message from err$body, that contains the real sql error --- R/LowLevelFunctions.R | 14 +++++--------- R/Sql.R | 14 +++++++++----- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/LowLevelFunctions.R b/R/LowLevelFunctions.R index 410042e5..d7bd8c7e 100644 --- a/R/LowLevelFunctions.R +++ b/R/LowLevelFunctions.R @@ -84,7 +84,8 @@ delayIfNecessary <- function(sql, regex, executionTimes, threshold) { if (!is.na(lastExecutedTime) && !is.null(lastExecutedTime)) { delta <- difftime(currentTime, lastExecutedTime, units = "secs") if (delta < threshold) { - Sys.sleep(threshold - delta) + Sys.sleep(threshold - delta) + message(paste("Delayed for", threshold - delta, "seconds for", tableName)) } } executionTimes[[tableName]] <- currentTime @@ -92,12 +93,12 @@ delayIfNecessary <- function(sql, regex, executionTimes, threshold) { } delayIfNecessaryForDdl <- function(sql) { - regexForDdl <- "(^CREATE\\s+TABLE\\s+IF\\s+EXISTS|^CREATE\\s+TABLE|^DROP\\s+TABLE\\s+IF\\s+EXISTS|^DROP\\s+TABLE)\\s+([a-zA-Z0-9_$#-]*\\.?\\s*(?:[a-zA-Z0-9_]+)*)" + regexForDdl <- "(^CREATE\\s+TABLE\\s+IF\\s+EXISTS|^CREATE\\s+TABLE|^DROP\\s+TABLE\\s+IF\\s+EXISTS|^DROP\\s+TABLE)\\s+([a-zA-Z0-9_$#-]*\\.?\\s*(?:[a-zA-Z0-9_]+)*\\.?\\s*(?:[a-zA-Z0-9_]+))" delayIfNecessary(sql, regexForDdl, ddlExecutionTimes, 5) } delayIfNecessaryForInsert <- function(sql) { - regexForInsert <- "(^INSERT\\s+INTO)\\s+([a-zA-Z0-9_$#-]*\\.?\\s*(?:[a-zA-Z0-9_]+)*)" + regexForInsert <- "(^INSERT\\s+INTO)\\s+([a-zA-Z0-9_$#-]*\\.?\\s*(?:[a-zA-Z0-9_]+)*\\.?\\s*(?:[a-zA-Z0-9_]+))" delayIfNecessary(sql, regexForInsert, insertExecutionTimes, 5) } @@ -120,12 +121,7 @@ lowLevelExecuteSql <- function(connection, sql) { } else { rowsAffected <- sanitizeJavaErrorForRlang(rJava::.jcall(statement, "J", "executeLargeUpdate", as.character(sql), check = FALSE)) } - - if (dbms(connection) == "bigquery") { - delayIfNecessaryForDdl(sql) - delayIfNecessaryForInsert(sql) - } - + invisible(rowsAffected) } diff --git a/R/Sql.R b/R/Sql.R index 73670627..47993bb0 100644 --- a/R/Sql.R +++ b/R/Sql.R @@ -36,7 +36,11 @@ return(paste(lines, collapse = "\n")) } -.createErrorReport <- function(dbms, message, sql, fileName) { +.createErrorReport <- function(dbms, err, sql, fileName) { + message <- err$message + if (dbms == "bigquery" && !is.null(err$body)) { + message <- paste0(message, "\n", err$body) + } report <- c("DBMS:\n", dbms, "\n\nError:\n", message, "\n\nSQL:\n", sql, "\n\n", .systemInfo()) fileConn <- file(fileName) writeChar(report, fileConn, eos = NULL) @@ -200,7 +204,7 @@ executeSql <- function(connection, logTrace(paste("Statements took", delta, attr(delta, "units"))) }, error = function(err) { - .createErrorReport(dbms, err$message, paste(batchSql, collapse = "\n\n"), errorReportFile) + .createErrorReport(dbms, err, paste(batchSql, collapse = "\n\n"), errorReportFile) }, finally = { rJava::.jcall(statement, "V", "close") @@ -230,7 +234,7 @@ executeSql <- function(connection, logTrace(paste("Executing SQL took", delta, attr(delta, "units"))) }, error = function(err) { - .createErrorReport(dbms, err$message, sqlStatement, errorReportFile) + .createErrorReport(dbms, err, sqlStatement, errorReportFile) }) if (progressBar) { setTxtProgressBar(pb, i / length(sqlStatements)) @@ -354,7 +358,7 @@ querySql <- function(connection, return(result) }, error = function(err) { - .createErrorReport(dbms(connection), err$message, sql, errorReportFile) + .createErrorReport(dbms(connection), err, sql, errorReportFile) }) } @@ -618,7 +622,7 @@ renderTranslateQueryApplyBatched <- function(connection, queryResult <- DBI::dbSendQuery(connection, sql) }, error = function(err) { - .createErrorReport(dbms(connection), err$message, sql, errorReportFile) + .createErrorReport(dbms(connection), err, sql, errorReportFile) } ) on.exit(DBI::dbClearResult(queryResult)) From 35e0e398dfc3df5343f71882e464d98d6d6198cb Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Tue, 10 Mar 2026 13:16:28 +0200 Subject: [PATCH 8/9] Uncomment Windows-only guard to run BigQuery tests only on Windows in tests/testthat/setup.R --- tests/testthat/setup.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 59887fd1..a65e9ecf 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -172,7 +172,7 @@ if (.Platform$OS.type == "windows") { # BigQuery ------------------------------------------------------------------ if (Sys.getenv("CDM_BIG_QUERY_PROJECT") != "" & Sys.getenv("CDM_BIG_QUERY_BILLING") != "") { # To avoid rate limit on BigQuery, only test on 1 OS: - #if (.Platform$OS.type == "windows") { + if (.Platform$OS.type == "windows") { bqKeyFile <- tempfile(fileext = ".json") writeLines(Sys.getenv("CDM_BIG_QUERY_KEY_FILE"), bqKeyFile) if (testthat::is_testing()) { @@ -193,7 +193,7 @@ if (Sys.getenv("CDM_BIG_QUERY_PROJECT") != "" & Sys.getenv("CDM_BIG_QUERY_BILLIN cdmDatabaseSchema = Sys.getenv("CDM_BIG_QUERY_CDM_SCHEMA"), tempEmulationSchema = Sys.getenv("CDM_BIG_QUERY_OHDSI_SCHEMA") ) - #} + } } # InterSystems IRIS ----------------------------------------------------------------- From 9e6a7d2d536919445c0e27536a91cfd8c0793d5a Mon Sep 17 00:00:00 2001 From: javier-gracia-tabuenca-tuni Date: Thu, 12 Mar 2026 07:35:06 +0200 Subject: [PATCH 9/9] Pass full error object to .createErrorReport in querySqlToAndromeda --- R/Andromeda.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Andromeda.R b/R/Andromeda.R index 0a41125b..acaa8b49 100644 --- a/R/Andromeda.R +++ b/R/Andromeda.R @@ -118,7 +118,7 @@ querySqlToAndromeda <- function( invisible(andromeda) }, error = function(err) { - .createErrorReport(dbms(connection), err$message, sql, errorReportFile) + .createErrorReport(dbms(connection), err, sql, errorReportFile) }) }