From 68767befb462012e808796ba6a65e75eb0a68629 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Tue, 19 Dec 2023 16:16:28 -0600
Subject: [PATCH 01/11] Ci tweaks (#1421)

* Re-skip R 3.6 on windows
* Suppress old backend warning
* Add host to Postgres connection
* Ignore a test on SQL server
* Make unique table name work in parallel
---
 .github/workflows/R-CMD-check.yaml         |  4 +++-
 R/utils.R                                  |  8 ++++----
 tests/testthat/helper-src.R                |  6 +++---
 tests/testthat/test-backend-postgres-old.R |  4 +++-
 tests/testthat/test-verb-set-ops.R         | 13 ++++++++-----
 5 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index ee65ccb57..95e951b2c 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -25,8 +25,10 @@ jobs:
           - {os: macos-latest,   r: 'release'}
 
           - {os: windows-latest, r: 'release'}
+          # # some database packages (e.g. RMariaDB) might not work on old R
+          # versions on windows #1382
           # Use 3.6 to trigger usage of RTools35
-          - {os: windows-latest, r: '3.6'}
+          # - {os: windows-latest, r: '3.6'}
           # use 4.1 to check with rtools40's older compiler
           - {os: windows-latest, r: '4.1'}
 
diff --git a/R/utils.R b/R/utils.R
index 8fc7856cf..d23e14fa0 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -21,11 +21,11 @@ named_commas <- function(x) {
 commas <- function(...) paste0(..., collapse = ", ")
 
 unique_table_name <- function() {
-  # Needs to use option to unique names across reloads while testing
-  i <- getOption("dbplyr_table_name", 0) + 1
-  options(dbplyr_table_name = i)
-  sprintf("dbplyr_%03i", i)
+  vals <- c(letters, LETTERS, 0:9)
+  name <- paste0(sample(vals, 10, replace = TRUE), collapse = "")
+  paste0("dbplyr_", name)
 }
+
 unique_subquery_name <- function() {
   # Needs to use option so can reset at the start of each query
   i <- getOption("dbplyr_subquery_name", 0) + 1
diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R
index ac7e3c5a9..1c23c1717 100644
--- a/tests/testthat/helper-src.R
+++ b/tests/testthat/helper-src.R
@@ -3,14 +3,14 @@ on_cran <- function() !identical(Sys.getenv("NOT_CRAN"), "true")
 
 if (test_srcs$length() == 0) {
 
-  # test_register_src("df", dplyr::src_df(env = new.env(parent = emptyenv())))
   test_register_con("sqlite", RSQLite::SQLite(), ":memory:")
 
   if (identical(Sys.getenv("GITHUB_POSTGRES"), "true")) {
     test_register_con("postgres", RPostgres::Postgres(),
       dbname = "test",
       user = "postgres",
-      password = "password"
+      password = "password",
+      host = "127.0.0.1"
     )
   } else if (identical(Sys.getenv("GITHUB_MSSQL"), "true")) {
     test_register_con("mssql", odbc::odbc(),
@@ -23,7 +23,7 @@ if (test_srcs$length() == 0) {
     )
   } else if (on_gha() || on_cran()) {
     # Only test with sqlite
-  } else  {
+  } else {
     test_register_con("MariaDB", RMariaDB::MariaDB(),
       dbname = "test",
       host = "localhost",
diff --git a/tests/testthat/test-backend-postgres-old.R b/tests/testthat/test-backend-postgres-old.R
index 7b1b2cd50..cbbe284cf 100644
--- a/tests/testthat/test-backend-postgres-old.R
+++ b/tests/testthat/test-backend-postgres-old.R
@@ -11,7 +11,9 @@ test_that("RPostgreSQL backend", {
     )
   )
 
-  copy_to(src, mtcars, "mtcars", overwrite = TRUE, temporary = FALSE)
+  suppressWarnings(
+    copy_to(src, mtcars, "mtcars", overwrite = TRUE, temporary = FALSE)
+  )
   withr::defer(DBI::dbRemoveTable(src, "mtcars"))
 
   expect_identical(colnames(tbl(src, "mtcars")), colnames(mtcars))
diff --git a/tests/testthat/test-verb-set-ops.R b/tests/testthat/test-verb-set-ops.R
index 8fbd20e50..b5e221fd3 100644
--- a/tests/testthat/test-verb-set-ops.R
+++ b/tests/testthat/test-verb-set-ops.R
@@ -110,14 +110,17 @@ test_that("SQLite warns if set op attempted when tbl has LIMIT", {
 test_that("other backends can combine with a limit", {
   df <- tibble(x = 1:2)
 
-  # sqlite only allows limit at top level
-  tbls_full <- test_load(df, ignore = "sqlite")
-  tbls_head <- lapply(test_load(df, ignore = "sqlite"), head, n = 1)
+  ignore <- c(
+    "sqlite", # only allows limit at top level
+    "mssql"   # unusual execution order gives unintuitive result
+  )
+  tbls_full <- test_load(df, ignore = ignore)
+  tbls_head <- lapply(test_load(df, ignore = ignore), head, n = 1)
 
   tbls_full %>%
     purrr::map2(tbls_head, union) %>%
-    expect_equal_tbls()
+    expect_equal_tbls(head(df, 1))
   tbls_full %>%
     purrr::map2(tbls_head, union_all) %>%
-    expect_equal_tbls()
+    expect_equal_tbls(head(df, 1))
 })

From e89aa96b62819aaeab4caf53f2b07a9fea96fa1a Mon Sep 17 00:00:00 2001
From: "Nathan S. Watson-Haigh" <nathan.watson-haigh@grifols.com>
Date: Thu, 21 Dec 2023 00:21:35 +1030
Subject: [PATCH 02/11] Better support for string matching in Snowflake (#1406)

* Added support for `str_starts()` and `str_ends()` by using Snowflake's
`REGEXP_INSTR()` function
* Refactored `str_detect()` to use Snowflake's `REGEXP_INSTR()` function.
* Ensure escape characters are escaped
---
 NEWS.md                                    |  7 +++
 R/backend-snowflake.R                      | 63 ++++++++++++++--------
 tests/testthat/_snaps/backend-snowflake.md | 10 ----
 tests/testthat/test-backend-snowflake.R    | 12 +++--
 4 files changed, 56 insertions(+), 36 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 45c2e46f0..9abe7a689 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,12 @@
 # dbplyr (development version)
 
+* Snowflake (@nathanhaigh, #1406)
+  * Added support for `str_starts()` and `str_ends()` via `REGEXP_INSTR()`
+  * Refactored `str_detect()` to use `REGEXP_INSTR()` so now supports
+    regular expressions.
+  * Refactored `grepl()` to use `REGEXP_INSTR()` so now supports
+    case-insensitive matching through `grepl(..., ignore.case = TRUE)`
+
 * Functions qualified with the base namespace are now also translated, e.g.
   `base::paste0(x, "_1")` is now translated (@mgirlich, #1022).
 
diff --git a/R/backend-snowflake.R b/R/backend-snowflake.R
index 5774be3cf..f89998047 100644
--- a/R/backend-snowflake.R
+++ b/R/backend-snowflake.R
@@ -38,23 +38,38 @@ sql_translation.Snowflake <- function(con) {
       str_locate = function(string, pattern) {
         sql_expr(POSITION(!!pattern, !!string))
       },
-      # REGEXP on Snowflaake "implicitly anchors a pattern at both ends", which
-      # str_detect does not.  Left- and right-pad `pattern` with .* to get
-      # str_detect-like behavior
       str_detect = function(string, pattern, negate = FALSE) {
-        sql_str_pattern_switch(
-          string = string,
-          pattern = {{ pattern }},
-          negate = negate,
-          f_fixed = sql_str_detect_fixed_instr("detect"),
-          f_regex = function(string, pattern, negate = FALSE) {
-            if (isTRUE(negate)) {
-              sql_expr(!(((!!string)) %REGEXP% (".*" || (!!pattern) || ".*")))
-            } else {
-              sql_expr(((!!string)) %REGEXP% (".*" || (!!pattern) || ".*"))
-            }
-          }
-        )
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) == 0L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) != 0L, con = con)
+        }
+      },
+      str_starts = function(string, pattern, negate = FALSE) {
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) != 1L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern) == 1L, con = con)
+        }
+      },
+      str_ends = function(string, pattern, negate = FALSE) {
+        con <- sql_current_con()
+
+        # Snowflake needs backslashes escaped, so we must increase the level of escaping
+        pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+        if (negate) {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern, 1L, 1L, 1L) != LENGTH(!!string) + 1L, con = con)
+        } else {
+          translate_sql(REGEXP_INSTR(!!string, !!pattern, 1L, 1L, 1L) == LENGTH(!!string) + 1L, con = con)
+        }
       },
       # On Snowflake, REGEXP_REPLACE is used like this:
       # REGEXP_REPLACE( <subject> , <pattern> [ , <replacement> ,
@@ -261,15 +276,19 @@ snowflake_grepl <- function(pattern,
                             perl = FALSE,
                             fixed = FALSE,
                             useBytes = FALSE) {
-  # https://docs.snowflake.com/en/sql-reference/functions/regexp.html
-  check_unsupported_arg(ignore.case, FALSE, backend = "Snowflake")
+  con <- sql_current_con()
+
   check_unsupported_arg(perl, FALSE, backend = "Snowflake")
   check_unsupported_arg(fixed, FALSE, backend = "Snowflake")
   check_unsupported_arg(useBytes, FALSE, backend = "Snowflake")
-  # REGEXP on Snowflaake "implicitly anchors a pattern at both ends", which
-  # grepl does not.  Left- and right-pad `pattern` with .* to get grepl-like
-  # behavior
-  sql_expr(((!!x)) %REGEXP% (".*" || !!paste0("(", pattern, ")") || ".*"))
+
+  # https://docs.snowflake.com/en/sql-reference/functions/regexp_instr.html
+  # REGEXP_INSTR optional parameters: position, occurrance, option, regex_parameters
+  regexp_parameters <- "c"
+  if(ignore.case) { regexp_parameters <- "i" }
+  # Snowflake needs backslashes escaped, so we must increase the level of escaping
+  pattern <- gsub("\\", "\\\\", pattern, fixed = TRUE)
+  translate_sql(REGEXP_INSTR(!!x, !!pattern, 1L, 1L, 0L, !!regexp_parameters) != 0L, con = con)
 }
 
 snowflake_round <- function(x, digits = 0L) {
diff --git a/tests/testthat/_snaps/backend-snowflake.md b/tests/testthat/_snaps/backend-snowflake.md
index e43d3042e..2eef02c36 100644
--- a/tests/testthat/_snaps/backend-snowflake.md
+++ b/tests/testthat/_snaps/backend-snowflake.md
@@ -1,13 +1,3 @@
-# custom scalar translated correctly
-
-    Code
-      (expect_error(test_translate_sql(grepl("exp", x, ignore.case = TRUE))))
-    Output
-      <error/rlang_error>
-      Error in `grepl()`:
-      ! `ignore.case = TRUE` isn't supported in Snowflake translation.
-      i It must be FALSE instead.
-
 # pmin() and pmax() respect na.rm
 
     Code
diff --git a/tests/testthat/test-backend-snowflake.R b/tests/testthat/test-backend-snowflake.R
index b1f37b14a..0a6e58157 100644
--- a/tests/testthat/test-backend-snowflake.R
+++ b/tests/testthat/test-backend-snowflake.R
@@ -2,8 +2,8 @@ test_that("custom scalar translated correctly", {
   local_con(simulate_snowflake())
   expect_equal(test_translate_sql(log10(x)), sql("LOG(10.0, `x`)"))
   expect_equal(test_translate_sql(round(x, digits = 1.1)), sql("ROUND((`x`) :: FLOAT, 1)"))
-  expect_equal(test_translate_sql(grepl("exp", x)), sql("(`x`) REGEXP ('.*' || '(exp)' || '.*')"))
-  expect_snapshot((expect_error(test_translate_sql(grepl("exp", x, ignore.case = TRUE)))))
+  expect_equal(test_translate_sql(grepl("exp", x)), sql("REGEXP_INSTR(`x`, 'exp', 1, 1, 0, 'c') != 0"))
+  expect_equal(test_translate_sql(grepl("exp", x, ignore.case = TRUE)), sql("REGEXP_INSTR(`x`, 'exp', 1, 1, 0, 'i') != 0"))
 })
 
 test_that("pasting translated correctly", {
@@ -25,8 +25,8 @@ test_that("custom stringr functions translated correctly", {
   local_con(simulate_snowflake())
 
   expect_equal(test_translate_sql(str_locate(x, y)), sql("POSITION(`y`, `x`)"))
-  expect_equal(test_translate_sql(str_detect(x, y)), sql("(`x`) REGEXP ('.*' || `y` || '.*')"))
-  expect_equal(test_translate_sql(str_detect(x, y, negate = TRUE)), sql("!((`x`) REGEXP ('.*' || `y` || '.*'))"))
+  expect_equal(test_translate_sql(str_detect(x, y)), sql("REGEXP_INSTR(`x`, `y`) != 0"))
+  expect_equal(test_translate_sql(str_detect(x, y, negate = TRUE)), sql("REGEXP_INSTR(`x`, `y`) = 0"))
   expect_equal(test_translate_sql(str_replace(x, y, z)), sql("REGEXP_REPLACE(`x`, `y`, `z`, 1.0, 1.0)"))
   expect_equal(test_translate_sql(str_replace(x, "\\d", z)), sql("REGEXP_REPLACE(`x`, '\\\\d', `z`, 1.0, 1.0)"))
   expect_equal(test_translate_sql(str_replace_all(x, y, z)), sql("REGEXP_REPLACE(`x`, `y`, `z`)"))
@@ -34,6 +34,10 @@ test_that("custom stringr functions translated correctly", {
   expect_equal(test_translate_sql(str_remove(x, y)), sql("REGEXP_REPLACE(`x`, `y`, '', 1.0, 1.0)"))
   expect_equal(test_translate_sql(str_remove_all(x, y)), sql("REGEXP_REPLACE(`x`, `y`)"))
   expect_equal(test_translate_sql(str_trim(x)), sql("TRIM(`x`)"))
+  expect_equal(test_translate_sql(str_starts(x, y)), sql("REGEXP_INSTR(`x`, `y`) = 1"))
+  expect_equal(test_translate_sql(str_starts(x, y, negate = TRUE)), sql("REGEXP_INSTR(`x`, `y`) != 1"))
+  expect_equal(test_translate_sql(str_ends(x, y)), sql("REGEXP_INSTR(`x`, `y`, 1, 1, 1) = (LENGTH(`x`) + 1)"))
+  expect_equal(test_translate_sql(str_ends(x, y, negate = TRUE)), sql("REGEXP_INSTR(`x`, `y`, 1, 1, 1) != (LENGTH(`x`) + 1)"))
 })
 
 test_that("aggregates are translated correctly", {

From a2027ccbb9a7c047480e57870a2aeffe07d609a5 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 20 Dec 2023 08:25:48 -0600
Subject: [PATCH 03/11] Standardize on `withCallingHandlers` and use the same
 style everywhere (#1422)

---
 R/db-io.R               |  2 +-
 R/db-sql.R              | 31 +++++++++++++++----------------
 R/tidyeval-across.R     | 15 ++++++++-------
 R/tidyeval.R            |  2 +-
 R/utils-check.R         |  2 +-
 R/verb-compute.R        |  6 +++---
 R/verb-pivot-wider.R    |  2 +-
 man/collapse.tbl_sql.Rd |  3 ++-
 8 files changed, 32 insertions(+), 31 deletions(-)

diff --git a/R/db-io.R b/R/db-io.R
index 16e1c12a4..de8561ba0 100644
--- a/R/db-io.R
+++ b/R/db-io.R
@@ -72,7 +72,7 @@ db_copy_to.DBIConnection <- function(con,
   call <- current_env()
 
   with_transaction(con, in_transaction, {
-    tryCatch(
+    withCallingHandlers(
       {
         table <- dplyr::db_write_table(con, table,
           types = types,
diff --git a/R/db-sql.R b/R/db-sql.R
index 894d738a9..b689d684c 100644
--- a/R/db-sql.R
+++ b/R/db-sql.R
@@ -1102,9 +1102,9 @@ dbplyr_explain <- function(con, ...) {
 #' @importFrom dplyr db_explain
 db_explain.DBIConnection <- function(con, sql, ...) {
   sql <- sql_query_explain(con, sql, ...)
-  call <- current_call()
-  expl <- withCallingHandlers(
-    DBI::dbGetQuery(con, sql),
+  
+  withCallingHandlers(
+    expl <- DBI::dbGetQuery(con, sql),
     error = function(cnd) {
       cli_abort("Can't explain query.", parent = cnd)
     }
@@ -1121,8 +1121,8 @@ dbplyr_query_fields <- function(con, ...) {
 #' @importFrom dplyr db_query_fields
 db_query_fields.DBIConnection <- function(con, sql, ...) {
   sql <- sql_query_fields(con, sql, ...)
-  df <- withCallingHandlers(
-    DBI::dbGetQuery(con, sql),
+  withCallingHandlers(
+    df <- DBI::dbGetQuery(con, sql),
     error = function(cnd) {
       cli_abort("Can't query fields.", parent = cnd)
     }
@@ -1141,19 +1141,18 @@ db_save_query.DBIConnection <- function(con,
                                         temporary = TRUE,
                                         ...,
                                         overwrite = FALSE) {
+  if (overwrite) {
+    name <- as_table_ident(name)
+    name_id <- table_ident_to_id(name)
+    found <- DBI::dbExistsTable(con, name_id)
+    if (found) {
+      DBI::dbRemoveTable(con, name_id)
+    }
+  }
+
   sql <- sql_query_save(con, sql, name, temporary = temporary, ...)
   withCallingHandlers(
-    {
-      if (overwrite) {
-        name <- as_table_ident(name)
-        name_id <- table_ident_to_id(name)
-        found <- DBI::dbExistsTable(con, name_id)
-        if (found) {
-          DBI::dbRemoveTable(con, name_id)
-        }
-      }
-      DBI::dbExecute(con, sql, immediate = TRUE)
-    },
+    DBI::dbExecute(con, sql, immediate = TRUE),
     error = function(cnd) {
       cli_abort(
         "Can't save query to table {.table {format(name, con = con)}}.",
diff --git a/R/tidyeval-across.R b/R/tidyeval-across.R
index d0b4ec8c2..8b4327ecb 100644
--- a/R/tidyeval-across.R
+++ b/R/tidyeval-across.R
@@ -213,13 +213,14 @@ across_setup <- function(data,
   dots <- call$...
   for (i in seq_along(call$...)) {
     dot <- call$...[[i]]
-    try_fetch({
-      dots[[i]] <- partial_eval(dot, data = data, env = env, error_call = error_call)
-    }, error = function(cnd) {
-      label <- expr_as_label(dot, names2(call$...)[[i]])
-      msg <- "Problem while evaluating {.code {label}}."
-      cli_abort(msg, call = call(fn), parent = cnd)
-    })
+    withCallingHandlers(
+      dots[[i]] <- partial_eval(dot, data = data, env = env, error_call = error_call),
+      error = function(cnd) {
+        label <- expr_as_label(dot, names2(call$...)[[i]])
+        msg <- "Problem while evaluating {.code {label}}."
+        cli_abort(msg, call = call(fn), parent = cnd)
+      }
+    )
   }
 
   names_spec <- eval(call$.names, env)
diff --git a/R/tidyeval.R b/R/tidyeval.R
index 9270051f9..293fffb0e 100644
--- a/R/tidyeval.R
+++ b/R/tidyeval.R
@@ -124,7 +124,7 @@ partial_eval_dots <- function(.data,
 
 partial_eval_quo <- function(x, data, error_call, dot_name, was_named) {
   # no direct equivalent in `dtplyr`, mostly handled in `dt_squash()`
-  try_fetch(
+  withCallingHandlers(
     expr <- partial_eval(get_expr(x), data, get_env(x), error_call = error_call),
     error = function(cnd) {
       label <- expr_as_label(x, dot_name)
diff --git a/R/utils-check.R b/R/utils-check.R
index e7e986007..edf407936 100644
--- a/R/utils-check.R
+++ b/R/utils-check.R
@@ -182,7 +182,7 @@ with_indexed_errors <- function(expr,
                                 ...,
                                 .error_call = caller_env(),
                                 .frame = caller_env()) {
-  try_fetch(
+  withCallingHandlers(
     expr,
     purrr_error_indexed = function(cnd) {
       message <- message(cnd)
diff --git a/R/verb-compute.R b/R/verb-compute.R
index 6fe53787a..c4272bf9c 100644
--- a/R/verb-compute.R
+++ b/R/verb-compute.R
@@ -25,7 +25,7 @@ collapse.tbl_sql <- function(x, ...) {
 
 #' @rdname collapse.tbl_sql
 #' @param name Table name in remote database.
-#' @param temporary Should the table be temporary (`TRUE`, the default`) or
+#' @param temporary Should the table be temporary (`TRUE`, the default) or
 #'   persistent (`FALSE`)?
 #' @inheritParams copy_to.src_sql
 #' @inheritParams collect.tbl_sql
@@ -128,8 +128,8 @@ collect.tbl_sql <- function(x, ..., n = Inf, warn_incomplete = TRUE, cte = FALSE
   }
 
   sql <- db_sql_render(x$src$con, x, cte = cte)
-  out <- withCallingHandlers(
-    db_collect(x$src$con, sql, n = n, warn_incomplete = warn_incomplete, ...),
+  withCallingHandlers(
+    out <- db_collect(x$src$con, sql, n = n, warn_incomplete = warn_incomplete, ...),
     error = function(cnd) {
       cli_abort("Failed to collect lazy table.", parent = cnd)
     }
diff --git a/R/verb-pivot-wider.R b/R/verb-pivot-wider.R
index 6d915193a..476577fe5 100644
--- a/R/verb-pivot-wider.R
+++ b/R/verb-pivot-wider.R
@@ -359,7 +359,7 @@ select_wider_id_cols <- function(data,
     return(names(sim_data))
   }
 
-  try_fetch(
+  withCallingHandlers(
     id_cols <- tidyselect::eval_select(
       enquo(id_cols),
       sim_data,
diff --git a/man/collapse.tbl_sql.Rd b/man/collapse.tbl_sql.Rd
index b322e4b2e..c93a83aa2 100644
--- a/man/collapse.tbl_sql.Rd
+++ b/man/collapse.tbl_sql.Rd
@@ -28,7 +28,8 @@
 
 \item{name}{Table name in remote database.}
 
-\item{temporary}{Should the table be temporary (\code{TRUE}, the default\verb{) or persistent (}FALSE`)?}
+\item{temporary}{Should the table be temporary (\code{TRUE}, the default) or
+persistent (\code{FALSE})?}
 
 \item{unique_indexes}{a list of character vectors. Each element of the list
 will create a new unique index over the specified column(s). Duplicate rows

From 6f54668241938af1b0353beef965943e29963da8 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 21 Dec 2023 07:07:35 -0600
Subject: [PATCH 04/11] Drop tryCatch + finally in favour of on.exit() (#1424)

---
 R/db-io.R | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/R/db-io.R b/R/db-io.R
index de8561ba0..f1b919eb3 100644
--- a/R/db-io.R
+++ b/R/db-io.R
@@ -156,15 +156,13 @@ db_collect <- function(con, sql, n = -1, warn_incomplete = TRUE, ...) {
 #' @export
 db_collect.DBIConnection <- function(con, sql, n = -1, warn_incomplete = TRUE, ...) {
   res <- dbSendQuery(con, sql)
-  tryCatch({
-    out <- dbFetch(res, n = n)
-    if (warn_incomplete) {
-      res_warn_incomplete(res, "n = Inf")
-    }
-  }, finally = {
-    dbClearResult(res)
-  })
+  on.exit(dbClearResult(res), add = TRUE)
 
+  out <- dbFetch(res, n = n)
+  if (warn_incomplete) {
+    res_warn_incomplete(res, "n = Inf")
+  }
+ 
   out
 }
 

From 150893914611519954c992086422ae2a23df3d8d Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 21 Dec 2023 08:13:29 -0600
Subject: [PATCH 05/11] Include SQL in wrapped errors (#1423)

Includes some polishing of SQL server tests to make future debugging easier.

Fixes #1401
---
 NEWS.md                                   |  3 +
 R/db-io.R                                 | 85 +++++++++++++----------
 R/db-sql.R                                | 70 +++++++++----------
 R/rows.R                                  | 24 ++-----
 R/utils.R                                 |  6 +-
 tests/testthat/_snaps/backend-mssql.md    | 14 ++++
 tests/testthat/_snaps/backend-postgres.md |  2 +
 tests/testthat/_snaps/db-io.md            |  6 +-
 tests/testthat/_snaps/db-sql.md           |  5 ++
 tests/testthat/_snaps/rows.md             |  2 +
 tests/testthat/_snaps/verb-compute.md     |  7 +-
 tests/testthat/helper-src.R               | 10 ++-
 tests/testthat/test-backend-mssql.R       | 20 +++---
 tests/testthat/test-db-sql.R              |  2 +
 tests/testthat/test-verb-compute.R        |  9 +--
 15 files changed, 154 insertions(+), 111 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 9abe7a689..da9ab66ad 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # dbplyr (development version)
 
+* Database errors now show the generated SQL, which hopefully will make it
+  faster to track down problems (#1401).
+
 * Snowflake (@nathanhaigh, #1406)
   * Added support for `str_starts()` and `str_ends()` via `REGEXP_INSTR()`
   * Refactored `str_detect()` to use `REGEXP_INSTR()` so now supports
diff --git a/R/db-io.R b/R/db-io.R
index f1b919eb3..11e9b2c02 100644
--- a/R/db-io.R
+++ b/R/db-io.R
@@ -69,27 +69,24 @@ db_copy_to.DBIConnection <- function(con,
   new <- db_table_temporary(con, table, temporary)
   table <- new$table
   temporary <- new$temporary
-  call <- current_env()
-
-  with_transaction(con, in_transaction, {
-    withCallingHandlers(
-      {
-        table <- dplyr::db_write_table(con, table,
-          types = types,
-          values = values,
-          temporary = temporary,
-          overwrite = overwrite,
-          ...
-        )
-        create_indexes(con, table, unique_indexes, unique = TRUE)
-        create_indexes(con, table, indexes)
-        if (analyze) dbplyr_analyze(con, table)
-      },
-      error = function(cnd) {
-        cli_abort("Can't copy to table {.field {format(table, con = con)}}.", parent = cnd, call = call)
-      }
-    )
-  })
+
+  with_transaction(
+    con,
+    in_transaction,
+    "Can't copy data to table {.field {format(table, con = con)}}.",
+    {
+      table <- dplyr::db_write_table(con, table,
+        types = types,
+        values = values,
+        temporary = temporary,
+        overwrite = overwrite,
+        ...
+      )
+      create_indexes(con, table, unique_indexes, unique = TRUE)
+      create_indexes(con, table, indexes)
+      if (analyze) dbplyr_analyze(con, table)
+    }
+  )
 
   table
 }
@@ -131,18 +128,23 @@ db_compute.DBIConnection <- function(con,
   table <- new$table
   temporary <- new$temporary
 
-  with_transaction(con, in_transaction, {
-    table <- dbplyr_save_query(
-      con,
-      sql,
-      table,
-      temporary = temporary,
-      overwrite = overwrite
-    )
-    create_indexes(con, table, unique_indexes, unique = TRUE)
-    create_indexes(con, table, indexes)
-    if (analyze) dbplyr_analyze(con, table)
-  })
+  with_transaction(
+    con,
+    in_transaction,
+    "Can't copy query to table {.field {format(table, con = con)}}.",
+    {
+      table <- dbplyr_save_query(
+        con,
+        sql,
+        table,
+        temporary = temporary,
+        overwrite = overwrite
+      )
+      create_indexes(con, table, unique_indexes, unique = TRUE)
+      create_indexes(con, table, indexes)
+      if (analyze) dbplyr_analyze(con, table)
+    }
+  )
 
   table
 }
@@ -162,7 +164,7 @@ db_collect.DBIConnection <- function(con, sql, n = -1, warn_incomplete = TRUE, .
   if (warn_incomplete) {
     res_warn_incomplete(res, "n = Inf")
   }
- 
+
   out
 }
 
@@ -215,14 +217,23 @@ create_indexes <- function(con, table, indexes = NULL, unique = FALSE, ...) {
   }
 }
 
-# Don't use `tryCatch()` because it messes with the callstack
-with_transaction <- function(con, in_transaction, code) {
+with_transaction <- function(con,
+                             in_transaction,
+                             msg,
+                             code,
+                             call = caller_env(),
+                             env = caller_env()) {
   if (in_transaction) {
     dbBegin(con)
     on.exit(dbRollback(con))
   }
 
-  code
+  withCallingHandlers(
+    code,
+    error = function(cnd) {
+      cli_abort(msg, parent = cnd, call = call, .envir = env)
+    }
+  )
 
   if (in_transaction) {
     on.exit()
diff --git a/R/db-sql.R b/R/db-sql.R
index b689d684c..8634711e9 100644
--- a/R/db-sql.R
+++ b/R/db-sql.R
@@ -1065,13 +1065,8 @@ db_analyze.DBIConnection <- function(con, table, ...) {
   if (is.null(sql)) {
     return() # nocov
   }
-  withCallingHandlers(
-    DBI::dbExecute(con, sql),
-    error = function(cnd) {
-      msg <- "Can't analyze table {.field {format(table, con = con)}}."
-      cli_abort(msg, parent = cnd)
-    }
-  )
+
+  db_execute(con, sql, "Can't analyze table {.field {format(table, con = con)}}.")
 }
 
 dbplyr_create_index <- function(con, ...) {
@@ -1086,13 +1081,7 @@ db_create_index.DBIConnection <- function(con,
                                           unique = FALSE,
                                           ...) {
   sql <- sql_table_index(con, table, columns, name = name, unique = unique, ...)
-  withCallingHandlers(
-    DBI::dbExecute(con, sql),
-    error = function(cnd) {
-      msg <- "Can't create index on table {.field {format(table, con = con)}}."
-      cli_abort(msg, parent = cnd)
-    }
-  )
+  db_execute(con, sql, "Can't create index on table {.field {format(table, con = con)}}.")
 }
 
 dbplyr_explain <- function(con, ...) {
@@ -1102,13 +1091,7 @@ dbplyr_explain <- function(con, ...) {
 #' @importFrom dplyr db_explain
 db_explain.DBIConnection <- function(con, sql, ...) {
   sql <- sql_query_explain(con, sql, ...)
-  
-  withCallingHandlers(
-    expl <- DBI::dbGetQuery(con, sql),
-    error = function(cnd) {
-      cli_abort("Can't explain query.", parent = cnd)
-    }
-  )
+  expl <- db_get_query(con, sql, "Can't explain query.")
 
   out <- utils::capture.output(print(expl))
   paste(out, collapse = "\n")
@@ -1121,12 +1104,7 @@ dbplyr_query_fields <- function(con, ...) {
 #' @importFrom dplyr db_query_fields
 db_query_fields.DBIConnection <- function(con, sql, ...) {
   sql <- sql_query_fields(con, sql, ...)
-  withCallingHandlers(
-    df <- DBI::dbGetQuery(con, sql),
-    error = function(cnd) {
-      cli_abort("Can't query fields.", parent = cnd)
-    }
-  )
+  df <- db_get_query(con, sql, "Can't query fields.")
   names(df)
 }
 
@@ -1151,15 +1129,8 @@ db_save_query.DBIConnection <- function(con,
   }
 
   sql <- sql_query_save(con, sql, name, temporary = temporary, ...)
-  withCallingHandlers(
-    DBI::dbExecute(con, sql, immediate = TRUE),
-    error = function(cnd) {
-      cli_abort(
-        "Can't save query to table {.table {format(name, con = con)}}.",
-        parent = cnd
-      )
-    }
-  )
+  db_execute(con, sql, "Can't save query to table {.table {format(name, con = con)}}.")
+
   name
 }
 
@@ -1175,3 +1146,30 @@ sql_subquery.DBIConnection <- function(con,
                                        lvl = 0) {
   sql_query_wrap(con, from = from, name = name, ..., lvl = lvl)
 }
+
+# Helpers -------------------------------------------------------------------
+
+db_execute <- function(con, sql, msg, call = caller_env(), env = caller_env()) {
+  dbi_wrap(
+    dbExecute(con, sql, immediate = TRUE),
+    sql = sql,
+    msg = msg,
+    call = call,
+    env = env
+  )
+  invisible()
+}
+
+db_get_query <- function(con, sql, msg, call = caller_env(), env = caller_env()) {
+  dbi_wrap(dbGetQuery(con, sql), sql, msg, call = call, env = env)
+}
+
+dbi_wrap <- function(code, sql, msg, call = caller_env(), env = caller_env()) {
+  withCallingHandlers(
+    code,
+    error = function(cnd) {
+      msg <- c(msg, i = paste0("Using SQL: ", sql))
+      cli_abort(msg, parent = cnd, call = call, .envir = env)
+    }
+  )
+}
diff --git a/R/rows.R b/R/rows.R
index 9655e470b..7aa18cb71 100644
--- a/R/rows.R
+++ b/R/rows.R
@@ -759,25 +759,15 @@ rows_auto_copy <- function(x, y, copy, call = caller_env()) {
 }
 
 rows_get_or_execute <- function(x, sql, returning_cols, call = caller_env()) {
+  error <- "Can't modify database table {.val {remote_name(x)}}."
   con <- remote_con(x)
-  withCallingHandlers(
-    {
-      if (is_empty(returning_cols)) {
-        DBI::dbExecute(con, sql, immediate = TRUE)
-      } else {
-        returned_rows <- DBI::dbGetQuery(con, sql, immediate = TRUE)
-        x <- set_returned_rows(x, returned_rows)
-      }
-    },
-    error = function(cnd) {
-      cli_abort(
-        "Can't modify database table {.val {remote_name(x)}}.",
-        parent = cnd,
-        call = call
-      )
-    }
-  )
 
+  if (is_empty(returning_cols)) {
+    db_execute(con, sql, error, call = call)
+  } else {
+    returned_rows <- db_get_query(con, sql, error, call = call)
+    x <- set_returned_rows(x, returned_rows)
+  }
 
   invisible(x)
 }
diff --git a/R/utils.R b/R/utils.R
index d23e14fa0..5febbb770 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -20,10 +20,10 @@ named_commas <- function(x) {
 
 commas <- function(...) paste0(..., collapse = ", ")
 
-unique_table_name <- function() {
+unique_table_name <- function(prefix = "") {
   vals <- c(letters, LETTERS, 0:9)
   name <- paste0(sample(vals, 10, replace = TRUE), collapse = "")
-  paste0("dbplyr_", name)
+  paste0(prefix, "dbplyr_", name)
 }
 
 unique_subquery_name <- function() {
@@ -85,7 +85,7 @@ res_warn_incomplete <- function(res, hint = "n = -1") {
 hash_temp <- function(name) {
   name <- paste0("#", name)
   cli::cli_inform(
-    paste0("Created a temporary table named ", name),
+    "Created a temporary table named {name}",
     class = c("dbplyr_message_temp_table", "dbplyr_message")
   )
   name
diff --git a/tests/testthat/_snaps/backend-mssql.md b/tests/testthat/_snaps/backend-mssql.md
index 69d4c1ece..9736c39c9 100644
--- a/tests/testthat/_snaps/backend-mssql.md
+++ b/tests/testthat/_snaps/backend-mssql.md
@@ -400,3 +400,17 @@
       FROM `df`
       ORDER BY `y`
 
+# can copy_to() and compute() with temporary tables (#438)
+
+    Code
+      db <- copy_to(con, df, name = unique_table_name(), temporary = TRUE)
+    Message
+      Created a temporary table named #dbplyr_{tmp}
+
+---
+
+    Code
+      db2 <- db %>% mutate(y = x + 1) %>% compute()
+    Message
+      Created a temporary table named #dbplyr_{tmp}
+
diff --git a/tests/testthat/_snaps/backend-postgres.md b/tests/testthat/_snaps/backend-postgres.md
index 50bad613a..b6c98be73 100644
--- a/tests/testthat/_snaps/backend-postgres.md
+++ b/tests/testthat/_snaps/backend-postgres.md
@@ -126,6 +126,7 @@
     Condition
       Error in `rows_insert()`:
       ! Can't modify database table "df_x".
+      i Using SQL: INSERT INTO "df_x" ("a", "b", "c", "d") SELECT * FROM ( SELECT "a", "b", "c" + 1.0 AS "c", "d" FROM "df_y" ) AS "...y" ON CONFLICT ("a", "b") DO NOTHING RETURNING "df_x"."a", "df_x"."b", "df_x"."c", "df_x"."d"
       Caused by error:
       ! dummy DBI error
 
@@ -137,6 +138,7 @@
     Condition
       Error in `rows_upsert()`:
       ! Can't modify database table "df_x".
+      i Using SQL: INSERT INTO "df_x" ("a", "b", "c", "d") SELECT "a", "b", "c", "d" FROM ( SELECT "a", "b", "c" + 1.0 AS "c", "d" FROM "df_y" ) AS "...y" WHERE true ON CONFLICT ("a", "b") DO UPDATE SET "c" = "excluded"."c", "d" = "excluded"."d" RETURNING "df_x"."a", "df_x"."b", "df_x"."c", "df_x"."d"
       Caused by error:
       ! dummy DBI error
 
diff --git a/tests/testthat/_snaps/db-io.md b/tests/testthat/_snaps/db-io.md
index 82af628a4..671570c6a 100644
--- a/tests/testthat/_snaps/db-io.md
+++ b/tests/testthat/_snaps/db-io.md
@@ -6,9 +6,10 @@
     Output
       <error/rlang_error>
       Error in `db_copy_to()`:
-      ! Can't copy to table `tmp2`.
+      ! Can't copy data to table `tmp2`.
       Caused by error in `db_create_index.DBIConnection()`:
       ! Can't create index on table `tmp2`.
+      i Using SQL: CREATE UNIQUE INDEX `tmp2_x` ON `tmp2` (`x`)
       Caused by error:
       ! dummy DBI error
 
@@ -20,7 +21,7 @@
     Output
       <error/rlang_error>
       Error in `db_copy_to()`:
-      ! Can't copy to table `tmp`.
+      ! Can't copy data to table `tmp`.
       Caused by error in `dplyr::db_write_table()`:
       ! Can't write table table `tmp`.
       Caused by error:
@@ -35,6 +36,7 @@
       <error/rlang_error>
       Error in `db_save_query()`:
       ! Can't save query to table tmp.
+      i Using SQL: CREATE TEMPORARY TABLE `tmp` AS `SELECT 2 FROM tmp`
       Caused by error:
       ! dummy DBI error
 
diff --git a/tests/testthat/_snaps/db-sql.md b/tests/testthat/_snaps/db-sql.md
index 5df09a665..f00e1048f 100644
--- a/tests/testthat/_snaps/db-sql.md
+++ b/tests/testthat/_snaps/db-sql.md
@@ -16,6 +16,7 @@
       <error/rlang_error>
       Error in `db_analyze()`:
       ! Can't analyze table tbl.
+      i Using SQL: ANALYZE `tbl`
       Caused by error:
       ! dummy DBI error
     Code
@@ -24,6 +25,7 @@
       <error/rlang_error>
       Error in `db_create_index()`:
       ! Can't create index on table tbl.
+      i Using SQL: CREATE INDEX `tbl_col` ON `tbl` (`col`)
       Caused by error:
       ! dummy DBI error
     Code
@@ -32,6 +34,7 @@
       <error/rlang_error>
       Error in `db_explain()`:
       ! Can't explain query.
+      i Using SQL: EXPLAIN QUERY PLAN invalid sql
       Caused by error:
       ! dummy DBI error
     Code
@@ -40,6 +43,7 @@
       <error/rlang_error>
       Error in `db_query_fields()`:
       ! Can't query fields.
+      i Using SQL: SELECT * FROM `does not exist` AS `q01` WHERE (0 = 1)
       Caused by error:
       ! dummy DBI error
     Code
@@ -48,6 +52,7 @@
       <error/rlang_error>
       Error in `db_save_query()`:
       ! Can't save query to table tbl.
+      i Using SQL: CREATE TEMPORARY TABLE `tbl` AS `invalid sql`
       Caused by error:
       ! dummy DBI error
 
diff --git a/tests/testthat/_snaps/rows.md b/tests/testthat/_snaps/rows.md
index 02b447cb3..0f9229fc9 100644
--- a/tests/testthat/_snaps/rows.md
+++ b/tests/testthat/_snaps/rows.md
@@ -97,6 +97,7 @@
       <error/rlang_error>
       Error in `rows_append()`:
       ! Can't modify database table "mtcars".
+      i Using SQL: INSERT INTO `mtcars` (`x`) SELECT * FROM ( SELECT * FROM `dbplyr_{tmp}` ) AS `...y`
       Caused by error:
       ! dummy DBI error
     Code
@@ -106,6 +107,7 @@
       <error/rlang_error>
       Error in `rows_append()`:
       ! Can't modify database table "mtcars".
+      i Using SQL: INSERT INTO `mtcars` (`x`) SELECT * FROM ( SELECT * FROM `dbplyr_{tmp}` ) AS `...y` RETURNING `mtcars`.`x`
       Caused by error:
       ! dummy DBI error
 
diff --git a/tests/testthat/_snaps/verb-compute.md b/tests/testthat/_snaps/verb-compute.md
index b79714bae..133926a3d 100644
--- a/tests/testthat/_snaps/verb-compute.md
+++ b/tests/testthat/_snaps/verb-compute.md
@@ -20,10 +20,13 @@
     Code
       df %>% compute(name = in_schema("main", "db1"), temporary = FALSE)
     Condition
-      Error in `db_save_query.DBIConnection()`:
+      Error in `db_compute()`:
+      ! Can't copy query to table `main`.`db1`.
+      Caused by error in `db_save_query.DBIConnection()`:
       ! Can't save query to table `main`.`db1`.
+      i Using SQL: CREATE TABLE `main`.`db1` AS SELECT * FROM `dbplyr_{tmp}`
       Caused by error:
-      ! table `db1` already exists
+      ! dummy DBI error
 
 # collect() handles DBI error
 
diff --git a/tests/testthat/helper-src.R b/tests/testthat/helper-src.R
index 1c23c1717..1957b3f9d 100644
--- a/tests/testthat/helper-src.R
+++ b/tests/testthat/helper-src.R
@@ -50,8 +50,16 @@ local_sqlite_con_with_aux <- function(envir = parent.frame()) {
 }
 
 snap_transform_dbi <- function(x) {
+  x <- gsub("dbplyr_[a-zA-Z0-9]+", "dbplyr_{tmp}", x)
+
   # use the last line matching this in case of multiple chained errors
-  dbi_line_id <- max(which(x == "Caused by error:"))
+  caused_by <- which(x == "Caused by error:")
+  if (length(caused_by) == 0) {
+    return(x)
+  }
+
+  dbi_line_id <- max(caused_by)
+
   n <- length(x)
   x <- x[-seq2(dbi_line_id + 1, n)]
   c(x, "! dummy DBI error")
diff --git a/tests/testthat/test-backend-mssql.R b/tests/testthat/test-backend-mssql.R
index dfc05c91a..c11e84028 100644
--- a/tests/testthat/test-backend-mssql.R
+++ b/tests/testthat/test-backend-mssql.R
@@ -331,30 +331,32 @@ test_that("row_number() with and without group_by() and arrange(): unordered def
 
 # Live database -----------------------------------------------------------
 
-test_that("can copy_to() and compute() with temporary tables (#272)", {
+test_that("can copy_to() and compute() with temporary tables (#438)", {
   con <- src_test("mssql")
   df <- tibble(x = 1:3)
-  expect_message(
-    db <- copy_to(con, df, name = "temp", temporary = TRUE),
-    "Created a temporary table",
+
+  # converts to name automatically with message
+  expect_snapshot(
+    db <- copy_to(con, df, name = unique_table_name(), temporary = TRUE),
+    transform = snap_transform_dbi
   )
   expect_equal(db %>% pull(), 1:3)
 
-  expect_message(
+  expect_snapshot(
     db2 <- db %>% mutate(y = x + 1) %>% compute(),
-    "Created a temporary table"
+    transform = snap_transform_dbi
   )
   expect_equal(db2 %>% pull(), 2:4)
 })
 
 test_that("bit conversion works for important cases", {
   df <- tibble(x = 1:3, y = 3:1)
-  db <- copy_to(src_test("mssql"), df, name = unique_table_name())
+  db <- copy_to(src_test("mssql"), df, name = unique_table_name("#"))
   expect_equal(db %>% mutate(z = x == y) %>% pull(), c(FALSE, TRUE, FALSE))
   expect_equal(db %>% filter(x == y) %>% pull(), 2)
 
   df <- tibble(x = c(TRUE, FALSE, FALSE), y = c(TRUE, FALSE, TRUE))
-  db <- copy_to(src_test("mssql"), df, name = unique_table_name())
+  db <- copy_to(src_test("mssql"), df, name = unique_table_name("#"))
   expect_equal(db %>% filter(x == 1) %>% pull(), TRUE)
   expect_equal(db %>% mutate(z = TRUE) %>% pull(), c(1, 1, 1))
 
@@ -368,7 +370,7 @@ test_that("bit conversion works for important cases", {
 
 test_that("as.integer and as.integer64 translations if parsing failures", {
   df <- data.frame(x = c("1.3", "2x"))
-  db <- copy_to(src_test("mssql"), df, name = unique_table_name())
+  db <- copy_to(src_test("mssql"), df, name = unique_table_name("#"))
 
   out <- db %>%
     mutate(
diff --git a/tests/testthat/test-db-sql.R b/tests/testthat/test-db-sql.R
index 398f77456..c6239082b 100644
--- a/tests/testthat/test-db-sql.R
+++ b/tests/testthat/test-db-sql.R
@@ -1,4 +1,5 @@
 test_that("2nd edition uses sql methods", {
+  reset_warning_verbosity("Test-edition")
   local_methods(
     db_analyze.Test = function(con, ...) abort("db_method")
   )
@@ -21,6 +22,7 @@ test_that("sql_query_rows() works", {
 })
 
 test_that("handles DBI error", {
+  unique_subquery_name_reset()
   con <- local_sqlite_connection()
 
   expect_snapshot({
diff --git a/tests/testthat/test-verb-compute.R b/tests/testthat/test-verb-compute.R
index d6b96b3b5..2b9b7392f 100644
--- a/tests/testthat/test-verb-compute.R
+++ b/tests/testthat/test-verb-compute.R
@@ -104,10 +104,11 @@ test_that("compute can handle schema", {
   )
 
   # errors because name already exists
-  expect_snapshot(error = TRUE, {
-    df %>%
-      compute(name = in_schema("main", "db1"), temporary = FALSE)
-  })
+  expect_snapshot(
+    df %>% compute(name = in_schema("main", "db1"), temporary = FALSE),
+    transform = snap_transform_dbi,
+    error = TRUE
+  )
 })
 
 test_that("collect() handles DBI error", {

From e898906cb7b090861f1c17c7b31643724f18bd78 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Thu, 21 Dec 2023 08:38:43 -0600
Subject: [PATCH 06/11] Fix R CMD check NOTE + doc buglets (#1425)

---
 R/backend-mssql.R            | 12 ++++++------
 R/backend-snowflake.R        |  2 +-
 R/verb-pivot-longer.R        |  2 +-
 man/pivot_longer.tbl_lazy.Rd |  2 +-
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/R/backend-mssql.R b/R/backend-mssql.R
index 830f51b26..e58844869 100644
--- a/R/backend-mssql.R
+++ b/R/backend-mssql.R
@@ -5,13 +5,13 @@
 #' details of overall translation technology. Key differences for this backend
 #' are:
 #'
-#' * `SELECT` uses `TOP` not `LIMIT`
-#' * Automatically prefixes `#` to create temporary tables. Add the prefix
+#' - `SELECT` uses `TOP` not `LIMIT`
+#' - Automatically prefixes `#` to create temporary tables. Add the prefix
 #'   yourself to avoid the message.
-#' * String basics: `paste()`, `substr()`, `nchar()`
-#' * Custom types for `as.*` functions
-#' * Lubridate extraction functions, `year()`, `month()`, `day()` etc
-#' * Semi-automated bit <-> boolean translation (see below)
+#' - String basics: `paste()`, `substr()`, `nchar()`
+#' - Custom types for `as.*` functions
+#' - Lubridate extraction functions, `year()`, `month()`, `day()` etc
+#' - Semi-automated bit <-> boolean translation (see below)
 #'
 #' Use `simulate_mssql()` with `lazy_frame()` to see simulated SQL without
 #' converting to live access database.
diff --git a/R/backend-snowflake.R b/R/backend-snowflake.R
index f89998047..11254577d 100644
--- a/R/backend-snowflake.R
+++ b/R/backend-snowflake.R
@@ -320,4 +320,4 @@ snowflake_pmin_pmax_builder <- function(dot_1, dot_2, comparison){
   glue_sql2(sql_current_con(), glue("COALESCE(IFF({dot_2} {comparison} {dot_1}, {dot_2}, {dot_1}), {dot_2}, {dot_1})"))
 }
 
-utils::globalVariables(c("%REGEXP%", "DAYNAME", "DECODE", "FLOAT", "MONTHNAME", "POSITION", "trim"))
+utils::globalVariables(c("%REGEXP%", "DAYNAME", "DECODE", "FLOAT", "MONTHNAME", "POSITION", "trim", "LENGTH"))
diff --git a/R/verb-pivot-longer.R b/R/verb-pivot-longer.R
index 8d4aed53d..028934a7f 100644
--- a/R/verb-pivot-longer.R
+++ b/R/verb-pivot-longer.R
@@ -3,7 +3,7 @@
 #' @description
 #' `pivot_longer()` "lengthens" data, increasing the number of rows and
 #' decreasing the number of columns. The inverse transformation is
-#' `tidyr::pivot_wider()]
+#' [tidyr::pivot_wider()].
 #'
 #' Learn more in `vignette("pivot", "tidyr")`.
 #'
diff --git a/man/pivot_longer.tbl_lazy.Rd b/man/pivot_longer.tbl_lazy.Rd
index 22952c699..0bd531529 100644
--- a/man/pivot_longer.tbl_lazy.Rd
+++ b/man/pivot_longer.tbl_lazy.Rd
@@ -60,7 +60,7 @@ in the \code{value_to} column.}
 \description{
 \code{pivot_longer()} "lengthens" data, increasing the number of rows and
 decreasing the number of columns. The inverse transformation is
-`tidyr::pivot_wider()]
+\code{\link[tidyr:pivot_wider]{tidyr::pivot_wider()}}.
 
 Learn more in \code{vignette("pivot", "tidyr")}.
 

From 267a12e080806482f85be5a73b5fb5372b14af1f Mon Sep 17 00:00:00 2001
From: Thomas Hulst <32511519+thomashulst@users.noreply.github.com>
Date: Thu, 21 Dec 2023 16:00:18 +0100
Subject: [PATCH 07/11] Allow Oracle to correctly explain queries (#1354)

Fixes #1353
---
 NAMESPACE                               |  2 ++
 NEWS.md                                 |  2 ++
 R/backend-oracle.R                      | 24 ++++++++++++++++++++----
 tests/testthat/_snaps/backend-oracle.md |  4 ++--
 4 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 9677e24b3..231fd305d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -55,6 +55,8 @@ S3method(db_copy_to,DBIConnection)
 S3method(db_create_index,DBIConnection)
 S3method(db_desc,DBIConnection)
 S3method(db_explain,DBIConnection)
+S3method(db_explain,OraConnection)
+S3method(db_explain,Oracle)
 S3method(db_query_fields,DBIConnection)
 S3method(db_query_fields,PostgreSQLConnection)
 S3method(db_save_query,DBIConnection)
diff --git a/NEWS.md b/NEWS.md
index da9ab66ad..316b50d0d 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
 # dbplyr (development version)
 
+* `db_explain()` now works for Oracle (@thomashulst, #1353).
+
 * Database errors now show the generated SQL, which hopefully will make it
   faster to track down problems (#1401).
 
diff --git a/R/backend-oracle.R b/R/backend-oracle.R
index dcae5b1d2..e66ef1b52 100644
--- a/R/backend-oracle.R
+++ b/R/backend-oracle.R
@@ -144,10 +144,11 @@ sql_translation.Oracle <- function(con) {
 
 #' @export
 sql_query_explain.Oracle <- function(con, sql, ...) {
-  glue_sql2(
-    con,
-    "EXPLAIN PLAN FOR {sql};\n",
-    "SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY()));",
+
+  # https://docs.oracle.com/en/database/oracle/oracle-database/19/tgsql/generating-and-displaying-execution-plans.html
+  c(
+    glue_sql2(con, "EXPLAIN PLAN FOR {sql}"),
+    glue_sql2(con, "SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY())")
   )
 }
 
@@ -182,6 +183,18 @@ sql_expr_matches.Oracle <- function(con, x, y, ...) {
   glue_sql2(con, "decode({x}, {y}, 0, 1) = 0")
 }
 
+#' @export
+db_explain.Oracle <- function(con, sql, ...) {
+  sql <- sql_query_explain(con, sql, ...)
+
+  msg <- "Can't explain query."
+  db_execute(con, sql[[1]], msg) # EXPLAIN PLAN
+  expl <- db_get_query(con, sql[[2]], msg) # DBMS_XPLAN.DISPLAY
+
+  out <- utils::capture.output(print(expl))
+  paste(out, collapse = "\n")
+}
+
 #' @export
 db_supports_table_alias_with_as.Oracle <- function(con) {
   FALSE
@@ -219,6 +232,9 @@ setdiff.OraConnection <- setdiff.tbl_Oracle
 #' @export
 sql_expr_matches.OraConnection <- sql_expr_matches.Oracle
 
+#' @export
+db_explain.OraConnection <- db_explain.Oracle
+
 #' @export
 db_supports_table_alias_with_as.OraConnection <- db_supports_table_alias_with_as.Oracle
 
diff --git a/tests/testthat/_snaps/backend-oracle.md b/tests/testthat/_snaps/backend-oracle.md
index 72e3f07bb..5ede3c406 100644
--- a/tests/testthat/_snaps/backend-oracle.md
+++ b/tests/testthat/_snaps/backend-oracle.md
@@ -41,8 +41,8 @@
     Code
       sql_query_explain(con, sql("SELECT * FROM foo"))
     Output
-      <SQL> EXPLAIN PLAN FOR SELECT * FROM foo;
-      SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY()));
+      <SQL> EXPLAIN PLAN FOR SELECT * FROM foo
+      <SQL> SELECT PLAN_TABLE_OUTPUT FROM TABLE(DBMS_XPLAN.DISPLAY())
 
 ---
 

From 81f23d47720d0326df41775ee330eaa06e833929 Mon Sep 17 00:00:00 2001
From: Noam Ross <noam.ross@gmail.com>
Date: Thu, 21 Dec 2023 16:11:41 -0500
Subject: [PATCH 08/11] Create `src_` classes from DBI class extensions (#918)

Co-authored-by: Hadley Wickham <h.wickham@gmail.com>
---
 NEWS.md                       |  3 +++
 R/src_dbi.R                   |  9 ++++++---
 tests/testthat/test-src_dbi.R | 18 ++++++++++++++++++
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 316b50d0d..ad78e01f9 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # dbplyr (development version)
 
+* The class of remote sources now includes all S4 class names, not just
+  the first (#918).
+
 * `db_explain()` now works for Oracle (@thomashulst, #1353).
 
 * Database errors now show the generated SQL, which hopefully will make it
diff --git a/R/src_dbi.R b/R/src_dbi.R
index 57e6c193f..978be8439 100644
--- a/R/src_dbi.R
+++ b/R/src_dbi.R
@@ -123,17 +123,20 @@ src_dbi <- function(con, auto_disconnect = FALSE) {
     disco <- db_disconnector(con, quiet = is_true(auto_disconnect)) # nocov
   }
 
-  subclass <- paste0("src_", class(con)[[1]])
-
   structure(
     list(
       con = con,
       disco = disco
     ),
-    class = c(subclass, "src_dbi", "src_sql", "src")
+    class = connection_s3_class(con)
   )
 }
 
+connection_s3_class <- function(con) {
+  subclass <- setdiff(methods::is(con), methods::extends("DBIConnection"))
+  c(paste0("src_", subclass), "src_dbi", "src_sql", "src")
+}
+
 methods::setOldClass(c("src_dbi", "src_sql", "src"))
 
 # nocov start
diff --git a/tests/testthat/test-src_dbi.R b/tests/testthat/test-src_dbi.R
index e7b8c23a3..337808779 100644
--- a/tests/testthat/test-src_dbi.R
+++ b/tests/testthat/test-src_dbi.R
@@ -4,3 +4,21 @@ test_that("tbl and src classes include connection class", {
   expect_true(inherits(mf, "tbl_SQLiteConnection"))
   expect_true(inherits(mf$src, "src_SQLiteConnection"))
 })
+
+test_that("generates S3 class based on S4 class name", {
+  con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
+  expect_equal(
+    connection_s3_class(con), 
+    c("src_SQLiteConnection", "src_dbi", "src_sql", "src")
+ )
+
+  on.exit(removeClass("Foo2"))
+  on.exit(removeClass("Foo1"))
+
+  Foo1 <- setClass("Foo1", contains = "DBIConnection")
+  Foo2 <- setClass("Foo2", contains = "Foo1")
+  expect_equal(
+    connection_s3_class(Foo2()), 
+    c("src_Foo2", "src_Foo1", "src_dbi", "src_sql", "src")
+  )
+})

From 3ab0ebec0858e858829dfb0f8ab03cb85a976632 Mon Sep 17 00:00:00 2001
From: Reijo Sund <reijo.sund@uef.fi>
Date: Fri, 22 Dec 2023 00:26:08 +0200
Subject: [PATCH 09/11] Let additional arguments pass from
 db_compute.DBIConnection() to dbplyr_save_query() (#1037)

---
 NEWS.md   | 3 +++
 R/db-io.R | 1 +
 2 files changed, 4 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index ad78e01f9..6eeb08a18 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # dbplyr (development version)
 
+* Allow additional arguments to be passed from `compute()` all the way to 
+  `sql_query_save()`-method (@rsund).
+
 * The class of remote sources now includes all S4 class names, not just
   the first (#918).
 
diff --git a/R/db-io.R b/R/db-io.R
index 11e9b2c02..690dfec13 100644
--- a/R/db-io.R
+++ b/R/db-io.R
@@ -137,6 +137,7 @@ db_compute.DBIConnection <- function(con,
         con,
         sql,
         table,
+        ...,
         temporary = temporary,
         overwrite = overwrite
       )

From f6b34fa56675b5d0decb23c5868a07a40f8c1a0b Mon Sep 17 00:00:00 2001
From: Thomas Hulst <32511519+thomashulst@users.noreply.github.com>
Date: Fri, 22 Dec 2023 14:37:58 +0100
Subject: [PATCH 10/11] Add str_replace and str_replace_all for Oracle backend
 (#1402)

Fixes #1393
---
 NEWS.md                                 |  3 +++
 R/backend-oracle.R                      | 10 ++++++++++
 tests/testthat/_snaps/backend-oracle.md | 11 +++++++++++
 tests/testthat/test-backend-oracle.R    | 10 ++++++++++
 4 files changed, 34 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 6eeb08a18..297a7f42a 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # dbplyr (development version)
 
+* Oracle: Added support for `str_replace()` and `str_replace_all()` via
+  `REGEXP_REPLACE()` (@thomashulst, #1402).
+
 * Allow additional arguments to be passed from `compute()` all the way to 
   `sql_query_save()`-method (@rsund).
 
diff --git a/R/backend-oracle.R b/R/backend-oracle.R
index e66ef1b52..9e2bfaa6e 100644
--- a/R/backend-oracle.R
+++ b/R/backend-oracle.R
@@ -133,6 +133,16 @@ sql_translation.Oracle <- function(con) {
       paste0 = sql_paste_infix("", "||", function(x) sql_expr(cast(!!x %as% text))),
       str_c = sql_paste_infix("", "||", function(x) sql_expr(cast(!!x %as% text))),
 
+      # https://docs.oracle.com/en/database/oracle/oracle-database/19/sqlrf/REGEXP_REPLACE.html
+      # 4th argument is starting position (default: 1 => first char of string)
+      # 5th argument is occurrence (default: 0 => match all occurrences)
+      str_replace = function(string, pattern, replacement){
+        sql_expr(regexp_replace(!!string, !!pattern, !!replacement, 1L, 1L))
+      },
+      str_replace_all = function(string, pattern, replacement){
+        sql_expr(regexp_replace(!!string, !!pattern, !!replacement))
+      },
+
       # lubridate --------------------------------------------------------------
       today = function() sql_expr(TRUNC(CURRENT_TIMESTAMP)),
       now = function() sql_expr(CURRENT_TIMESTAMP)
diff --git a/tests/testthat/_snaps/backend-oracle.md b/tests/testthat/_snaps/backend-oracle.md
index 5ede3c406..e50731905 100644
--- a/tests/testthat/_snaps/backend-oracle.md
+++ b/tests/testthat/_snaps/backend-oracle.md
@@ -1,3 +1,14 @@
+# string functions translate correctly
+
+    Code
+      test_translate_sql(str_replace(col, "pattern", "replacement"))
+    Output
+      <SQL> REGEXP_REPLACE(`col`, 'pattern', 'replacement', 1, 1)
+    Code
+      test_translate_sql(str_replace_all(col, "pattern", "replacement"))
+    Output
+      <SQL> REGEXP_REPLACE(`col`, 'pattern', 'replacement')
+
 # queries translate correctly
 
     Code
diff --git a/tests/testthat/test-backend-oracle.R b/tests/testthat/test-backend-oracle.R
index 5c299600f..9824c8245 100644
--- a/tests/testthat/test-backend-oracle.R
+++ b/tests/testthat/test-backend-oracle.R
@@ -16,6 +16,16 @@ test_that("paste and paste0 translate correctly", {
   expect_equal(test_translate_sql(str_c(x, y)), sql("`x` || `y`"))
 })
 
+
+test_that("string functions translate correctly", {
+  local_con(simulate_oracle())
+
+  expect_snapshot({
+    test_translate_sql(str_replace(col, "pattern", "replacement"))
+    test_translate_sql(str_replace_all(col, "pattern", "replacement"))
+  })
+})
+
 test_that("queries translate correctly", {
   mf <- lazy_frame(x = 1, con = simulate_oracle())
   expect_snapshot(mf %>% head())

From a40c03a91852e93c2cae8a0bcbf4e421a751780d Mon Sep 17 00:00:00 2001
From: Eric Neer <EricJNeer@gmail.com>
Date: Fri, 22 Dec 2023 06:38:53 -0800
Subject: [PATCH 11/11] Improve MS SQL bit to boolean translation (#1288)

---
 NAMESPACE                              |  1 +
 NEWS.md                                |  3 ++
 R/backend-mssql.R                      | 36 +++++++++++++++++++++
 tests/testthat/_snaps/backend-mssql.md | 45 ++++++++++++++++++++++++++
 tests/testthat/test-backend-mssql.R    | 14 ++++++++
 5 files changed, 99 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index 231fd305d..556dda0a3 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -60,6 +60,7 @@ S3method(db_explain,Oracle)
 S3method(db_query_fields,DBIConnection)
 S3method(db_query_fields,PostgreSQLConnection)
 S3method(db_save_query,DBIConnection)
+S3method(db_sql_render,"Microsoft SQL Server")
 S3method(db_sql_render,DBIConnection)
 S3method(db_supports_table_alias_with_as,DBIConnection)
 S3method(db_supports_table_alias_with_as,OraConnection)
diff --git a/NEWS.md b/NEWS.md
index 297a7f42a..9dfbc547f 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # dbplyr (development version)
 
+* SQL server: `filter()` does a better job of converting logical vectors 
+  from bit to boolean (@ejneer, #1288). 
+
 * Oracle: Added support for `str_replace()` and `str_replace_all()` via
   `REGEXP_REPLACE()` (@thomashulst, #1402).
 
diff --git a/R/backend-mssql.R b/R/backend-mssql.R
index e58844869..ec259797a 100644
--- a/R/backend-mssql.R
+++ b/R/backend-mssql.R
@@ -589,4 +589,40 @@ mssql_bit_int_bit <- function(f) {
   dplyr::if_else(x, "1", "0", "NULL")
 }
 
+#' @export
+`db_sql_render.Microsoft SQL Server` <- function(con, sql, ..., cte = FALSE, use_star = TRUE) {
+  # Post-process WHERE to cast logicals from BIT to BOOLEAN
+  sql$lazy_query <- purrr::modify_tree(
+    sql$lazy_query,
+    is_node = function(x) inherits(x, "lazy_query"),
+    post = mssql_update_where_clause
+  )
+
+  NextMethod()
+}
+
+mssql_update_where_clause <- function(qry) {
+  if (!has_name(qry, "where")) {
+    return(qry)
+  }
+
+  qry$where <- lapply(
+    qry$where, 
+    function(x) set_expr(x, bit_to_boolean(get_expr(x)))
+  )
+  qry
+}
+
+bit_to_boolean <- function(x_expr) {
+  if (is_atomic(x_expr) || is_symbol(x_expr)) {
+    expr(cast(!!x_expr %AS% BIT) == 1L)
+  } else if (is_call(x_expr, c("|", "&", "||", "&&", "!", "("))) {
+    idx <- seq2(2, length(x_expr))
+    x_expr[idx] <- lapply(x_expr[idx], bit_to_boolean)
+    x_expr
+  } else {
+    x_expr
+  }
+}
+
 utils::globalVariables(c("BIT", "CAST", "%AS%", "%is%", "convert", "DATE", "DATENAME", "DATEPART", "IIF", "NOT", "SUBSTRING", "LTRIM", "RTRIM", "CHARINDEX", "SYSDATETIME", "SECOND", "MINUTE", "HOUR", "DAY", "DAYOFWEEK", "DAYOFYEAR", "MONTH", "QUARTER", "YEAR", "BIGINT", "INT", "%AND%", "%BETWEEN%"))
diff --git a/tests/testthat/_snaps/backend-mssql.md b/tests/testthat/_snaps/backend-mssql.md
index 9736c39c9..20e547f8e 100644
--- a/tests/testthat/_snaps/backend-mssql.md
+++ b/tests/testthat/_snaps/backend-mssql.md
@@ -370,6 +370,51 @@
       OUTPUT `INSERTED`.`a`, `INSERTED`.`b` AS `b2`
       ;
 
+# atoms and symbols are cast to bit in `filter`
+
+    Code
+      mf %>% filter(x)
+    Output
+      <SQL>
+      SELECT `df`.*
+      FROM `df`
+      WHERE (cast(`x` AS `BIT`) = 1)
+
+---
+
+    Code
+      mf %>% filter(TRUE)
+    Output
+      <SQL>
+      SELECT `df`.*
+      FROM `df`
+      WHERE (cast(1 AS `BIT`) = 1)
+
+---
+
+    Code
+      mf %>% filter((!x) | FALSE)
+    Output
+      <SQL>
+      SELECT `df`.*
+      FROM `df`
+      WHERE ((NOT(cast(`x` AS `BIT`) = 1)) OR cast(0 AS `BIT`) = 1)
+
+---
+
+    Code
+      mf %>% filter(x) %>% inner_join(mf, by = "x")
+    Output
+      <SQL>
+      SELECT `LHS`.`x` AS `x`
+      FROM (
+        SELECT `df`.*
+        FROM `df`
+        WHERE (cast(`x` AS `BIT`) = 1)
+      ) AS `LHS`
+      INNER JOIN `df`
+        ON (`LHS`.`x` = `df`.`x`)
+
 # row_number() with and without group_by() and arrange(): unordered defaults to Ordering by NULL (per empty_order)
 
     Code
diff --git a/tests/testthat/test-backend-mssql.R b/tests/testthat/test-backend-mssql.R
index c11e84028..bebaf7364 100644
--- a/tests/testthat/test-backend-mssql.R
+++ b/tests/testthat/test-backend-mssql.R
@@ -322,6 +322,20 @@ test_that("`sql_query_upsert()` is correct", {
   )
 })
 
+test_that("atoms and symbols are cast to bit in `filter`", {
+  mf <- lazy_frame(x = TRUE, con = simulate_mssql())
+
+  # as simple symbol and atom
+  expect_snapshot(mf %>% filter(x))
+  expect_snapshot(mf %>% filter(TRUE))
+
+  # when involved in a (perhaps nested) logical expression
+  expect_snapshot(mf %>% filter((!x) | FALSE))
+
+  # in a subquery
+  expect_snapshot(mf %>% filter(x) %>% inner_join(mf, by = "x"))
+})
+
 test_that("row_number() with and without group_by() and arrange(): unordered defaults to Ordering by NULL (per empty_order)", {
   mf <- lazy_frame(x = c(1:5), y = c(rep("A", 5)), con = simulate_mssql())
   expect_snapshot(mf %>% mutate(rown = row_number()))