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
150
151
152
153
154
155
156
157
|
#' spec_sql_list_objects
#' @family sql specifications
#' @usage NULL
#' @format NULL
#' @keywords NULL
spec_sql_list_objects <- list(
list_objects_formals = function() {
# <establish formals of described functions>
expect_equal(names(formals(dbListObjects)), c("conn", "prefix", "..."))
},
list_objects_1 = function(ctx, con, table_name = "dbit06") {
#' @return
#' `dbListObjects()`
objects <- dbListObjects(con)
#' returns a data frame
expect_s3_class(objects, "data.frame")
#' with columns
cols <- c("table", "is_prefix")
#' `table` and `is_prefix` (in that order),
expect_equal(names(objects)[seq_along(cols)], cols)
#' optionally with other columns with a dot (`.`) prefix.
expect_true(all(grepl("^[.]", names(objects)[-seq_along(cols)])))
#' The `table` column is of type list.
expect_equal(typeof(objects$table), "list")
#' Each object in this list is suitable for use as argument in [dbQuoteIdentifier()].
expect_error(map(objects$table, dbQuoteIdentifier, conn = con), NA)
#' The `is_prefix` column is a logical.
expect_type(objects$is_prefix, "logical")
#' This data frame contains one row for each object (schema, table
expect_false(table_name %in% objects)
#' and view)
# TODO
#' accessible from the prefix (if passed) or from the global namespace
#' (if prefix is omitted).
#' Tables added with [dbWriteTable()] are
penguins <- get_penguins(ctx)
dbWriteTable(con, table_name, penguins)
#' part of the data frame.
objects <- dbListObjects(con)
quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
},
# second stage
list_objects_2 = function(ctx, con) {
# table_name not in formals on purpose: this means that this table won't be
# removed at the end of the test
table_name <- "dbit06"
#' As soon a table is removed from the database,
#' it is also removed from the data frame of database objects.
objects <- dbListObjects(con)
quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
expect_false(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
},
#'
list_objects_temporary = function(ctx, con, table_name) {
#' The same applies to temporary objects if supported by the database.
if (isTRUE(ctx$tweaks$temporary_tables) && isTRUE(ctx$tweaks$list_temporary_tables)) {
dbWriteTable(con, table_name, data.frame(a = 1L), temporary = TRUE)
objects <- dbListObjects(con)
quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
}
},
#'
list_objects_quote = function(ctx, con) {
#' The returned names are suitable for quoting with `dbQuoteIdentifier()`.
if (isTRUE(ctx$tweaks$strict_identifier)) {
table_names <- "a"
} else {
table_names <- c("a", "with spaces", "with,comma")
}
for (table_name in table_names) {
local_remove_test_table(con, table_name)
dbWriteTable(con, dbQuoteIdentifier(con, table_name), data.frame(a = 2L))
objects <- dbListObjects(con)
quoted_tables <- map_chr(objects$table, dbQuoteIdentifier, conn = con)
expect_true(dbQuoteIdentifier(con, table_name) %in% quoted_tables)
}
},
#'
list_objects_closed_connection = function(ctx, closed_con) {
#' @section Failure modes:
#' An error is raised when calling this method for a closed
expect_error(dbListObjects(closed_con))
},
list_objects_invalid_connection = function(ctx, invalid_con) {
#' or invalid connection.
expect_error(dbListObjects(invalid_con))
},
list_objects_features = function(ctx, con) {
#' @section Specification:
objects <- dbListObjects(con)
#' The `prefix` column indicates if the `table` value refers to a table
#' or a prefix.
#' For a call with the default `prefix = NULL`, the `table`
#' values that have `is_prefix == FALSE` correspond to the tables
#' returned from [dbListTables()],
non_prefix_objects <- map_chr(
objects$table[!objects$is_prefix],
dbQuoteIdentifier,
conn = con
)
all_tables <- dbQuoteIdentifier(con, dbListTables(con))
expect_equal(sort(non_prefix_objects), sort(as.character(all_tables)))
#'
#' The `table` object can be quoted with [dbQuoteIdentifier()].
sql <- map(objects$table[!objects$is_prefix], dbQuoteIdentifier, conn = con)
#' The result of quoting can be passed to [dbUnquoteIdentifier()].
expect_error(walk(sql, dbUnquoteIdentifier, conn = con), NA)
#' (For backends it may be convenient to use the [Id] class, but this is
#' not required.)
if (!any(objects$is_prefix)) {
skip("No schemas available")
}
#'
#' Values in `table` column that have `is_prefix == TRUE` can be
#' passed as the `prefix` argument to another call to `dbListObjects()`.
#' For the data frame returned from a `dbListObject()` call with the
#' `prefix` argument set, all `table` values where `is_prefix` is
#' `FALSE` can be used in a call to [dbExistsTable()] which returns
#' `TRUE`.
for (schema in utils::head(objects$table[objects$is_prefix])) {
sub_objects <- dbListObjects(con, prefix = schema)
for (sub_table in utils::head(sub_objects$table[!sub_objects$is_prefix])) {
# HACK HACK HACK for RMariaDB on OS X (#188)
if (!identical(sub_table, Id(schema = "information_schema", table = "FILES"))) {
# eval(bquote()) preserves the SQL class, even if it's not apparent
# in the output
eval(bquote(expect_true(
dbExistsTable(con, .(sub_table)),
label = paste0("dbExistsTable(", dbQuoteIdentifier(con, sub_table), ")")
)))
}
}
}
},
#
NULL
)
|
