1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#' spec_result_send_statement
#' @family result specifications
#' @usage NULL
#' @format NULL
#' @keywords NULL
spec_result_send_statement <- list(
send_statement_formals = function() {
# <establish formals of described functions>
expect_equal(names(formals(dbSendStatement)), c("conn", "statement", "..."))
},
send_statement_trivial = function(ctx, con, table_name) {
#' @return
#' `dbSendStatement()` returns
res <- expect_visible(dbSendStatement(con, trivial_statement(ctx, table_name)))
#' an S4 object that inherits from [DBIResult-class].
expect_s4_class(res, "DBIResult")
#' The result set can be used with [dbGetRowsAffected()] to
#' determine the number of rows affected by the query.
expect_error(dbGetRowsAffected(res), NA)
#' Once you have finished using a result, make sure to clear it
#' with [dbClearResult()].
dbClearResult(res)
},
#'
send_statement_closed_connection = function(ctx, closed_con) {
#' @section Failure modes:
#' An error is raised when issuing a statement over a closed
table_name <- "dbit10"
expect_error(dbSendStatement(closed_con, trivial_statement(ctx, table_name = table_name)))
},
send_statement_invalid_connection = function(ctx, invalid_con) {
#' or invalid connection,
table_name <- "dbit11"
expect_error(dbSendStatement(invalid_con, trivial_statement(ctx, table_name = table_name)))
},
send_statement_non_string = function(con) {
#' or if the statement is not a non-`NA` string.
expect_error(dbSendStatement(con, character()))
expect_error(dbSendStatement(con, letters))
expect_error(dbSendStatement(con, NA_character_))
},
send_statement_syntax_error = function(con) {
#' An error is also raised if the syntax of the query is invalid
#' and all query parameters are given (by passing the `params` argument)
#' or the `immediate` argument is set to `TRUE`.
#'
#' @section Failure modes:
expect_error(dbSendStatement(con, "CREATTE", params = list()))
expect_error(dbSendStatement(con, "CREATTE", immediate = TRUE))
},
send_statement_result_valid = function(ctx, con, table_name) {
#' @section Specification:
#' No warnings occur under normal conditions.
expect_warning(res <- dbSendStatement(con, trivial_statement(ctx, table_name)), NA)
#' When done, the DBIResult object must be cleared with a call to
#' [dbClearResult()].
dbClearResult(res)
},
#
send_statement_stale_warning = function(ctx) {
#' Failure to clear the result set leads to a warning
#' when the connection is closed.
con <- connect(ctx)
on.exit(dbDisconnect(con))
expect_warning(dbSendStatement(con, trivial_query()), NA)
expect_warning({
dbDisconnect(con)
gc()
})
on.exit(NULL)
},
send_statement_only_one_result_set = function(ctx, con, table_name) {
#' If the backend supports only one open result set per connection,
res1 <- dbSendStatement(con, trivial_statement(ctx, table_name))
other_table_name <- random_table_name()
local_remove_test_table(con, other_table_name)
#' issuing a second query invalidates an already open result set
#' and raises a warning.
query <- ctx$tweaks$create_table_as(other_table_name, "SELECT 1 AS a")
expect_warning(res2 <- dbSendStatement(con, query))
expect_false(dbIsValid(res1))
#' The newly opened result set is valid
expect_true(dbIsValid(res2))
#' and must be cleared with `dbClearResult()`.
dbClearResult(res2)
},
#' @section Additional arguments:
#' The following arguments are not part of the `dbSendStatement()` generic
#' (to improve compatibility across backends)
#' but are part of the DBI specification:
#' - `params` (default: `NULL`)
#' - `immediate` (default: `NULL`)
#'
#' They must be provided as named arguments.
#' See the "Specification" sections for details on their usage.
send_statement_params = function(ctx, con) {
#' @section Specification:
#'
#' The `param` argument allows passing query parameters, see [dbBind()] for details.
placeholder_funs <- get_placeholder_funs(ctx)
for (placeholder_fun in placeholder_funs) {
table_name <- random_table_name()
local_remove_test_table(con, table_name)
dbWriteTable(con, table_name, data.frame(a = as.numeric(1:3)))
placeholder <- placeholder_fun(1)
query <- paste0("DELETE FROM ", table_name, " WHERE a > ", placeholder)
values <- 1.5
params <- stats::setNames(list(values), names(placeholder))
rs <- dbSendStatement(con, query, params = params)
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)
}
},
send_statement_immediate = function(ctx, con, table_name) {
#' @inheritSection spec_result_get_query Specification for the `immediate` argument
res <- expect_visible(dbSendStatement(con, trivial_statement(ctx, table_name), immediate = TRUE))
expect_s4_class(res, "DBIResult")
expect_error(dbGetRowsAffected(res), NA)
dbClearResult(res)
},
#
NULL
)
|
