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
141
142
143
144
145
146
147
148
149
|
#' spec_sql_quote_literal
#' @family sql specifications
#' @usage NULL
#' @format NULL
#' @keywords NULL
spec_sql_quote_literal <- list(
quote_literal_formals = function() {
# <establish formals of described functions>
expect_equal(names(formals(dbQuoteLiteral)), c("conn", "x", "..."))
},
quote_literal_return = function(con) {
#' @return
#' `dbQuoteLiteral()` returns an object that can be coerced to [character],
simple <- "simple"
simple_out <- dbQuoteLiteral(con, simple)
expect_error(as.character(simple_out), NA)
expect_type(as.character(simple_out), "character")
expect_equal(length(simple_out), 1L)
},
#
quote_literal_vectorized = function(con) {
#' of the same length as the input.
letters_out <- dbQuoteLiteral(con, letters)
expect_equal(length(letters_out), length(letters))
},
#
quote_literal_empty = function(ctx, con) {
skip_if_not_dbitest(ctx, "1.7.2")
#' For an empty
#' integer,
expect_equal(length(dbQuoteLiteral(con, integer())), 0L)
#' numeric,
expect_equal(length(dbQuoteLiteral(con, numeric())), 0L)
#' character,
expect_equal(length(dbQuoteLiteral(con, character())), 0L)
#' logical,
expect_equal(length(dbQuoteLiteral(con, logical())), 0L)
#' date,
expect_equal(length(dbQuoteLiteral(con, Sys.Date()[0])), 0L)
#' time,
expect_equal(length(dbQuoteLiteral(con, Sys.time()[0])), 0L)
#' or blob vector,
expect_equal(length(dbQuoteLiteral(con, list())), 0L)
#' this function returns a length-0 object.
},
#
quote_literal_double = function(con) {
simple <- "simple"
simple_out <- dbQuoteLiteral(con, simple)
letters_out <- dbQuoteLiteral(con, letters)
empty <- character()
empty_out <- dbQuoteLiteral(con, character())
#'
#' When passing the returned object again to `dbQuoteLiteral()`
#' as `x`
#' argument, it is returned unchanged.
expect_identical(dbQuoteLiteral(con, simple_out), simple_out)
expect_identical(dbQuoteLiteral(con, letters_out), letters_out)
expect_identical(dbQuoteLiteral(con, empty_out), empty_out)
#' Passing objects of class [SQL] should also return them unchanged.
expect_identical(dbQuoteLiteral(con, SQL(simple)), SQL(simple))
expect_identical(dbQuoteLiteral(con, SQL(letters)), SQL(letters))
expect_identical(dbQuoteLiteral(con, SQL(empty)), SQL(empty))
#' (For backends it may be most convenient to return [SQL] objects
#' to achieve this behavior, but this is not required.)
},
quote_literal_roundtrip = function(ctx, con) {
#' @section Specification:
do_test_literal <- function(x) {
#' The returned expression can be used in a `SELECT ...` query,
literals <- map_chr(x, dbQuoteLiteral, conn = con)
query <- paste0("SELECT ", paste(literals, collapse = ", "))
#' and the value of
#' \code{dbGetQuery(paste0("SELECT ", dbQuoteLiteral(x)))[[1]]}
#' must be equal to `x`
x_out <- check_df(dbGetQuery(con, query))
expect_equal(nrow(x_out), 1L)
is_logical <- map_lgl(x, is.logical)
x_out[is_logical] <- map(x_out[is_logical], as.logical)
is_numeric <- map_lgl(x, is.numeric)
x_out[is_numeric] <- map(x_out[is_numeric], as.numeric)
expect_equal(as.list(unname(x_out)), x)
}
#' for any scalar
test_literals <- list(
#' integer,
1L,
#' numeric,
2.5,
#' string,
"string",
#' and logical.
TRUE
)
do_test_literal(test_literals)
},
#
quote_literal_na = function(ctx, con) {
null <- dbQuoteLiteral(con, NA_character_)
quoted_null <- dbQuoteLiteral(con, as.character(null))
na <- dbQuoteLiteral(con, "NA")
quoted_na <- dbQuoteLiteral(con, as.character(na))
query <- paste0(
"SELECT ",
null, " AS null_return,",
na, " AS na_return,",
quoted_null, " AS quoted_null,",
quoted_na, " AS quoted_na"
)
#' If `x` is `NA`, the result must merely satisfy [is.na()].
rows <- check_df(dbGetQuery(con, query))
expect_true(is.na(rows$null_return))
#' The literals `"NA"` or `"NULL"` are not treated specially.
expect_identical(rows$na_return, "NA")
expect_identical(rows$quoted_null, as.character(null))
expect_identical(rows$quoted_na, as.character(na))
},
#
#'
quote_literal_na_is_null = function(ctx, con) {
#' `NA` should be translated to an unquoted SQL `NULL`,
null <- dbQuoteLiteral(con, NA_character_)
#' so that the query `SELECT * FROM (SELECT 1) a WHERE ... IS NULL`
rows <- check_df(dbGetQuery(con, paste0("SELECT * FROM (SELECT 1) a WHERE ", null, " IS NULL")))
#' returns one row.
expect_equal(nrow(rows), 1L)
},
#'
quote_literal_error = function(ctx, con) {
#' @section Failure modes:
#'
#' Passing a list
expect_error(dbQuoteString(con, as.list(1:3)))
#' for the `x` argument raises an error.
},
#
NULL
)
|
