feat: New allow_na_rows_affected tweak to support NA values retur…

…ned from `dbGetRowsAffected()`

R/spec-meta-bind-.R

@@ -6,6 +6,7 @@ test_select_bind <- function(con, ctx, ...) {
     test_select_bind_one,
     con = con,
     is_null_check = ctx$tweaks$is_null_check,
+    allow_na_rows_affected = ctx$tweaks$allow_na_rows_affected,
     ...
   )
 }
@@ -25,14 +26,20 @@ get_placeholder_funs <- function(ctx) {
   placeholder_fun
 }
 
-test_select_bind_one <- function(con, placeholder_fun, is_null_check, values,
-                                 query = TRUE,
-                                 extra = "none",
-                                 cast_fun = identity) {
+test_select_bind_one <- function(
+    con,
+    placeholder_fun,
+    is_null_check,
+    values,
+    query = TRUE,
+    extra = "none",
+    cast_fun = identity,
+    allow_na_rows_affected = FALSE) {
   bind_tester <- BindTester$new(con)
   bind_tester$placeholder_fun <- placeholder_fun
   bind_tester$is_null_check <- is_null_check
   bind_tester$cast_fun <- cast_fun
+  bind_tester$allow_na_rows_affected <- allow_na_rows_affected
   bind_tester$values <- values
   bind_tester$query <- query
   bind_tester$extra_obj <- new_extra_imp(extra)
@@ -79,6 +86,7 @@ BindTester <- R6::R6Class(
     placeholder_fun = NULL,
     is_null_check = NULL,
     cast_fun = NULL,
+    allow_na_rows_affected = NULL,
     values = NULL,
     query = TRUE,
     extra_obj = NULL
@@ -155,6 +163,10 @@ BindTester <- R6::R6Class(
     },
     #
     compare_affected = function(rows_affected, values) {
+      # Allow NA value for dbGetRowsAffected(), #297
+      if (isTRUE(allow_na_rows_affected) && is.na(rows_affected)) {
+        return()
+      }
       expect_equal(rows_affected, sum(values[[1]]))
     }
   )

R/spec-meta-get-rows-affected.R

@@ -9,7 +9,7 @@ spec_meta_get_rows_affected <- list(
     expect_equal(names(formals(dbGetRowsAffected)), c("res", "..."))
   },
 
-  rows_affected_statement = function(con, table_name) {
+  rows_affected_statement = function(ctx, con, table_name) {
     #' @return
     #' `dbGetRowsAffected()` returns a scalar number (integer or numeric),
     #' the number of rows affected by a data manipulation statement
@@ -23,15 +23,25 @@ spec_meta_get_rows_affected <- list(
     res <- local_result(dbSendStatement(con, query))
     rc <- dbGetRowsAffected(res)
     #' The value is available directly after the call
-    expect_equal(rc, 5L)
+    if (isTRUE(ctx$tweaks$allow_na_rows_affected)) {
+      expect_true((is.na(rc) && is.numeric(rc)) || rc == 5L)
+    } else {
+      expect_equal(rc, 5L)
+    }
     expect_warning(check_df(dbFetch(res)))
     rc <- dbGetRowsAffected(res)
     #' and does not change after calling [dbFetch()].
-    expect_equal(rc, 5L)
+    if (isTRUE(ctx$tweaks$allow_na_rows_affected)) {
+      expect_true((is.na(rc) && is.numeric(rc)) || rc == 5L)
+    } else {
+      expect_equal(rc, 5L)
+    }
+    #' `NA_integer_` or `NA_numeric_` are allowed if the number of rows affected is not known.
   },
   #
-  rows_affected_query = function(con) {
+  rows_affected_query = function(ctx, con) {
     query <- trivial_query()
+    #'
     #' For queries issued with [dbSendQuery()],
     res <- local_result(dbSendQuery(con, query))
     rc <- dbGetRowsAffected(res)
@@ -41,6 +51,7 @@ spec_meta_get_rows_affected <- list(
     rc <- dbGetRowsAffected(res)
     #' and after the call to `dbFetch()`.
     expect_equal(rc, 0L)
+    #' `NA` values are not allowed.
   },
   #'
   get_rows_affected_error = function(con, table_name) {

R/spec-result-execute.R

@@ -73,8 +73,12 @@ spec_result_execute <- list(
       query <- paste0("DELETE FROM ", table_name, " WHERE a > ", placeholder)
       values <- 1.5
       params <- stats::setNames(list(values), names(placeholder))
-      ret <- dbExecute(con, query, params = params)
-      expect_equal(ret, 2, info = placeholder)
+      rc <- dbExecute(con, query, params = params)
+      if (isTRUE(ctx$tweaks$allow_na_rows_affected)) {
+        expect_true((is.na(rc) && is.numeric(rc)) || rc == 2L, info = placeholder)
+      } else {
+        expect_equal(rc, 2L, info = placeholder)
+      }
     }
   },
 

R/spec-result-send-statement.R

@@ -118,7 +118,12 @@ spec_result_send_statement <- list(
       values <- 1.5
       params <- stats::setNames(list(values), names(placeholder))
       rs <- dbSendStatement(con, query, params = params)
-      expect_equal(dbGetRowsAffected(rs), 2, info = placeholder)
+      rc <- dbGetRowsAffected(rs)
+      if (isTRUE(ctx$tweaks$allow_na_rows_affected)) {
+        expect_true((is.na(rc) && is.numeric(rc)) || rc == 2L, info = placeholder)
+      } else {
+        expect_equal(rc, 2L, info = placeholder)
+      }
       dbClearResult(rs)
     }
   },

R/tweaks.R

@@ -101,6 +101,10 @@
     #'   Set to `FALSE` if the DBMS doesn't support listing temporary tables.
     "list_temporary_tables" = TRUE,
 
+    #' @param allow_na_rows_affected `[logical(1L)]`\cr
+    #'   Set to `TRUE` to allow [dbRowsAffected()] to return `NA`.
+    "allow_na_rows_affected" = FALSE,
+
     #' @param is_null_check `[function(character)]`\cr
     #'   A vectorized function that creates an SQL expression for checking if a
     #'   value is `NULL`.