Testing a new backend
The test cases in the DBItest package are structured very similarly to the sections in the “backend” vignette:
vignette("backend", package = "DBI")
Like the “backend” vignette, this vignette assumes that you are implementing the RKazam package that has a Kazam() function that creates a new DBIDriver instance for connecting to a “Kazam” database.
You can add the tests in the DBItest package incrementally, as you proceed with implementing the various parts of the DBI. The DBItest package builds upon the testthat package. To enable it, run the following in your package directory (after installing or updating devtools):
devtools::use_testthat()
devtools::use_test("DBItest")
This creates, among others, a file test-DBItest.R in the tests/testthat directory. Replace its entire contents by the following:
DBItest::make_context(Kazam(), NULL)
DBItest::test_getting_started()
Now test your package with devtools::test(). If you followed at least the “Getting started” section of the DBI “backend” vignette, all tests should succeed.
By adding the corresponding test function to your tests/test-DBItest.R file before implementing a section, you get immediate feedback which functionality of this section still needs to be implemented by running devtools::test() again. Therefore, proceed by appending the following to tests/test-DBItest.R, to include a test case for the forthcoming section:
Again, all tests should succeed when you are done with the “Driver” section. Add the call to the next tester function, implement the following section until all tests succeed, and so forth.
In this scenario, you are usually interested only in the first error the test suite finds. The StopReporter of testthat is most helpful here, activate it by passing reporter = "stop" to devtools::test(). Alternatively, call the relevant DBItest::test_() function directly.
The tests are documented with the corresponding functions: For instance, ?test_driver shows a coarse description of all tests for the “Driver” test case. Test failures will include the name of the test that is failing; in this case, investigating the documentation or the source code of the DBItest package will usually lead to the cause of the error.
Not all tests can be satisfied: For example, there is one test that tests that logical variables survive a write-read roundtrip to the database, whereas another test tests that logical variables are converted to integer in such a case. Tests can be skipped by adding regular expressions for the tests to skip as character vector to the call, as in the following[^termnull]:
DBItest::test_driver(skip = c(
"data_type" # Reason 1...
"constructor.*", # Reason 2...
NULL
))
[^termnull]: The terminating `NULL` allows appending new lines to the end by copy-pasting an existing line, without having to take care of the terminating comma.
Some other reasons to skip tests are: - your database does not support a feature - you want to postpone or avoid the implementation of a feature - the test takes too long to run
Testing an existing backend
For an existing backends, simply enabling all tests may be the quickest way to get started. Run the following in your package directory (after installing or updating devtools):
devtools::use_testthat()
devtools::use_test("DBItest")
This creates, among others, a file test-DBItest.R in the tests/testthat directory. Replace its entire contents by the following:
DBItest::make_context(Kazam(), NULL)
DBItest::test_all()
The notes about “Kazam” and skipping tests from the previous section apply here as well. The test_all() function simply calls all test cases.
DBItest/inst/doc/test.Rmd 0000644 0001762 0000144 00000010263 13020472540 014714 0 ustar ligges users ---
title: "Testing DBI backends"
author: "Kirill Müller"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Testing DBI backends}
%\VignetteEngine{knitr::rmarkdown}
\usepackage[utf8]{inputenc}
---
This document shows how to use the `DBItest` package when implementing a new `DBI` backend or when applying it to an existing backend. The `DBItest` package provides a large collection of automated tests.
## Testing a new backend
The test cases in the `DBItest` package are structured very similarly to the sections in the "backend" vignette:
```r
vignette("backend", package = "DBI")
```
Like the "backend" vignette, this vignette assumes that you are implementing the `RKazam` package that has a `Kazam()` function that creates a new `DBIDriver` instance for connecting to a "Kazam" database.
You can add the tests in the `DBItest` package incrementally, as you proceed with implementing the various parts of the DBI. The `DBItest` package builds upon the `testthat` package. To enable it, run the following in your package directory (after installing or updating `devtools`):
```r
devtools::use_testthat()
devtools::use_test("DBItest")
```
This creates, among others, a file `test-DBItest.R` in the `tests/testthat` directory. Replace its entire contents by the following:
```r
DBItest::make_context(Kazam(), NULL)
DBItest::test_getting_started()
```
Now test your package with `devtools::test()`. If you followed at least the "Getting started" section of the `DBI` "backend" vignette, all tests should succeed.
By adding the corresponding test function to your `tests/test-DBItest.R` file *before* implementing a section, you get immediate feedback which functionality of this section still needs to be implemented by running `devtools::test()` again. Therefore, proceed by appending the following to `tests/test-DBItest.R`, to include a test case for the forthcoming section:
```r
DBItest::test_driver()
```
Again, all tests should succeed when you are done with the "Driver" section. Add the call to the next tester function, implement the following section until all tests succeed, and so forth.
In this scenario, you are usually interested only in the first error the test suite finds. The `StopReporter` of `testthat` is most helpful here, activate it by passing `reporter = "stop"` to `devtools::test()`. Alternatively, call the relevant `DBItest::test_()` function directly.
The tests are documented with the corresponding functions: For instance, `?test_driver` shows a coarse description of all tests for the "Driver" test case. Test failures will include the name of the test that is failing; in this case, investigating the documentation or the source code of the `DBItest` package will usually lead to the cause of the error.
Not all tests can be satisfied: For example, there is one test that tests that `logical` variables survive a write-read roundtrip to the database, whereas another test tests that `logical` variables are converted to `integer` in such a case. Tests can be skipped by adding regular expressions for the tests to skip as character vector to the call, as in the following[^termnull]:
```r
DBItest::test_driver(skip = c(
"data_type" # Reason 1...
"constructor.*", # Reason 2...
NULL
))
[^termnull]: The terminating `NULL` allows appending new lines to the end by copy-pasting an existing line, without having to take care of the terminating comma.
```
Some other reasons to skip tests are:
- your database does not support a feature
- you want to postpone or avoid the implementation of a feature
- the test takes too long to run
## Testing an existing backend
For an existing backends, simply enabling all tests may be the quickest way to get started. Run the following in your package directory (after installing or updating `devtools`):
```r
devtools::use_testthat()
devtools::use_test("DBItest")
```
This creates, among others, a file `test-DBItest.R` in the `tests/testthat` directory. Replace its entire contents by the following:
```r
DBItest::make_context(Kazam(), NULL)
DBItest::test_all()
```
The notes about "Kazam" and skipping tests from the previous section apply here as well. The `test_all()` function simply calls all test cases.
DBItest/tests/ 0000755 0001762 0000144 00000000000 12731771543 012724 5 ustar ligges users DBItest/tests/testthat.R 0000644 0001762 0000144 00000000072 13017553133 014675 0 ustar ligges users library(testthat)
library(DBItest)
test_check("DBItest")
DBItest/tests/testthat/ 0000755 0001762 0000144 00000000000 13020502150 014536 5 ustar ligges users DBItest/tests/testthat/test-tweaks.R 0000644 0001762 0000144 00000000551 13017553133 017152 0 ustar ligges users context("tweaks")
test_that("multiplication works", {
expect_true(names(formals(tweaks))[[1]] == "...")
expect_warning(tweaks(`_oooops` = 42, `_darn` = -1), "_oooops, _darn")
expect_warning(tweaks(), NA)
expect_warning(tweaks(5), "named")
expect_warning(tweaks(5, `_ooops` = 42), "named")
expect_warning(tweaks(constructor_name = "constr"), NA)
})
DBItest/tests/testthat/test-context.R 0000644 0001762 0000144 00000000143 13017553133 017335 0 ustar ligges users context("context")
test_that("default context is NULL", {
expect_null(get_default_context())
})
DBItest/tests/testthat/test-lint.R 0000644 0001762 0000144 00000000474 13017553133 016626 0 ustar ligges users context("lint")
test_that("lintr is happy", {
skip_on_cran()
expect_false("package:DBI" %in% search())
require(DBI)
on.exit(detach(), add = TRUE)
expect_true("package:DBI" %in% search())
#lintr::expect_lint_free()
detach()
on.exit(NULL, add = FALSE)
expect_false("package:DBI" %in% search())
})
DBItest/NAMESPACE 0000644 0001762 0000144 00000003155 12773765672 013021 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(format,DBItest_tweaks)
S3method(print,DBItest_tweaks)
export(get_default_context)
export(make_context)
export(set_default_context)
export(test_all)
export(test_compliance)
export(test_connection)
export(test_driver)
export(test_getting_started)
export(test_meta)
export(test_result)
export(test_sql)
export(test_stress)
export(test_transaction)
export(tweaks)
import(testthat)
importFrom(DBI,dbBegin)
importFrom(DBI,dbBind)
importFrom(DBI,dbCallProc)
importFrom(DBI,dbClearResult)
importFrom(DBI,dbColumnInfo)
importFrom(DBI,dbCommit)
importFrom(DBI,dbConnect)
importFrom(DBI,dbDataType)
importFrom(DBI,dbDisconnect)
importFrom(DBI,dbDriver)
importFrom(DBI,dbExecute)
importFrom(DBI,dbExistsTable)
importFrom(DBI,dbFetch)
importFrom(DBI,dbGetDBIVersion)
importFrom(DBI,dbGetInfo)
importFrom(DBI,dbGetQuery)
importFrom(DBI,dbGetRowCount)
importFrom(DBI,dbGetRowsAffected)
importFrom(DBI,dbGetStatement)
importFrom(DBI,dbHasCompleted)
importFrom(DBI,dbIsValid)
importFrom(DBI,dbListConnections)
importFrom(DBI,dbListFields)
importFrom(DBI,dbListTables)
importFrom(DBI,dbQuoteIdentifier)
importFrom(DBI,dbQuoteString)
importFrom(DBI,dbReadTable)
importFrom(DBI,dbRemoveTable)
importFrom(DBI,dbRollback)
importFrom(DBI,dbSendQuery)
importFrom(DBI,dbSendStatement)
importFrom(DBI,dbSetDataMappings)
importFrom(DBI,dbUnloadDriver)
importFrom(DBI,dbWriteTable)
importFrom(methods,extends)
importFrom(methods,findMethod)
importFrom(methods,getClass)
importFrom(methods,getClasses)
importFrom(methods,hasMethod)
importFrom(methods,is)
importFrom(stats,setNames)
importFrom(withr,with_temp_libpaths)
DBItest/NEWS.md 0000644 0001762 0000144 00000021500 13020261000 012624 0 ustar ligges users # DBItest 1.4 (2016-12-02)
## DBI specification
- Use markdown in documentation.
- Description of parametrized queries and statements (#88).
- New hidden `DBIspec-wip` page for work-in-progress documentation.
- Get rid of "Format" and "Usage" sections, and aliases, in the specs.
## Tests
- Not testing for presence of `max.connections` element in `dbGetInfo(Driver)` (rstats-db/DBI#56).
- Test multi-row binding for queries and statements (#96).
- New `ellipsis` check that verifies that all implemented DBI methods contain `...` in their formals. This excludes `show()` and all methods defined in this or other packages.
- Refactored `bind_` tests to use the new `parameter_pattern` tweak (#95).
- Rough draft of transaction tests (#36).
- New `fetch_zero_rows` test, split from `fetch_premature_close`.
- The "compliance" test tests that the backend package exports exactly one subclass of each DBI virtual class.
- Document and enhance test for `dbDataType("DBIDriver", "ANY")` (#88).
- Minor corrections for "bind" tests.
## Internal
- Isolate stress tests from main test suite (#92).
- Refactor test specification in smaller modules, isolated from actual test execution (#81). This breaks the documentation of the tests, which will be substituted by a DBI specification in prose.
- Align description of binding with code.
- Refactor tests for `dbBind()`, test is run by `BindTester` class, and behavior is specified by members and by instances of the new `BindTesterExtra` class.
- The `skip` argument to the `test_()` functions is again evaluated with `perl = TRUE` to support negative lookaheads (#33).
- Use `dbSendStatement()` and `dbExecute()` where appropriate.
- Avoid empty subsections in Rd documentation to satisfy `R CMD check` (#81).
# DBItest 1.3 (2016-07-07)
Bug fixes
---------
- Fix `read_table` test when the backend actually returns the data in a different order.
New tests
---------
- Test `dbDataType()` on connections (#69, #75, @imanuelcostigan).
- Check returned strings for UTF-8 encoding (#72).
- Repeated `dbBind()` + `dbFetch()` on the same result set (#51).
Features
--------
- `tweaks()` gains an `...` as first argument to support future/deprecated tweaks (with a warning), and also to avoid unnamed arguments (#83).
- `testthat` now shows a more accurate location for the source of errors, failures, and skips (#78).
- Aggregate skipped tests, only one `skip()` call per test function.
- Indicate that some tests are optional in documentation (#15).
Internal
--------
- New `constructor_relax_args` tweak, currently not queried.
- The `ctx` argument is now explicit in the test functions.
- Change underscores to dashes in file names.
- Remove `testthat` compatibility hack.
- New `all_have_utf8_or_ascii_encoding()` which vectorizes `has_utf8_or_ascii_encoding()`.
- Test on AppVeyor (#73).
- Work around regression in R 3.3.0 (fix scheduled for R 3.3.1) which affected stress tests.
# DBItest 1.2 (2016-05-21)
- Infrastructure
- Support names for contexts (@hoesler, #67).
- The `skip` argument to the test functions is now treated as a Perl regular expression to allow negative lookahead. Use `skip = "(?!test_regex).*"` to choose a single test to run (#33).
- Added encoding arguments to non-ASCII string constants (#60, @hoesler).
- Improve tests
- `simultaneous_connections` test always closes all connections on exit (@hoesler, #68).
- More generic compliance check (@hoesler, #61).
- Update documentation to reflect test condition (@imanuelcostigan, #70).
- `testthat` dependency
- Import all of `testthat` to avoid `R CMD check` warnings.
- Compatibility with dev version of `testthat` (#62).
- Improve Travis builds
- Use container-based builds on Travis.
- Install `RPostgres` and `RMySQL` from `rstats-db`.
- Install `DBI` and `testthat` from GitHub.
Version 1.1 (2016-02-12)
===
- New feature: tweaks
- New argument `tweaks` to `make_context()` (#49).
- New `tweaks()`, essentially constructs a named list of tweaks but with predefined and documented argument names.
- `constructor_name`, respected by the `constructor.*` tests.
- `strict_identifier`, if `TRUE` all identifier must be syntactic names even if quoted. The quoting test is now split, and a part is ignored conditional to this tweak. The `roundtrip_quotes` tests also respects this tweak.
- `omit_blob_tests` for DBMS that don't have a BLOB data type.
- `current_needs_parens` -- some SQL dialects (e.g., BigQuery) require parentheses for the functions `current_date`, `current_time` and `current_timestamp`.
- `union`, for specifying a nonstandard way of combining queries. All union queries now name each column in each subquery (required for `bigrquery`).
- New tests
- `dbGetInfo(Result)` (rstats-db/DBI#55).
- `dbListFields()` (#26).
- New `package_name` test in `test_getting_started()`.
- Improved tests
- Stress test now installs package in temporary library (before loading `DBI`) using `R CMD INSTALL` before loading DBI (rstats-db/RSQLite#128, #48).
- Row count is now tested for equality but not identity, so that backends can return a numeric value > 2^31 at their discretion.
- Call `dbRemoveTable()` instead of issuing `DROP` requests, the latter might be unsupported.
- Use subqueries in queries that use `WHERE`.
- Test that `dbClearResult()` on a closed result set raises a warning.
- Expect a warning instead of an error for double disconnect (#50).
- Move connection test that requires `dbFetch()` to `test_result()`.
- Split `can_connect_and_disconnect` test.
- Expect `DBI` to be in `Imports`, not in `Depends`.
- Removed tests
- Remove test for `dbGetException()` (rstats-db/DBI#51).
- Bug fixes
- Fix broken tests for quoting.
- Self-testing
- Test `RPostgres`, `RMySQL`, `RSQLite` and `RKazam` as part of the Travis-CI tests (#52).
- Travis CI now installs rstats-db/DBI, updated namespace imports (`dbiCheckCompliance()`, `dbListResults()`).
- Use fork of `testthat`.
- Utilities
- Return test results as named array of logical. Requires hadley/testthat#360, gracefully degrades with the CRAN version.
- Internal
- Refactored the `get_info_()` tests to use a vector of names.
- Use versioned dependency for DBI
- Use unqualified calls to `dbBind()` again
Version 1.0 (2015-12-17)
===
- CRAN release
- Eliminate errors on win-builder
- Satisfy R CMD check
- Use LGPL-2 license
- Add RStudio as copyright holder
- Move `devtools` package from "Imports" to "Suggests"
Version 0.3 (2015-11-15)
===
- Feature-complete, ready for review
- Tests from the proposal
- Add missing methods to compliance check
- Add simple read-only test (#27)
- Add stress tests for repeated load/unload (with and without connecting) in new R session (#2),
- Migrate all tests from existing backends (#28)
- Refactor `data_` tests to use a worker function `test_select()`
- Test tables with `NA` values above and below the non-`NA` value in `data_` tests
- Test return values and error conditions for `dbBind()` and `dbClearResult()` (#31)
- Test vectorization of `dbQuoteString()` and `dbQuoteIdentifier()` (#18)
- Test that dates have `integer` as underlying data type (#9)
- Roundtrip tests sort output table to be sure (#32)
- Test `NA` to `NULL` conversion in `dbQuoteString()`, and false friends (#23)
- Enhance test for `dbQuoteIdentifier()` (#30)
- Style
- Avoid using `data.frame()` for date and time columns (#10)
- Use `expect_identical()` instead of `expect_equal()` in many places (#13)
- Catch all errors in `on.exit()` handlers via `expect_error()` (#20).
- Combine "meta" tests into new `test_meta()` (#37)
- Documentation
- New "test" vignette (#16)
- Add package documentation (#38)
- Same as 0.2-5
Version 0.2 (2015-11-11)
===
- Tests from the proposal
- SQL
- Metadata
- DBI compliance (not testing read-only yet)
- Migrate most of the tests from RMySQL
- Test improvements
- Test BLOB data type (#17)
- Check actual availability of type returned by `dbDataType()` (#19)
- Testing infrastructure
- Disambiguate test names (#21)
- Use regex matching for deciding skipped tests, skip regex must match the entire test name
- Documentation
- Document all tests in each test function using the new inline documentation feature of roxygen2
- Improve documentation for `test_all()`: Tests are listed in new "Tests" section
- Add brief instructions to README
- Move repository to rstats-db namespace
- Same as 0.1-6
Version 0.1 (2015-10-11)
===
- First GitHub release
- Builds successfully on Travis
- Testing infrastructure
- Test context
- Skipped tests call `skip()`
- Function `test_all()` that runs all tests
- Tests from the proposal
- Getting started
- Driver
- Connection
- Results
- Code formatting is checked with lintr
- Same as 0.0-5
DBItest/R/ 0000755 0001762 0000144 00000000000 13020260451 011742 5 ustar ligges users DBItest/R/spec-result.R 0000644 0001762 0000144 00000001054 13017553133 014343 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_result <- c(
spec_result_send_query,
spec_result_fetch,
spec_result_get_query,
spec_result_create_table_with_data_type,
spec_result_roundtrip
)
# Helpers -----------------------------------------------------------------
union <- function(..., .order_by = NULL, .ctx) {
if (is.null(.ctx$tweaks$union)) {
query <- paste(c(...), collapse = " UNION ")
} else {
query <- .ctx$tweaks$union(c(...))
}
if (!missing(.order_by)) {
query <- paste(query, "ORDER BY", .order_by)
}
query
}
DBItest/R/spec-result-create-table-with-data-type.R 0000644 0001762 0000144 00000004175 13017553133 021537 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Result:
#' \subsection{Create table with data type}{
spec_result_create_table_with_data_type <- list(
#' SQL Data types exist for all basic R data types, and the engine can
#' process them.
data_type_connection = function(ctx) {
with_connection({
check_connection_data_type <- function(value) {
eval(bquote({
expect_is(dbDataType(con, .(value)), "character")
expect_equal(length(dbDataType(con, .(value))), 1L)
expect_error({
as_is_type <- dbDataType(con, I(.(value)))
expect_identical(dbDataType(con, .(value)), as_is_type)
}
, NA)
expect_error({
unknown_type <- dbDataType(con, structure(.(value),
class = "unknown1"))
expect_identical(dbDataType(con, unclass(.(value))), unknown_type)
}
, NA)
query <- paste0("CREATE TABLE test (a ", dbDataType(con, .(value)),
")")
}))
eval(bquote({
expect_error(dbExecute(con, .(query)), NA)
on.exit(expect_error(dbExecute(con, "DROP TABLE test"), NA),
add = TRUE)
}))
}
expect_conn_has_data_type <- function(value) {
eval(bquote(
expect_error(check_connection_data_type(.(value)), NA)))
}
expect_conn_has_data_type(logical(1))
expect_conn_has_data_type(integer(1))
expect_conn_has_data_type(numeric(1))
expect_conn_has_data_type(character(1))
expect_conn_has_data_type(Sys.Date())
expect_conn_has_data_type(Sys.time())
if (!isTRUE(ctx$tweaks$omit_blob_tests)) {
expect_conn_has_data_type(list(raw(1)))
}
})
},
#' SQL data type for factor is the same as for character.
data_type_factor = function(ctx) {
with_connection({
expect_identical(dbDataType(con, letters),
dbDataType(con, factor(letters)))
expect_identical(dbDataType(con, letters),
dbDataType(con, ordered(letters)))
})
},
#' }
NULL
)
DBItest/R/test-connection.R 0000644 0001762 0000144 00000000704 13020260451 015202 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_connection()]:
#' Test the "Connection" class
NULL
#' Test the "Connection" class
#'
#' @inheritParams test_all
#' @include test-driver.R
#' @family tests
#' @importFrom withr with_temp_libpaths
#' @importFrom methods is
#' @export
test_connection <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Connection"
run_tests(ctx, spec_connection, skip, test_suite)
}
DBItest/R/spec-stress.R 0000644 0001762 0000144 00000000150 13017553133 014344 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_stress <- c(
spec_stress_driver,
spec_stress_connection
)
DBItest/R/utf8.R 0000644 0001762 0000144 00000001014 13017553133 012757 0 ustar ligges users text_cyrillic <- iconv(list(as.raw(
c(0xd0, 0x9a, 0xd0, 0xb8, 0xd1, 0x80, 0xd0, 0xb8, 0xd0, 0xbb, 0xd0, 0xbb))), from = "UTF-8", to = "UTF-8")
text_latin <- iconv(list(as.raw(c(0x4d, 0xc3, 0xbc, 0x6c, 0x6c, 0x65, 0x72))), from = "UTF-8", to = "UTF-8")
text_chinese <- iconv(list(as.raw(c(0xe6, 0x88, 0x91, 0xe6, 0x98, 0xaf, 0xe8,
0xb0, 0x81))), from = "UTF-8", to = "UTF-8")
text_ascii <- iconv("ASCII", to = "ASCII")
texts <- c(text_cyrillic, text_latin, text_chinese, text_ascii)
DBItest/R/spec-transaction-begin-rollback.R 0000644 0001762 0000144 00000000333 13017553133 020222 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Transactions:
#' \subsection{`dbBegin("DBIConnection")` and `dbRollback("DBIConnection")`}{
spec_transaction_begin_rollback <- list(
#' Filler
#' }
NULL
)
DBItest/R/utils.R 0000644 0001762 0000144 00000002353 13017553133 013240 0 ustar ligges users `%||%` <- function(a, b) if (is.null(a)) b else a
get_pkg <- function(ctx) {
if (!requireNamespace("devtools", quietly = TRUE)) {
skip("devtools not installed")
}
pkg_name <- package_name(ctx)
expect_is(pkg_name, "character")
pkg_path <- find.package(pkg_name)
devtools::as.package(pkg_path)
}
utils::globalVariables("con")
utils::globalVariables("con2")
# Expects a variable "ctx" in the environment env,
# evaluates the code inside local() after defining a variable "con"
# (can be overridden by specifying con argument)
# that points to a newly opened connection. Disconnects on exit.
with_connection <- function(code, con = "con", env = parent.frame()) {
code_sub <- substitute(code)
con <- as.name(con)
eval(bquote({
.(con) <- connect(ctx)
on.exit(expect_error(dbDisconnect(.(con)), NA), add = TRUE)
local(.(code_sub))
}
), envir = env)
}
get_iris <- function(ctx) {
datasets_iris <- datasets::iris
if (isTRUE(ctx$tweaks$strict_identifier)) {
names(datasets_iris) <- gsub(".", "_", names(datasets_iris), fixed = TRUE)
}
datasets_iris
}
unrowname <- function(x) {
rownames(x) <- NULL
x
}
random_table_name <- function(n = 10) {
paste0(sample(letters, n, replace = TRUE), collapse = "")
}
DBItest/R/spec-stress-driver.R 0000644 0001762 0000144 00000001671 13017553133 015646 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Driver:
#' \subsection{Repeated loading, instantiation, and unloading}{
spec_stress_driver <- list(
#' Repeated load, instantiation, and unload of package in a new R session.
stress_load_unload = function(ctx) {
skip_on_travis()
skip_on_appveyor()
skip_if_not(getRversion() != "3.3.0")
pkg <- get_pkg(ctx)
script_file <- tempfile("DBItest", fileext = ".R")
cat(
"devtools::RCMD('INSTALL', ", shQuote(pkg$path), ")\n",
"for (i in 1:50) {\n",
" ", pkg$package, "::", deparse(ctx$drv_call), "\n",
" unloadNamespace(getNamespace(\"", pkg$package, "\"))\n",
"}\n",
sep = "",
file = script_file
)
with_temp_libpaths({
expect_equal(system(paste0("R -q --vanilla -f ", shQuote(script_file)),
ignore.stdout = TRUE, ignore.stderr = TRUE),
0L)
})
},
#' }
NULL
)
DBItest/R/spec-meta-get-rows-affected.R 0000644 0001762 0000144 00000002212 13017553133 017254 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbGetRowsAffected("DBIResult")`}{
spec_meta_get_rows_affected <- list(
#' Information on affected rows is correct.
rows_affected = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbExecute(con, "DROP TABLE iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
local({
query <- paste0(
"DELETE FROM iris WHERE (",
dbQuoteIdentifier(con, "Species"),
" = ", dbQuoteString(con, "versicolor"),
")")
res <- dbSendStatement(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
ra <- dbGetRowsAffected(res)
expect_identical(ra, sum(iris$Species == "versicolor"))
})
local({
query <- "DELETE FROM iris WHERE (0 = 1)"
res <- dbSendStatement(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
ra <- dbGetRowsAffected(res)
expect_identical(ra, 0L)
})
})
},
#' }
NULL
)
DBItest/R/test-transaction.R 0000644 0001762 0000144 00000000603 13020260451 015366 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_transaction()]:
#' Test transaction functions
NULL
#' Test transaction functions
#'
#' @inheritParams test_all
#' @include test-meta.R
#' @family tests
#' @export
test_transaction <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Transactions"
run_tests(ctx, spec_transaction, skip, test_suite)
}
DBItest/R/test-getting-started.R 0000644 0001762 0000144 00000001025 13020260451 016145 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_getting_started()]:
#' Getting started with testing
NULL
#' Getting started with testing
#'
#' Tests very basic features of a DBI driver package, to support testing
#' and test-first development right from the start.
#'
#' @inheritParams test_all
#' @include test-all.R
#' @family tests
#' @export
test_getting_started <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Getting started"
run_tests(ctx, spec_getting_started, skip, test_suite)
}
DBItest/R/spec-connection-get-info.R 0000644 0001762 0000144 00000001260 13017553133 016671 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Connection:
#' \subsection{`dbGetInfo("DBIConnection")` (deprecated)}{
spec_connection_get_info <- list(
#' Return value of dbGetInfo has necessary elements
get_info_connection = function(ctx) {
con <- connect(ctx)
on.exit(expect_error(dbDisconnect(con), NA), add = TRUE)
info <- dbGetInfo(con)
expect_is(info, "list")
info_names <- names(info)
necessary_names <-
c("db.version", "dbname", "username", "host", "port")
for (name in necessary_names) {
eval(bquote(
expect_true(.(name) %in% info_names)))
}
expect_false("password" %in% info_names)
},
#' }
NULL
)
DBItest/R/spec-sql-quote-identifier.R 0000644 0001762 0000144 00000004661 13017553133 017106 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{`dbQuoteIdentifier("DBIConnection")`}{
spec_sql_quote_identifier <- list(
#' Can quote identifiers that consist of letters only.
quote_identifier = function(ctx) {
with_connection({
simple <- dbQuoteIdentifier(con, "simple")
query <- paste0("SELECT 1 as", simple)
expect_warning(rows <- dbGetQuery(con, query), NA)
expect_identical(names(rows), "simple")
expect_identical(unlist(unname(rows)), 1L)
})
},
#' Can quote identifiers with special characters, and create identifiers
#' that contain quotes and spaces.
quote_identifier_special = function(ctx) {
if (isTRUE(ctx$tweaks$strict_identifier)) {
skip("tweak: strict_identifier")
}
with_connection({
simple <- dbQuoteIdentifier(con, "simple")
with_space <- dbQuoteIdentifier(con, "with space")
with_dot <- dbQuoteIdentifier(con, "with.dot")
with_comma <- dbQuoteIdentifier(con, "with,comma")
quoted_simple <- dbQuoteIdentifier(con, as.character(simple))
quoted_with_space <- dbQuoteIdentifier(con, as.character(with_space))
quoted_with_dot <- dbQuoteIdentifier(con, as.character(with_dot))
quoted_with_comma <- dbQuoteIdentifier(con, as.character(with_comma))
query <- paste0("SELECT ",
"1 as", simple, ",",
"2 as", with_space, ",",
"3 as", with_dot, ",",
"4 as", with_comma, ",",
"5 as", quoted_simple, ",",
"6 as", quoted_with_space, ",",
"7 as", quoted_with_dot, ",",
"8 as", quoted_with_comma)
expect_warning(rows <- dbGetQuery(con, query), NA)
expect_identical(names(rows),
c("simple", "with space", "with.dot", "with,comma",
as.character(simple), as.character(with_space),
as.character(with_dot), as.character(with_comma)))
expect_identical(unlist(unname(rows)), 1:8)
})
},
#' Character vectors are treated as a single qualified identifier.
quote_identifier_not_vectorized = function(ctx) {
with_connection({
simple_out <- dbQuoteIdentifier(con, "simple")
expect_equal(length(simple_out), 1L)
letters_out <- dbQuoteIdentifier(con, letters[1:3])
expect_equal(length(letters_out), 1L)
})
},
#' }
NULL
)
DBItest/R/spec-transaction-with-transaction.R 0000644 0001762 0000144 00000000325 13017553133 020646 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Transactions:
#' \subsection{`dbWithTransaction("DBIConnection")` and `dbBreak()`}{
spec_transaction_with_transaction <- list(
#' Filler
#' }
NULL
)
DBItest/R/spec-meta-bind.R 0000644 0001762 0000144 00000020406 13020263501 014656 0 ustar ligges users run_bind_tester <- list()
#' @template dbispec-sub
#' @format NULL
#' @section Parametrized queries and statements:
#' \pkg{DBI} supports parametrized (or prepared) queries and statements
#' via the [DBI::dbBind()] generic.
#' Parametrized queries are different from normal queries
#' in that they allow an arbitrary number of placeholders,
#' which are later substituted by actual values.
#' Parametrized queries (and statements) serve two purposes:
#'
#' - The same query can be executed more than once with different values.
#' The DBMS may cache intermediate information for the query,
#' such as the execution plan,
#' and execute it faster.
#' - Separation of query syntax and parameters protects against SQL injection.
#'
#' The placeholder format is currently not specified by \pkg{DBI};
#' in the future, a uniform placeholder syntax may be supported.
#' Consult the backend documentation for the supported formats.
#' For automated testing, backend authors specify the placeholder syntax with
#' the `placeholder_pattern` tweak.
#' Known examples are:
#'
#' - `?` (positional matching in order of appearance) in \pkg{RMySQL} and \pkg{RSQLite}
#' - `$1` (positional matching by index) in \pkg{RPostgres} and \pkg{RSQLite}
#' - `:name` and `$name` (named matching) in \pkg{RSQLite}
#'
#' \pkg{DBI} clients execute parametrized statements as follows:
#'
run_bind_tester$fun <- function() {
if (extra_obj$requires_names() && is.null(names(placeholder))) {
# wrong_name test only valid for named placeholders
return()
}
# FIXME
#' 1. Call [DBI::dbSendQuery()] or [DBI::dbSendStatement()] with a query or statement
#' that contains placeholders,
#' store the returned \code{\linkS4class{DBIResult}} object in a variable.
#' Mixing placeholders (in particular, named and unnamed ones) is not
#' recommended.
if (is_query())
res <- send_query()
else
res <- send_statement()
#' It is good practice to register a call to [DBI::dbClearResult()] via
#' [on.exit()] right after calling `dbSendQuery()`, see the last
#' enumeration item.
on.exit(expect_error(dbClearResult(res), NA))
#' 1. Construct a list with parameters
#' that specify actual values for the placeholders.
bind_values <- values
#' The list must be named or unnamed,
#' depending on the kind of placeholders used.
#' Named values are matched to named parameters, unnamed values
#' are matched by position.
if (!is.null(names(placeholder))) {
names(bind_values) <- names(placeholder)
}
#' All elements in this list must have the same lengths and contain values
#' supported by the backend; a [data.frame()] is internally stored as such
#' a list.
# FIXME
#' The parameter list is passed a call to [dbBind()] on the `DBIResult`
#' object.
if (!bind(res, bind_values))
return()
#' 1. Retrieve the data or the number of affected rows from the `DBIResult` object.
retrieve <- function() {
#' - For queries issued by `dbSendQuery()`,
#' call [DBI::dbFetch()].
if (is_query()) {
rows <- dbFetch(res)
compare(rows, values)
} else {
#' - For statements issued by `dbSendStatements()`,
#' call [DBI::dbGetRowsAffected()].
#' (Execution begins immediately after the `dbBind()` call,
#' the statement is processed entirely before the function returns.
#' Calls to `dbFetch()` are ignored.)
rows_affected <- dbGetRowsAffected(res)
compare_affected(rows_affected, values)
}
}
retrieve()
#' 1. Repeat 2. and 3. as necessary.
if (extra_obj$is_repeated()) {
bind(res, bind_values)
retrieve()
}
#' 1. Close the result set via [DBI::dbClearResult()].
}
#' @template dbispec-sub-wip
#' @format NULL
#' @section Parametrised queries and statements:
#' \subsection{`dbBind("DBIResult")`}{
spec_meta_bind <- list(
#' Empty binding with check of
#' return value.
bind_empty = function(ctx) {
with_connection({
res <- dbSendQuery(con, "SELECT 1")
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
bind_res <- withVisible(dbBind(res, list()))
expect_false(bind_res$visible)
expect_identical(res, bind_res$value)
})
},
#' Binding of integer values raises an
#' error if connection is closed.
bind_error = function(ctx) {
con <- connect(ctx)
dbDisconnect(con)
expect_error(test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L))
},
#' Binding of integer values with check of
#' return value.
bind_return_value = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L, extra = "return_value")
})
},
#' Binding of integer values with too many
#' values.
bind_too_many = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L, extra = "too_many")
})
},
#' Binding of integer values with too few
#' values.
bind_not_enough = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L, extra = "not_enough")
})
},
#' Binding of integer values, repeated.
bind_repeated = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L, extra = "repeated")
})
},
#' Binding of integer values with wrong names.
bind_wrong_name = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L, extra = "wrong_name")
})
},
#' Binding of integer values.
bind_integer = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1L)
})
},
#' Binding of numeric values.
bind_numeric = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, 1.5)
})
},
#' Binding of logical values.
bind_logical = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, TRUE)
})
},
#' Binding of logical values (coerced to integer).
bind_logical_int = function(ctx) {
with_connection({
test_select_bind(
con, ctx$tweaks$placeholder_pattern, TRUE,
transform_input = function(x) as.character(as.integer(x)))
})
},
#' Binding of `NULL` values.
bind_null = function(ctx) {
with_connection({
test_select_bind(
con, ctx$tweaks$placeholder_pattern, NA,
transform_input = function(x) TRUE,
transform_output = is.na)
})
},
#' Binding of character values.
bind_character = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, texts)
})
},
#' Binding of date values.
bind_date = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, Sys.Date())
})
},
#' Binding of [POSIXct] timestamp values.
bind_timestamp = function(ctx) {
with_connection({
data_in <- as.POSIXct(round(Sys.time()))
test_select_bind(
con, ctx$tweaks$placeholder_pattern, data_in,
type = dbDataType(con, data_in),
transform_input = identity,
transform_output = identity,
expect = expect_equal)
})
},
#' Binding of [POSIXlt] timestamp values.
bind_timestamp_lt = function(ctx) {
with_connection({
data_in <- as.POSIXlt(round(Sys.time()))
test_select_bind(
con, ctx$tweaks$placeholder_pattern, data_in,
type = dbDataType(con, data_in),
transform_input = as.POSIXct,
transform_output = identity)
})
},
#' Binding of raw values.
bind_raw = function(ctx) {
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
skip("tweak: omit_blob_tests")
}
with_connection({
test_select_bind(
con, ctx$tweaks$placeholder_pattern, list(list(as.raw(1:10))),
type = NULL,
transform_input = identity,
transform_output = identity)
})
},
#' Binding of statements.
bind_statement = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1), query = FALSE)
})
},
#' Repeated binding of statements.
bind_statement_repeated = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1), query = FALSE, extra = "repeated")
})
},
#' }
NULL
)
DBItest/R/spec-connection-connect.R 0000644 0001762 0000144 00000001173 13017553133 016615 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Connection:
#' \subsection{Construction: `dbConnect("DBIDriver")` and `dbDisconnect("DBIConnection", "ANY")`}{
spec_connection_connect <- list(
#' Can connect and disconnect, connection object inherits from
#' "DBIConnection".
can_connect_and_disconnect = function(ctx) {
con <- connect(ctx)
expect_s4_class(con, "DBIConnection")
expect_true(dbDisconnect(con))
},
#' Repeated disconnect throws warning.
cannot_disconnect_twice = function(ctx) {
con <- connect(ctx)
dbDisconnect(con)
expect_warning(dbDisconnect(con))
},
#' }
NULL
)
DBItest/R/import-dbi.R 0000644 0001762 0000144 00000001277 13017553133 014152 0 ustar ligges users # The imports below were generated using the following call:
# @import.gen::importFrom("DBI")
#' @importFrom DBI dbBegin dbBind dbCallProc dbClearResult dbColumnInfo
#' @importFrom DBI dbCommit dbConnect dbDataType dbDisconnect dbDriver
#' @importFrom DBI dbExecute dbExistsTable dbFetch dbGetDBIVersion
#' @importFrom DBI dbGetInfo dbGetQuery dbGetRowCount dbGetRowsAffected
#' @importFrom DBI dbGetStatement dbHasCompleted dbIsValid
#' @importFrom DBI dbListConnections dbListFields dbListTables
#' @importFrom DBI dbQuoteIdentifier dbQuoteString dbReadTable dbRemoveTable
#' @importFrom DBI dbRollback dbSendQuery dbSendStatement dbSetDataMappings
#' @importFrom DBI dbUnloadDriver dbWriteTable
NULL
DBItest/R/spec-meta.R 0000644 0001762 0000144 00000000613 13017553133 013753 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_meta <- c(
spec_meta_is_valid_connection,
spec_meta_is_valid_result,
spec_meta_get_statement,
spec_meta_column_info,
spec_meta_get_row_count,
spec_meta_get_rows_affected,
spec_meta_get_info_result,
spec_meta_bind,
spec_meta_bind_multi_row,
# dbHasCompleted tested in test_result
# no 64-bit or time input data type yet
NULL
)
DBItest/R/spec-connection.R 0000644 0001762 0000144 00000000220 13017553133 015156 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_connection <- c(
spec_connection_connect,
spec_connection_data_type,
spec_connection_get_info
)
DBItest/R/spec-transaction.R 0000644 0001762 0000144 00000000257 13017553133 015356 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_transaction <- c(
spec_transaction_begin_commit,
spec_transaction_begin_rollback,
spec_transaction_with_transaction,
NULL
)
DBItest/R/spec-meta-get-info-result.R 0000644 0001762 0000144 00000001205 13017553133 016773 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbGetInfo("DBIResult")` (deprecated)}{
spec_meta_get_info_result <- list(
#' Return value of dbGetInfo has necessary elements
get_info_result = function(ctx) {
with_connection({
res <- dbSendQuery(con, "SELECT 1 as a")
info <- dbGetInfo(res)
expect_is(info, "list")
info_names <- names(info)
necessary_names <-
c("statement", "row.count", "rows.affected", "has.completed")
for (name in necessary_names) {
eval(bquote(
expect_true(.(name) %in% info_names)))
}
})
},
#' }
NULL
)
DBItest/R/test-driver.R 0000644 0001762 0000144 00000000633 13020260451 014337 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_driver()]:
#' Test the "Driver" class
NULL
#' Test the "Driver" class
#'
#' @inheritParams test_all
#' @include test-getting-started.R
#' @family tests
#' @importFrom withr with_temp_libpaths
#' @export
test_driver <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Driver"
run_tests(ctx, spec_driver, skip, test_suite)
}
DBItest/R/spec-sql-read-write-table.R 0000644 0001762 0000144 00000010117 13017553133 016752 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{`dbReadTable("DBIConnection")` and `dbWriteTable("DBIConnection")`}{
spec_sql_read_write_table <- list(
#' Can write the [datasets::iris] data as a table to the
#' database, but won't overwrite by default.
write_table = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
expect_error(dbWriteTable(con, "iris", iris))
with_connection({
expect_error(dbGetQuery(con2, "SELECT * FROM iris"), NA)
}
, con = "con2")
})
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
})
},
#' Can read the [datasets::iris] data from a database table.
read_table = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris_in <- get_iris(ctx)
iris_in$Species <- as.character(iris_in$Species)
order_in <- do.call(order, iris_in)
dbWriteTable(con, "iris", iris_in)
iris_out <- dbReadTable(con, "iris")
order_out <- do.call(order, iris_out)
expect_identical(unrowname(iris_in[order_in, ]), unrowname(iris_out[order_out, ]))
})
},
#' Can write the [datasets::iris] data as a table to the
#' database, will overwrite if asked.
overwrite_table = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
expect_error(dbWriteTable(con, "iris", iris[1:10,], overwrite = TRUE),
NA)
iris_out <- dbReadTable(con, "iris")
expect_identical(nrow(iris_out), 10L)
})
},
#' Can write the [datasets::iris] data as a table to the
#' database, will append if asked.
append_table = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
expect_error(dbWriteTable(con, "iris", iris[1:10,], append = TRUE), NA)
iris_out <- dbReadTable(con, "iris")
expect_identical(nrow(iris_out), nrow(iris) + 10L)
})
},
#' Cannot append to nonexisting table.
append_table_error = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
on.exit(expect_error(dbRemoveTable(con, "iris")))
iris <- get_iris(ctx)
expect_error(dbWriteTable(con, "iris", iris[1:20,], append = TRUE))
})
},
#' Can write the [datasets::iris] data as a temporary table to
#' the database, the table is not available in a second connection and is
#' gone after reconnecting.
temporary_table = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris[1:30, ], temporary = TRUE)
iris_out <- dbReadTable(con, "iris")
expect_identical(nrow(iris_out), 30L)
with_connection({
expect_error(dbGetQuery(con2, "SELECT * FROM iris"))
}
, con = "con2")
})
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
try(dbRemoveTable(con, "iris"), silent = TRUE)
})
},
#' A new table is visible in a second connection.
table_visible_in_other_connection = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * from test"))
on.exit(expect_error(dbRemoveTable(con, "test"), NA),
add = TRUE)
data <- data.frame(a = 1L)
dbWriteTable(con, "test", data)
with_connection({
expect_error(rows <- dbGetQuery(con2, "SELECT * FROM test"), NA)
expect_identical(rows, data)
}
, con = "con2")
})
},
#' }
NULL
)
DBItest/R/spec-meta-is-valid-connection.R 0000644 0001762 0000144 00000000572 13017553133 017622 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbIsValid("DBIConnection")`}{
spec_meta_is_valid_connection <- list(
#' Only an open connection is valid.
is_valid_connection = function(ctx) {
con <- connect(ctx)
expect_true(dbIsValid(con))
expect_error(dbDisconnect(con), NA)
expect_false(dbIsValid(con))
},
#' }
NULL
)
DBItest/R/spec-meta-get-statement.R 0000644 0001762 0000144 00000000771 13017553133 016537 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbGetStatement("DBIResult")`}{
spec_meta_get_statement <- list(
#' SQL query can be retrieved from the result.
get_statement = function(ctx) {
with_connection({
query <- "SELECT 1 as a"
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
s <- dbGetStatement(res)
expect_is(s, "character")
expect_identical(s, query)
})
},
#' }
NULL
)
DBItest/R/spec-meta-get-row-count.R 0000644 0001762 0000144 00000002433 13017553133 016465 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbGetRowCount("DBIResult")`}{
spec_meta_get_row_count <- list(
#' Row count information is correct.
row_count = function(ctx) {
with_connection({
query <- "SELECT 1 as a"
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
rc <- dbGetRowCount(res)
expect_equal(rc, 0L)
dbFetch(res)
rc <- dbGetRowCount(res)
expect_equal(rc, 1L)
})
with_connection({
query <- union(.ctx = ctx, "SELECT 1 as a", "SELECT 2", "SELECT 3")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
rc <- dbGetRowCount(res)
expect_equal(rc, 0L)
dbFetch(res, 2L)
rc <- dbGetRowCount(res)
expect_equal(rc, 2L)
dbFetch(res)
rc <- dbGetRowCount(res)
expect_equal(rc, 3L)
})
with_connection({
query <- union(
.ctx = ctx, "SELECT * FROM (SELECT 1 as a) a WHERE (0 = 1)")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
rc <- dbGetRowCount(res)
expect_equal(rc, 0L)
dbFetch(res)
rc <- dbGetRowCount(res)
expect_equal(rc, 0L)
})
},
#' }
NULL
)
DBItest/R/spec-result-get-query.R 0000644 0001762 0000144 00000004440 13017553133 016265 0 ustar ligges users # TODO: Decide where to put this, it's a connection method but requires result methods to be implemented
#' @template dbispec-sub-wip
#' @format NULL
#' @section Result:
#' \subsection{`dbGetQuery("DBIConnection", "ANY")`}{
spec_result_get_query <- list(
#' Single-value queries can be read with dbGetQuery
get_query_single = function(ctx) {
with_connection({
query <- "SELECT 1 as a"
rows <- dbGetQuery(con, query)
expect_identical(rows, data.frame(a=1L))
})
},
#' Multi-row single-column queries can be read with dbGetQuery.
get_query_multi_row_single_column = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:3, "AS a"), .order_by = "a")
rows <- dbGetQuery(con, query)
expect_identical(rows, data.frame(a=1L:3L))
})
},
#' Empty single-column queries can be read with
#' [DBI::dbGetQuery()]. Not all SQL dialects support the query
#' used here.
get_query_empty_single_column = function(ctx) {
with_connection({
query <- "SELECT * FROM (SELECT 1 as a) AS x WHERE (1 = 0)"
rows <- dbGetQuery(con, query)
expect_identical(names(rows), "a")
expect_identical(dim(rows), c(0L, 1L))
})
},
#' Single-row multi-column queries can be read with dbGetQuery.
get_query_single_row_multi_column = function(ctx) {
with_connection({
query <- "SELECT 1 as a, 2 as b, 3 as c"
rows <- dbGetQuery(con, query)
expect_identical(rows, data.frame(a=1L, b=2L, c=3L))
})
},
#' Multi-row multi-column queries can be read with dbGetQuery.
get_query_multi = function(ctx) {
with_connection({
query <- union(.ctx = ctx, paste("SELECT", 1:2, "AS a,", 2:3, "AS b"),
.order_by = "a")
rows <- dbGetQuery(con, query)
expect_identical(rows, data.frame(a=1L:2L, b=2L:3L))
})
},
#' Empty multi-column queries can be read with
#' [DBI::dbGetQuery()]. Not all SQL dialects support the query
#' used here.
get_query_empty_multi_column = function(ctx) {
with_connection({
query <-
"SELECT * FROM (SELECT 1 as a, 2 as b, 3 as c) AS x WHERE (1 = 0)"
rows <- dbGetQuery(con, query)
expect_identical(names(rows), letters[1:3])
expect_identical(dim(rows), c(0L, 3L))
})
},
#' }
NULL
)
DBItest/R/spec-meta-is-valid-result.R 0000644 0001762 0000144 00000000763 13017553133 017003 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbIsValid("DBIResult")`}{
spec_meta_is_valid_result <- list(
#' Only an open result set is valid.
is_valid_result = function(ctx) {
with_connection({
query <- "SELECT 1 as a"
res <- dbSendQuery(con, query)
expect_true(dbIsValid(res))
expect_error(dbFetch(res), NA)
expect_true(dbIsValid(res))
dbClearResult(res)
expect_false(dbIsValid(res))
})
},
#' }
NULL
)
DBItest/R/spec-sql.R 0000644 0001762 0000144 00000000331 13017553133 013621 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_sql <- c(
spec_sql_quote_string,
spec_sql_quote_identifier,
spec_sql_read_write_table,
spec_sql_read_write_roundtrip,
spec_sql_list_tables,
spec_sql_list_fields
)
DBItest/R/spec-result-send-query.R 0000644 0001762 0000144 00000004667 13017553133 016452 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Result:
#' \subsection{Construction: `dbSendQuery("DBIConnection")` and `dbClearResult("DBIResult")`}{
spec_result_send_query <- list(
#' Can issue trivial query, result object inherits from "DBIResult".
trivial_query = function(ctx) {
with_connection({
res <- dbSendQuery(con, "SELECT 1")
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_s4_class(res, "DBIResult")
})
},
#' Return value, currently tests that the return value is always
#' `TRUE`, and that an attempt to close a closed result set issues a
#' warning.
clear_result_return = function(ctx) {
with_connection({
res <- dbSendQuery(con, "SELECT 1")
expect_true(dbClearResult(res))
expect_warning(expect_true(dbClearResult(res)))
})
},
#' Leaving a result open when closing a connection gives a warning.
stale_result_warning = function(ctx) {
with_connection({
expect_warning(dbClearResult(dbSendQuery(con, "SELECT 1")), NA)
expect_warning(dbClearResult(dbSendQuery(con, "SELECT 2")), NA)
})
expect_warning(
with_connection(dbSendQuery(con, "SELECT 1"))
)
with_connection({
expect_warning(res1 <- dbSendQuery(con, "SELECT 1"), NA)
expect_true(dbIsValid(res1))
expect_warning(res2 <- dbSendQuery(con, "SELECT 2"))
expect_true(dbIsValid(res2))
expect_false(dbIsValid(res1))
dbClearResult(res2)
})
},
#' Can issue a command query that creates a table, inserts a row, and
#' deletes it; the result sets for these query always have "completed"
#' status.
command_query = function(ctx) {
with_connection({
on.exit({
res <- dbSendStatement(con, "DROP TABLE test")
expect_true(dbHasCompleted(res))
expect_error(dbClearResult(res), NA)
}
, add = TRUE)
res <- dbSendStatement(con, "CREATE TABLE test (a integer)")
expect_true(dbHasCompleted(res))
expect_error(dbClearResult(res), NA)
res <- dbSendStatement(con, "INSERT INTO test SELECT 1")
expect_true(dbHasCompleted(res))
expect_error(dbClearResult(res), NA)
})
},
#' Issuing an invalid query throws error (but no warnings, e.g. related to
#' pending results, are thrown).
invalid_query = function(ctx) {
expect_warning(
with_connection({
expect_error(dbSendStatement(con, "RAISE"))
}),
NA
)
},
#' }
NULL
)
DBItest/R/spec-transaction-begin-commit.R 0000644 0001762 0000144 00000006003 13017553133 017721 0 ustar ligges users #' @template dbispec-sub
#' @format NULL
#' @section Transactions:
#' \subsection{`dbBegin("DBIConnection")` and `dbCommit("DBIConnection")`}{
spec_transaction_begin_commit <- list(
#' Transactions are available in DBI, but actual support may vary between backends.
begin_commit = function(ctx) {
with_connection({
#' A transaction is initiated by a call to [DBI::dbBegin()]
dbBegin(con)
on.exit(dbRollback(con), add = FALSE)
#' and committed by a call to [DBI::dbCommit()].
expect_error({dbCommit(con); on.exit(NULL, add = FALSE)}, NA)
})
},
begin_commit_return_value = function(ctx) {
with_connection({
#' Both generics expect an object of class \code{\linkS4class{DBIConnection}}
#' and return `TRUE` (invisibly) upon success.
expect_invisible_true(dbBegin(con))
on.exit(dbRollback(con), add = FALSE)
expect_invisible_true(dbCommit(con))
on.exit(NULL, add = FALSE)
})
},
#'
#' The implementations are expected to raise an error in case of failure,
#' but this is difficult to test in an automated way.
begin_commit_closed = function(ctx) {
con <- connect(ctx)
dbDisconnect(con)
#' In any way, both generics should throw an error with a closed connection.
expect_error(dbBegin(con))
expect_error(dbCommit(con))
},
commit_without_begin = function(ctx) {
#' In addition, a call to [DBI::dbCommit()] without
#' a call to [DBI::dbBegin()] should raise an error.
with_connection({
expect_error(dbCommit(con))
})
},
begin_begin = function(ctx) {
#' Nested transactions are not supported by DBI,
with_connection({
#' an attempt to call [DBI::dbBegin()] twice
dbBegin(con)
on.exit(dbRollback(con), add = FALSE)
#' should yield an error.
expect_error(dbBegin(con))
dbCommit(con)
on.exit(NULL, add = FALSE)
})
},
#'
#' Data written in a transaction must persist after the transaction is committed.
begin_write_commit = function(ctx) {
with_connection({
#' For example, a table that is missing when the transaction is started
expect_false(dbExistsTable(con, "test"))
dbBegin(con)
on.exit(dbRollback(con), add = FALSE)
#' but is created
dbExecute(con, paste0("CREATE TABLE test (a ", dbDataType(con, 0L), ")"))
#' and populated during the transaction
dbExecute(con, paste0("INSERT INTO test (a) VALUES (1)"))
#' must exist and contain the data added there
expect_equal(dbReadTable(con, "test"), data.frame(a = 1))
#' both during
dbCommit(con)
on.exit(dbRemoveTable(con, "test"), add = FALSE)
#' and after the transaction.
expect_equal(dbReadTable(con, "test"), data.frame(a = 1))
})
},
#'
#' The behavior is not specified if other arguments are passed to these
#' functions. In particular, \pkg{RSQLite} issues named transactions
#' if the `name` argument is set.
#'
#' The transaction isolation level is not specified by DBI.
#'
#' }
NULL
)
DBItest/R/spec-sql-read-write-roundtrip.R 0000644 0001762 0000144 00000017031 13017553133 017713 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{Roundtrip tests}{
spec_sql_read_write_roundtrip <- list(
#' Can create tables with keywords as table and column names.
roundtrip_keywords = function(ctx) {
with_connection({
tbl_in <- data.frame(SELECT = "UNIQUE", FROM = "JOIN", WHERE = "ORDER",
stringsAsFactors = FALSE)
on.exit(expect_error(dbRemoveTable(con, "EXISTS"), NA), add = TRUE)
dbWriteTable(con, "EXISTS", tbl_in)
tbl_out <- dbReadTable(con, "EXISTS")
expect_identical(tbl_in, tbl_out)
})
},
#' Can create tables with quotes, commas, and spaces in column names and
#' data.
roundtrip_quotes = function(ctx) {
with_connection({
tbl_in <- data.frame(a = as.character(dbQuoteString(con, "")),
b = as.character(dbQuoteIdentifier(con, "")),
c = "with space",
d = ",",
stringsAsFactors = FALSE)
if (!isTRUE(ctx$tweaks$strict_identifier)) {
names(tbl_in) <- c(
as.character(dbQuoteIdentifier(con, "")),
as.character(dbQuoteString(con, "")),
"with space",
",")
}
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out)
})
},
#' Can create tables with integer columns.
roundtrip_integer = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(1:5, NA), id = 1:6)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with numeric columns.
roundtrip_numeric = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(seq(1, 3, by = 0.5), NA), id = 1:6)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with numeric columns that contain special values such
#' as `Inf` and `NaN`.
roundtrip_numeric_special = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(seq(1, 3, by = 0.5), NA, -Inf, Inf, NaN),
id = 1:9)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_equal(tbl_in$a, tbl_out$a[order(tbl_out$id)])
})
},
#' Can create tables with logical columns.
roundtrip_logical = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(TRUE, FALSE, NA), id = 1:3)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with logical columns, returned as integer.
roundtrip_logical_int = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(TRUE, FALSE, NA), id = 1:3)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(as.integer(tbl_in$a), tbl_out$a[order(tbl_out$id)])
})
},
#' Can create tables with NULL values.
roundtrip_null = function(ctx) {
with_connection({
tbl_in <- data.frame(a = NA)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_true(is.na(tbl_out$a))
})
},
#' Can create tables with 64-bit columns.
roundtrip_64_bit = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(-1e14, 1e15, 0.25, NA), id = 1:4)
tbl_in_trunc <- data.frame(a = trunc(tbl_in$a))
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in, field.types = "bigint")
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in_trunc, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with character columns.
roundtrip_character = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(text_cyrillic, text_latin,
text_chinese, text_ascii, NA),
id = 1:5, stringsAsFactors = FALSE)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
expect_true(all_have_utf8_or_ascii_encoding(tbl_out$a))
})
},
#' Can create tables with factor columns.
roundtrip_factor = function(ctx) {
with_connection({
tbl_in <- data.frame(a = factor(c(text_cyrillic, text_latin,
text_chinese, text_ascii, NA)),
id = 1:5, stringsAsFactors = FALSE)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(as.character(tbl_in$a), tbl_out$a[order(tbl_out$id)])
expect_true(all_have_utf8_or_ascii_encoding(tbl_out$a))
})
},
#' Can create tables with raw columns.
roundtrip_raw = function(ctx) {
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
skip("tweak: omit_blob_tests")
}
with_connection({
tbl_in <- list(a = list(as.raw(1:10), NA), id = 1:2)
tbl_in <- structure(tbl_in, class = "data.frame",
row.names = c(NA, -2L))
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with date columns.
roundtrip_date = function(ctx) {
with_connection({
tbl_in <- data.frame(id = 1:6)
tbl_in$a <- c(Sys.Date() + 1:5, NA)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_equal(tbl_in, tbl_out[order(tbl_out$id), ])
expect_is(unclass(tbl_out$a), "integer")
})
},
#' Can create tables with timestamp columns.
roundtrip_timestamp = function(ctx) {
with_connection({
tbl_in <- data.frame(id = 1:5)
tbl_in$a <- round(Sys.time()) + c(1, 60, 3600, 86400, NA)
tbl_in$b <- as.POSIXlt(tbl_in$a, tz = "GMT")
tbl_in$c <- as.POSIXlt(tbl_in$a, tz = "PST")
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(tbl_in, tbl_out[order(tbl_out$id), ])
})
},
#' Can create tables with row names.
roundtrip_rownames = function(ctx) {
with_connection({
tbl_in <- data.frame(a = c(1:5, NA),
row.names = paste0(LETTERS[1:6], 1:6),
id = 1:6)
on.exit(expect_error(dbRemoveTable(con, "test"), NA), add = TRUE)
dbWriteTable(con, "test", tbl_in)
tbl_out <- dbReadTable(con, "test")
expect_identical(rownames(tbl_in), rownames(tbl_out)[order(tbl_out$id)])
})
},
#' }
NULL
)
DBItest/R/spec-driver-get-info.R 0000644 0001762 0000144 00000001021 13020260451 016010 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Driver:
#' \subsection{`dbGetInfo("DBIDriver")` (deprecated)}{
spec_driver_get_info <- list(
#' Return value of dbGetInfo has necessary elements.
get_info_driver = function(ctx) {
info <- dbGetInfo(ctx$drv)
expect_is(info, "list")
info_names <- names(info)
necessary_names <-
c("driver.version", "client.version")
for (name in necessary_names) {
eval(bquote(
expect_true(.(name) %in% info_names)))
}
},
#' }
NULL
)
DBItest/R/spec-driver-data-type.R 0000644 0001762 0000144 00000004274 13017553133 016215 0 ustar ligges users #' @template dbispec-sub
#' @format NULL
#' @section Driver:
#' \subsection{`dbDataType("DBIDriver", "ANY")`}{
spec_driver_data_type <- list(
#' The backend can override the [DBI::dbDataType()] generic
#' for its driver class.
data_type_driver = function(ctx) {
#' This generic expects an arbitrary object as second argument
#' and returns a corresponding SQL type
check_driver_data_type <- function(value) {
eval(bquote({
#' as atomic
expect_equal(length(dbDataType(ctx$drv, .(value))), 1L)
#' character value
expect_is(dbDataType(ctx$drv, .(value)), "character")
#' with at least one character.
expect_match(dbDataType(ctx$drv, .(value)), ".")
#' As-is objects (i.e., wrapped by [base::I()]) must be
#' supported and return the same results as their unwrapped counterparts.
expect_identical(dbDataType(ctx$drv, I(.(value))),
dbDataType(ctx$drv, .(value)))
}))
}
#'
#' To query the values returned by the default implementation,
#' run `example(dbDataType, package = "DBI")`.
#' If the backend needs to override this generic,
#' it must accept all basic R data types as its second argument, namely
expect_driver_has_data_type <- function(value) {
eval(bquote(
expect_error(check_driver_data_type(.(value)), NA)))
}
#' [base::logical()],
expect_driver_has_data_type(logical(1))
#' [base::integer()],
expect_driver_has_data_type(integer(1))
#' [base::numeric()],
expect_driver_has_data_type(numeric(1))
#' [base::character()],
expect_driver_has_data_type(character(1))
#' dates (see [base::Dates()]),
expect_driver_has_data_type(Sys.Date())
#' date-time (see [base::DateTimeClasses()]),
expect_driver_has_data_type(Sys.time())
#' and [base::difftime()].
expect_driver_has_data_type(Sys.time() - Sys.time())
#' It also must accept lists of `raw` vectors
#' and map them to the BLOB (binary large object) data type.
if (!isTRUE(ctx$tweaks$omit_blob_tests)) {
expect_driver_has_data_type(list(raw(1)))
}
#' The behavior for other object types is not specified.
},
#' }
NULL
)
DBItest/R/spec-driver.R 0000644 0001762 0000144 00000000231 13017553133 014314 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_driver <- c(
spec_driver_class,
spec_driver_constructor,
spec_driver_data_type,
spec_driver_get_info
)
DBItest/R/spec-meta-bind-multi-row.R 0000644 0001762 0000144 00000004141 13020260451 016612 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Parametrised queries and statements:
#' \subsection{`dbBind("DBIResult")`}{
spec_meta_bind_multi_row <- list(
#' Binding of multi-row integer values.
bind_multi_row = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3))
})
},
#' Binding of multi-row integer values with zero rows.
bind_multi_row_zero_length = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(integer(), integer()))
})
},
#' Binding of multi-row integer values with unequal length.
bind_multi_row_unequal_length = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3, 2:4), extra = "unequal_length")
})
},
#' Binding of multi-row statements.
bind_multi_row_statement = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3), query = FALSE)
})
},
#' }
NULL
)
#' @noRd
#' @details
list(
#' Binding of multi-row integer values with group column.
bind_multi_row_group_column = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3), extra = "group_column")
})
},
#' Binding of multi-row integer values with group column and zero rows.
bind_multi_row_group_column_zero_length = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(integer(), integer()), extra = "group_column")
})
},
#' Binding of multi-row integer values, groupwise fetching.
bind_multi_row_groupwise_fetch = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3), extra = "groupwise_fetch")
})
},
#' Binding of multi-row integer values, groupwise fetching, with group column.
bind_multi_row_group_column_groupwise_fetch = function(ctx) {
with_connection({
test_select_bind(con, ctx$tweaks$placeholder_pattern, list(1:3), extra = c("group_column", "groupwise_fetch"))
})
},
NULL
)
DBItest/R/spec-result-fetch.R 0000644 0001762 0000144 00000010627 13017553133 015440 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Result:
#' \subsection{`dbFetch("DBIResult")` and `dbHasCompleted("DBIResult")`}{
spec_result_fetch <- list(
#' Single-value queries can be fetched.
fetch_single = function(ctx) {
with_connection({
query <- "SELECT 1 as a"
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_false(dbHasCompleted(res))
rows <- dbFetch(res)
expect_identical(rows, data.frame(a=1L))
expect_true(dbHasCompleted(res))
})
},
#' Multi-row single-column queries can be fetched.
fetch_multi_row_single_column = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:3, "AS a"), .order_by = "a")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_false(dbHasCompleted(res))
rows <- dbFetch(res)
expect_identical(rows, data.frame(a=1L:3L))
expect_true(dbHasCompleted(res))
})
},
#' Multi-row queries can be fetched progressively.
fetch_progressive = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:25, "AS a"), .order_by = "a")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_false(dbHasCompleted(res))
rows <- dbFetch(res, 10)
expect_identical(rows, data.frame(a=1L:10L))
expect_false(dbHasCompleted(res))
rows <- dbFetch(res, 10)
expect_identical(rows, data.frame(a=11L:20L))
expect_false(dbHasCompleted(res))
rows <- dbFetch(res, 10)
expect_identical(rows, data.frame(a=21L:25L))
expect_true(dbHasCompleted(res))
})
},
#' If more rows than available are fetched, the result is returned in full
#' but no warning is issued.
fetch_more_rows = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:3, "AS a"), .order_by = "a")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_false(dbHasCompleted(res))
expect_warning(rows <- dbFetch(res, 5L), NA)
expect_identical(rows, data.frame(a=1L:3L))
expect_true(dbHasCompleted(res))
})
},
#' If zero rows are fetched, the result is still fully typed.
fetch_zero_rows = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:3, "AS a"), .order_by = "a")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_warning(rows <- dbFetch(res, 0L), NA)
expect_identical(rows, data.frame(a=integer()))
expect_warning(dbClearResult(res), NA)
on.exit(NULL, add = FALSE)
})
},
#' If less rows than available are fetched, the result is returned in full
#' but no warning is issued.
fetch_premature_close = function(ctx) {
with_connection({
query <- union(
.ctx = ctx, paste("SELECT", 1:3, "AS a"), .order_by = "a")
res <- dbSendQuery(con, query)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
expect_warning(rows <- dbFetch(res, 2L), NA)
expect_identical(rows, data.frame(a=1L:2L))
expect_warning(dbClearResult(res), NA)
on.exit(NULL, add = FALSE)
})
},
#' Side-effect-only queries (without return value) can be fetched.
fetch_no_return_value = function(ctx) {
with_connection({
query <- "CREATE TABLE test (a integer)"
res <- dbSendStatement(con, query)
on.exit({
expect_error(dbClearResult(res), NA)
expect_error(dbClearResult(dbSendStatement(con, "DROP TABLE test")), NA)
}
, add = TRUE)
expect_true(dbHasCompleted(res))
rows <- dbFetch(res)
expect_identical(rows, data.frame())
expect_true(dbHasCompleted(res))
})
},
#' Fetching from a closed result set raises an error.
fetch_closed = function(ctx) {
with_connection({
query <- "SELECT 1"
res <- dbSendQuery(con, query)
dbClearResult(res)
expect_error(dbHasCompleted(res))
expect_error(dbFetch(res))
})
},
#' Querying a disconnected connection throws error.
cannot_query_disconnected = function(ctx) {
# TODO: Rename to fetch_disconnected
con <- connect(ctx)
dbDisconnect(con)
expect_error(dbGetQuery(con, "SELECT 1"))
},
#' }
NULL
)
DBItest/R/spec-sql-list-fields.R 0000644 0001762 0000144 00000001006 13017553133 016036 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{`dbListFields("DBIConnection")`}{
spec_sql_list_fields <- list(
#' Can list the fields for a table in the database.
list_fields = function(ctx) {
with_connection({
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
fields <- dbListFields(con, "iris")
expect_identical(fields, names(iris))
})
},
#' }
NULL
)
DBItest/R/run.R 0000644 0001762 0000144 00000002372 13017553133 012705 0 ustar ligges users run_tests <- function(ctx, tests, skip, test_suite) {
if (is.null(ctx)) {
stop("Need to call make_context() to use the test_...() functions.", call. = FALSE)
}
if (!inherits(ctx, "DBItest_context")) {
stop("ctx must be a DBItest_context object created by make_context().", call. = FALSE)
}
test_context <- paste0(
"DBItest", if(!is.null(ctx$name)) paste0("[", ctx$name, "]"),
": ", test_suite)
context(test_context)
tests <- tests[!vapply(tests, is.null, logical(1L))]
skip_rx <- paste0(paste0("(?:^", skip, "$)"), collapse = "|")
skip_flag <- grepl(skip_rx, names(tests), perl = TRUE)
ok <- vapply(seq_along(tests), function(test_idx) {
test_name <- names(tests)[[test_idx]]
if (skip_flag[[test_idx]])
FALSE
else {
test_fun <- patch_test_fun(tests[[test_name]], paste0(test_context, ": ", test_name))
test_fun(ctx)
}
},
logical(1L))
if (any(skip_flag)) {
test_that(paste0(test_context, ": skipped tests"), {
skip(paste0("by request: ", paste(names(tests)[skip_flag], collapse = ", ")))
})
}
ok
}
patch_test_fun <- function(test_fun, desc) {
body_of_test_fun <- body(test_fun)
eval(bquote(
function(ctx) {
test_that(.(desc), .(body_of_test_fun))
}
))
}
DBItest/R/spec-getting-started.R 0000644 0001762 0000144 00000001376 13017553133 016141 0 ustar ligges users #' @template dbispec
#' @format NULL
#' @section Getting started:
spec_getting_started <- list(
package_dependencies = function(ctx) {
#' A DBI backend is an R package,
pkg <- get_pkg(ctx)
pkg_imports <- devtools::parse_deps(pkg$imports)$name
#' which should import the \pkg{DBI}
expect_true("DBI" %in% pkg_imports)
#' and \pkg{methods}
expect_true("methods" %in% pkg_imports)
#' packages.
},
package_name = function(ctx) {
pkg_name <- package_name(ctx)
#' For better or worse, the names of many existing backends start with
#' \sQuote{R}, e.g., \pkg{RSQLite}, \pkg{RMySQL}, \pkg{RSQLServer}; it is up
#' to the package author to adopt this convention or not.
expect_match(pkg_name, "^R")
},
NULL
)
DBItest/R/spec-compliance-methods.R 0000644 0001762 0000144 00000004556 13017553133 016612 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Full compliance:
#' \subsection{All of DBI}{
spec_compliance_methods <- list(
#' The package defines three classes that implement the required methods.
compliance = function(ctx) {
pkg <- package_name(ctx)
where <- asNamespace(pkg)
sapply(names(key_methods), function(name) {
dbi_class <- paste0("DBI", name)
classes <- Filter(function(class) {
extends(class, dbi_class) && getClass(class)@virtual == FALSE
}, getClasses(where))
expect_equal(length(classes), 1)
class <- classes[[1]]
mapply(function(method, args) {
expect_has_class_method(method, class, args, where)
}, names(key_methods[[name]]), key_methods[[name]])
})
},
#' All methods have an ellipsis `...` in their formals.
ellipsis = function(ctx) {
pkg <- package_name(ctx)
where <- asNamespace(pkg)
methods <- s4_methods(where, function(x) x == "DBI")
Map(expect_ellipsis_in_formals, methods, names(methods))
},
#' }
NULL
)
# Helpers -----------------------------------------------------------------
#' @importFrom methods hasMethod
expect_has_class_method <- function(name, class, args, driver_package) {
full_args <- c(class, args)
eval(bquote(
expect_true(hasMethod(.(name), .(full_args), driver_package))
))
}
expect_ellipsis_in_formals <- function(method, name) {
sym <- as.name(name)
eval(bquote({
.(sym) <- method
expect_true("..." %in% s4_real_argument_names(.(sym)))
}))
}
key_methods <- list(
Driver = list(
"dbGetInfo" = NULL,
"dbConnect" = NULL,
"dbDataType" = NULL
),
Connection = list(
"dbDisconnect" = NULL,
"dbGetInfo" = NULL,
"dbSendQuery" = "character",
"dbListFields" = "character",
"dbListTables" = NULL,
"dbReadTable" = "character",
"dbWriteTable" = c("character", "data.frame"),
"dbExistsTable" = "character",
"dbRemoveTable" = "character",
"dbBegin" = NULL,
"dbCommit" = NULL,
"dbRollback" = NULL,
"dbIsValid" = NULL,
"dbQuoteString" = "character",
"dbQuoteIdentifier" = "character"
),
Result = list(
"dbIsValid" = NULL,
"dbFetch" = NULL,
"dbClearResult" = NULL,
"dbColumnInfo" = NULL,
"dbGetRowsAffected" = NULL,
"dbGetRowCount" = NULL,
"dbHasCompleted" = NULL,
"dbGetStatement" = NULL,
"dbBind" = NULL
)
)
DBItest/R/expectations.R 0000644 0001762 0000144 00000001453 13017553133 014606 0 ustar ligges users arglist_is_empty <- function() {
function(x) {
expect_true(
is.null(formals(x)),
"has empty argument list")
}
}
all_args_have_default_values <- function() {
function(x) {
args <- formals(x)
args <- args[names(args) != "..."]
expect_true(
all(vapply(args, as.character, character(1L)) != ""),
"has arguments without default values")
}
}
has_method <- function(method_name) {
function(x) {
my_class <- class(x)
expect_true(
length(findMethod(method_name, my_class)) > 0L,
paste("object of class", my_class, "has no", method_name, "method"))
}
}
expect_invisible_true <- function(code) {
ret <- withVisible(code)
expect_true(ret$value)
# Cannot test for visibility of return value yet (#89)
return()
expect_false(ret$visible)
}
DBItest/R/spec-result-roundtrip.R 0000644 0001762 0000144 00000050322 13017553133 016371 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Result:
#' \subsection{Data roundtrip}{
spec_result_roundtrip <- list(
#' Data conversion from SQL to R: integer
data_integer = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1L, -100L)
})
},
#' Data conversion from SQL to R: integer with typed NULL values.
data_integer_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1L, -100L, .add_null = "below")
})
},
#' Data conversion from SQL to R: integer with typed NULL values
#' in the first row.
data_integer_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1L, -100L, .add_null = "above")
})
},
#' Data conversion from SQL to R: numeric.
data_numeric = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1.5, -100.5)
})
},
#' Data conversion from SQL to R: numeric with typed NULL values.
data_numeric_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1.5, -100.5, .add_null = "below")
})
},
#' Data conversion from SQL to R: numeric with typed NULL values
#' in the first row.
data_numeric_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con, 1.5, -100.5, .add_null = "above")
})
},
#' Data conversion from SQL to R: logical. Optional, conflict with the
#' `data_logical_int` test.
data_logical = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = TRUE, "cast(0 AS boolean)" = FALSE)
})
},
#' Data conversion from SQL to R: logical with typed NULL values.
data_logical_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = TRUE, "cast(0 AS boolean)" = FALSE,
.add_null = "below")
})
},
#' Data conversion from SQL to R: logical with typed NULL values
#' in the first row
data_logical_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = TRUE, "cast(0 AS boolean)" = FALSE,
.add_null = "above")
})
},
#' Data conversion from SQL to R: logical (as integers). Optional,
#' conflict with the `data_logical` test.
data_logical_int = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = 1L, "cast(0 AS boolean)" = 0L)
})
},
#' Data conversion from SQL to R: logical (as integers) with typed NULL
#' values.
data_logical_int_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = 1L, "cast(0 AS boolean)" = 0L,
.add_null = "below")
})
},
#' Data conversion from SQL to R: logical (as integers) with typed NULL
#' values
#' in the first row.
data_logical_int_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"CAST(1 AS boolean)" = 1L, "cast(0 AS boolean)" = 0L,
.add_null = "above")
})
},
#' Data conversion from SQL to R: A NULL value is returned as NA.
data_null = function(ctx) {
with_connection({
check_result <- function(rows) {
expect_true(is.na(rows$a))
}
test_select(.ctx = ctx, con, "NULL" = is.na)
})
},
#' Data conversion from SQL to R: 64-bit integers.
data_64_bit = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"10000000000" = 10000000000, "-10000000000" = -10000000000)
})
},
#' Data conversion from SQL to R: 64-bit integers with typed NULL values.
data_64_bit_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"10000000000" = 10000000000, "-10000000000" = -10000000000,
.add_null = "below")
})
},
#' Data conversion from SQL to R: 64-bit integers with typed NULL values
#' in the first row.
data_64_bit_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"10000000000" = 10000000000, "-10000000000" = -10000000000,
.add_null = "above")
})
},
#' Data conversion from SQL to R: character.
data_character = function(ctx) {
with_connection({
values <- texts
test_funs <- rep(list(has_utf8_or_ascii_encoding), length(values))
sql_names <- as.character(dbQuoteString(con, texts))
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names))
test_select(.ctx = ctx, con, .dots = setNames(test_funs, sql_names))
})
},
#' Data conversion from SQL to R: character with typed NULL values.
data_character_null_below = function(ctx) {
with_connection({
values <- texts
test_funs <- rep(list(has_utf8_or_ascii_encoding), length(values))
sql_names <- as.character(dbQuoteString(con, texts))
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names),
.add_null = "below")
test_select(.ctx = ctx, con, .dots = setNames(test_funs, sql_names),
.add_null = "below")
})
},
#' Data conversion from SQL to R: character with typed NULL values
#' in the first row.
data_character_null_above = function(ctx) {
with_connection({
values <- texts
test_funs <- rep(list(has_utf8_or_ascii_encoding), length(values))
sql_names <- as.character(dbQuoteString(con, texts))
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names),
.add_null = "above")
test_select(.ctx = ctx, con, .dots = setNames(test_funs, sql_names),
.add_null = "above")
})
},
#' Data conversion from SQL to R: raw. Not all SQL dialects support the
#' syntax of the query used here.
data_raw = function(ctx) {
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
skip("tweak: omit_blob_tests")
}
with_connection({
values <- list(is_raw_list)
sql_names <- paste0("cast(1 as ", dbDataType(con, list(raw())), ")")
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names))
})
},
#' Data conversion from SQL to R: raw with typed NULL values.
data_raw_null_below = function(ctx) {
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
skip("tweak: omit_blob_tests")
}
with_connection({
values <- list(is_raw_list)
sql_names <- paste0("cast(1 as ", dbDataType(con, list(raw())), ")")
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names),
.add_null = "below")
})
},
#' Data conversion from SQL to R: raw with typed NULL values
#' in the first row.
data_raw_null_above = function(ctx) {
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
skip("tweak: omit_blob_tests")
}
with_connection({
values <- list(is_raw_list)
sql_names <- paste0("cast(1 as ", dbDataType(con, list(raw())), ")")
test_select(.ctx = ctx, con, .dots = setNames(values, sql_names),
.add_null = "above")
})
},
#' Data conversion from SQL to R: date, returned as integer with class.
data_date = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"date('2015-01-01')" = as_integer_date("2015-01-01"),
"date('2015-02-02')" = as_integer_date("2015-02-02"),
"date('2015-03-03')" = as_integer_date("2015-03-03"),
"date('2015-04-04')" = as_integer_date("2015-04-04"),
"date('2015-05-05')" = as_integer_date("2015-05-05"),
"date('2015-06-06')" = as_integer_date("2015-06-06"),
"date('2015-07-07')" = as_integer_date("2015-07-07"),
"date('2015-08-08')" = as_integer_date("2015-08-08"),
"date('2015-09-09')" = as_integer_date("2015-09-09"),
"date('2015-10-10')" = as_integer_date("2015-10-10"),
"date('2015-11-11')" = as_integer_date("2015-11-11"),
"date('2015-12-12')" = as_integer_date("2015-12-12"),
"current_date" ~ as_integer_date(Sys.time()))
})
},
#' Data conversion from SQL to R: date with typed NULL values.
data_date_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"date('2015-01-01')" = as_integer_date("2015-01-01"),
"date('2015-02-02')" = as_integer_date("2015-02-02"),
"date('2015-03-03')" = as_integer_date("2015-03-03"),
"date('2015-04-04')" = as_integer_date("2015-04-04"),
"date('2015-05-05')" = as_integer_date("2015-05-05"),
"date('2015-06-06')" = as_integer_date("2015-06-06"),
"date('2015-07-07')" = as_integer_date("2015-07-07"),
"date('2015-08-08')" = as_integer_date("2015-08-08"),
"date('2015-09-09')" = as_integer_date("2015-09-09"),
"date('2015-10-10')" = as_integer_date("2015-10-10"),
"date('2015-11-11')" = as_integer_date("2015-11-11"),
"date('2015-12-12')" = as_integer_date("2015-12-12"),
"current_date" ~ as_integer_date(Sys.time()),
.add_null = "below")
})
},
#' Data conversion from SQL to R: date with typed NULL values
#' in the first row.
data_date_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"date('2015-01-01')" = as_integer_date("2015-01-01"),
"date('2015-02-02')" = as_integer_date("2015-02-02"),
"date('2015-03-03')" = as_integer_date("2015-03-03"),
"date('2015-04-04')" = as_integer_date("2015-04-04"),
"date('2015-05-05')" = as_integer_date("2015-05-05"),
"date('2015-06-06')" = as_integer_date("2015-06-06"),
"date('2015-07-07')" = as_integer_date("2015-07-07"),
"date('2015-08-08')" = as_integer_date("2015-08-08"),
"date('2015-09-09')" = as_integer_date("2015-09-09"),
"date('2015-10-10')" = as_integer_date("2015-10-10"),
"date('2015-11-11')" = as_integer_date("2015-11-11"),
"date('2015-12-12')" = as_integer_date("2015-12-12"),
"current_date" ~ as_integer_date(Sys.time()),
.add_null = "above")
})
},
#' Data conversion from SQL to R: time.
data_time = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time '00:00:00'" = "00:00:00",
"time '12:34:56'" = "12:34:56",
"current_time" ~ is.character)
})
},
#' Data conversion from SQL to R: time with typed NULL values.
data_time_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time '00:00:00'" = "00:00:00",
"time '12:34:56'" = "12:34:56",
"current_time" ~ is.character,
.add_null = "below")
})
},
#' Data conversion from SQL to R: time with typed NULL values
#' in the first row.
data_time_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time '00:00:00'" = "00:00:00",
"time '12:34:56'" = "12:34:56",
"current_time" ~ is.character,
.add_null = "above")
})
},
#' Data conversion from SQL to R: time (using alternative syntax with
#' parentheses for specifying time literals).
data_time_parens = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time('00:00:00')" = "00:00:00",
"time('12:34:56')" = "12:34:56",
"current_time" ~ is.character)
})
},
#' Data conversion from SQL to R: time (using alternative syntax with
#' parentheses for specifying time literals) with typed NULL values.
data_time_parens_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time('00:00:00')" = "00:00:00",
"time('12:34:56')" = "12:34:56",
"current_time" ~ is.character,
.add_null = "below")
})
},
#' Data conversion from SQL to R: time (using alternative syntax with
#' parentheses for specifying time literals) with typed NULL values
#' in the first row.
data_time_parens_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"time('00:00:00')" = "00:00:00",
"time('12:34:56')" = "12:34:56",
"current_time" ~ is.character,
.add_null = "above")
})
},
#' Data conversion from SQL to R: timestamp.
data_timestamp = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"timestamp '2015-10-11 00:00:00'" = is_time,
"timestamp '2015-10-11 12:34:56'" = is_time,
"current_timestamp" ~ is_roughly_current_time)
})
},
#' Data conversion from SQL to R: timestamp with typed NULL values.
data_timestamp_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"timestamp '2015-10-11 00:00:00'" = is_time,
"timestamp '2015-10-11 12:34:56'" = is_time,
"current_timestamp" ~ is_roughly_current_time,
.add_null = "below")
})
},
#' Data conversion from SQL to R: timestamp with typed NULL values
#' in the first row.
data_timestamp_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx, con,
"timestamp '2015-10-11 00:00:00'" = is_time,
"timestamp '2015-10-11 12:34:56'" = is_time,
"current_timestamp" ~ is_roughly_current_time,
.add_null = "above")
})
},
#' Data conversion from SQL to R: timestamp with time zone.
data_timestamp_utc = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"timestamp '2015-10-11 00:00:00+02:00'" =
as.POSIXct("2015-10-11 00:00:00+02:00"),
"timestamp '2015-10-11 12:34:56-05:00'" =
as.POSIXct("2015-10-11 12:34:56-05:00"),
"current_timestamp" ~ is_roughly_current_time)
})
},
#' Data conversion from SQL to R: timestamp with time zone with typed NULL
#' values.
data_timestamp_utc_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"timestamp '2015-10-11 00:00:00+02:00'" =
as.POSIXct("2015-10-11 00:00:00+02:00"),
"timestamp '2015-10-11 12:34:56-05:00'" =
as.POSIXct("2015-10-11 12:34:56-05:00"),
"current_timestamp" ~ is_roughly_current_time,
.add_null = "below")
})
},
#' Data conversion from SQL to R: timestamp with time zone with typed NULL
#' values
#' in the first row.
data_timestamp_utc_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"timestamp '2015-10-11 00:00:00+02:00'" =
as.POSIXct("2015-10-11 00:00:00+02:00"),
"timestamp '2015-10-11 12:34:56-05:00'" =
as.POSIXct("2015-10-11 12:34:56-05:00"),
"current_timestamp" ~ is_roughly_current_time,
.add_null = "above")
})
},
#' Data conversion: timestamp (alternative syntax with parentheses
#' for specifying timestamp literals).
data_timestamp_parens = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"datetime('2015-10-11 00:00:00')" =
as.POSIXct("2015-10-11 00:00:00Z"),
"datetime('2015-10-11 12:34:56')" =
as.POSIXct("2015-10-11 12:34:56Z"),
"current_timestamp" ~ is_roughly_current_time)
})
},
#' Data conversion: timestamp (alternative syntax with parentheses
#' for specifying timestamp literals) with typed NULL values.
data_timestamp_parens_null_below = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"datetime('2015-10-11 00:00:00')" =
as.POSIXct("2015-10-11 00:00:00Z"),
"datetime('2015-10-11 12:34:56')" =
as.POSIXct("2015-10-11 12:34:56Z"),
"current_timestamp" ~ is_roughly_current_time,
.add_null = "below")
})
},
#' Data conversion: timestamp (alternative syntax with parentheses
#' for specifying timestamp literals) with typed NULL values
#' in the first row.
data_timestamp_parens_null_above = function(ctx) {
with_connection({
test_select(.ctx = ctx,
con,
"datetime('2015-10-11 00:00:00')" =
as.POSIXct("2015-10-11 00:00:00Z"),
"datetime('2015-10-11 12:34:56')" =
as.POSIXct("2015-10-11 12:34:56Z"),
"current_timestamp" ~ is_roughly_current_time,
.add_null = "above")
})
},
#' }
NULL
)
# NB: .table = TRUE will not work in bigrquery
test_select <- function(con, ..., .dots = NULL, .add_null = "none",
.table = FALSE, .ctx, .envir = parent.frame()) {
values <- c(list(...), .dots)
value_is_formula <- vapply(values, is.call, logical(1L))
names(values)[value_is_formula] <- lapply(values[value_is_formula], "[[", 2L)
values[value_is_formula] <- lapply(
values[value_is_formula],
function(x) {
eval(x[[3]], envir = .envir)
}
)
if (is.null(names(values))) {
sql_values <- lapply(values, as.character)
} else {
sql_values <- names(values)
}
if (isTRUE(.ctx$tweaks$current_needs_parens)) {
sql_values <- gsub("^(current_(?:date|time|timestamp))$", "\\1()",
sql_values)
}
sql_names <- letters[seq_along(sql_values)]
query <- paste("SELECT",
paste(sql_values, "as", sql_names, collapse = ", "))
if (.add_null != "none") {
query_null <- paste("SELECT",
paste("NULL as", sql_names, collapse = ", "))
query <- c(query, query_null)
if (.add_null == "above") {
query <- rev(query)
}
query <- paste0(query, ", ", 1:2, " as id")
query <- union(.ctx = .ctx, query)
}
if (.table) {
query <- paste("CREATE TABLE test AS", query)
expect_warning(dbExecute(con, query), NA)
on.exit(expect_error(dbExecute(con, "DROP TABLE test"), NA), add = TRUE)
expect_warning(rows <- dbReadTable(con, "test"), NA)
} else {
expect_warning(rows <- dbGetQuery(con, query), NA)
}
if (.add_null != "none") {
rows <- rows[order(rows$id), -(length(sql_names) + 1L)]
if (.add_null == "above") {
rows <- rows[2:1, ]
}
}
expect_identical(names(rows), sql_names)
for (i in seq_along(values)) {
value_or_testfun <- values[[i]]
if (is.function(value_or_testfun)) {
eval(bquote(expect_true(value_or_testfun(rows[1L, .(i)]))))
} else {
eval(bquote(expect_identical(rows[1L, .(i)], .(value_or_testfun))))
}
}
if (.add_null != "none") {
expect_equal(nrow(rows), 2L)
expect_true(all(is.na(unname(unlist(rows[2L, ])))))
} else {
expect_equal(nrow(rows), 1L)
}
}
all_have_utf8_or_ascii_encoding <- function(x) {
all(vapply(x, has_utf8_or_ascii_encoding, logical(1L)))
}
has_utf8_or_ascii_encoding <- function(x) {
if (Encoding(x) == "UTF-8")
TRUE
else if (Encoding(x) == "unknown") {
# Characters encoded as "unknown" must be ASCII only, and remain "unknown"
# after attempting to assign an encoding. From ?Encoding :
# > ASCII strings will never be marked with a declared encoding, since their
# > representation is the same in all supported encodings.
Encoding(x) <- "UTF-8"
Encoding(x) == "unknown"
} else
FALSE
}
is_raw_list <- function(x) {
is.list(x) && is.raw(x[[1L]])
}
is_time <- function(x) {
inherits(x, "POSIXct")
}
is_roughly_current_time <- function(x) {
is_time(x) && (Sys.time() - x <= 2)
}
as_integer_date <- function(d) {
d <- as.Date(d)
structure(as.integer(unclass(d)), class = class(d))
}
DBItest/R/test-compliance.R 0000644 0001762 0000144 00000000614 13020260451 015155 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_compliance()]:
#' Test full compliance to DBI
NULL
#' Test full compliance to DBI
#'
#' @inheritParams test_all
#' @include test-transaction.R
#' @family tests
#' @export
test_compliance <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Full compliance"
run_tests(ctx, spec_compliance, skip, test_suite)
}
DBItest/R/spec-compliance-read-only.R 0000644 0001762 0000144 00000000656 13017553133 017036 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Full compliance:
#' \subsection{Read-only access}{
spec_compliance_read_only <- list(
spec_compliance_methods,
#' Writing to the database fails. (You might need to set up a separate
#' test context just for this test.)
read_only = function(ctx) {
with_connection({
expect_error(dbWriteTable(con, "test", data.frame(a = 1)))
})
},
#' }
NULL
)
DBItest/R/spec-.R 0000644 0001762 0000144 00000003742 13017553133 013112 0 ustar ligges users # reverse order
# Script to create new spec files from subspec names read from clipboard:
# xclip -out -se c | sed 's/,//' | for i in $(cat); do f=$(echo $i | sed 's/_/-/g;s/$/.R/'); echo "$i <- list(" > R/$f; echo ")" >> R/$f; echo "#' @include $f"; done | tac
#
# Example input:
# test_xxx_1,
# test_xxx_2,
#
# Output: Files R/test-xxx-1.R and R/test-xxx-2.R, and @include directives to stdout
#' @include spec-stress.R
#' @include spec-stress-connection.R
#' @include spec-stress-driver.R
#' @include spec-compliance.R
#' @include spec-compliance-read-only.R
#' @include spec-compliance-methods.R
#' @include spec-transaction.R
#' @include spec-transaction-with-transaction.R
#' @include spec-transaction-begin-rollback.R
#' @include spec-transaction-begin-commit.R
#' @include spec-meta.R
#' @include spec-meta-bind-.R
#' @include spec-meta-bind-multi-row.R
#' @include spec-meta-bind.R
#' @include spec-meta-get-info-result.R
#' @include spec-meta-get-rows-affected.R
#' @include spec-meta-get-row-count.R
#' @include spec-meta-column-info.R
#' @include spec-meta-get-statement.R
#' @include spec-meta-is-valid-result.R
#' @include spec-meta-is-valid-connection.R
#' @include spec-sql.R
#' @include spec-sql-list-fields.R
#' @include spec-sql-list-tables.R
#' @include spec-sql-read-write-roundtrip.R
#' @include spec-sql-read-write-table.R
#' @include spec-sql-quote-identifier.R
#' @include spec-sql-quote-string.R
#' @include spec-result.R
#' @include spec-result-roundtrip.R
#' @include spec-result-create-table-with-data-type.R
#' @include spec-result-get-query.R
#' @include spec-result-fetch.R
#' @include spec-result-send-query.R
#' @include spec-connection.R
#' @include spec-connection-get-info.R
#' @include spec-connection-data-type.R
#' @include spec-connection-connect.R
#' @include spec-driver.R
#' @include spec-driver-get-info.R
#' @include spec-driver-data-type.R
#' @include spec-driver-constructor.R
#' @include spec-driver-class.R
#' @include spec-getting-started.R
#' @include spec.R
NULL
DBItest/R/spec-meta-column-info.R 0000644 0001762 0000144 00000001172 13017553133 016200 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Meta:
#' \subsection{`dbColumnInfo("DBIResult")`}{
spec_meta_column_info <- list(
#' Column information is correct.
column_info = function(ctx) {
with_connection({
query <- "SELECT 1 as a, 1.5 as b, NULL"
expect_warning(res <- dbSendQuery(con, query), NA)
on.exit(expect_error(dbClearResult(res), NA), add = TRUE)
ci <- dbColumnInfo(res)
expect_is(ci, "data.frame")
expect_identical(colnames(ci), c("name", "type"))
expect_identical(ci$name[1:2], c("a", "b"))
expect_is(ci$type, "character")
})
},
#' }
NULL
)
DBItest/R/test-stress.R 0000644 0001762 0000144 00000000565 13020260451 014373 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_stress()]:
#' Stress tests (not tested with `test_all`)
NULL
#' Stress tests
#'
#' @inheritParams test_all
#' @include test-compliance.R
#' @family tests
#' @export
test_stress <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Stress"
run_tests(ctx, spec_stress, skip, test_suite)
}
DBItest/R/import-testthat.R 0000644 0001762 0000144 00000000173 13017553133 015246 0 ustar ligges users #' @import testthat
NULL
#' @importFrom methods findMethod getClasses getClass extends
#' @importFrom stats setNames
NULL
DBItest/R/spec-sql-list-tables.R 0000644 0001762 0000144 00000002011 13017553133 016037 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{`dbListTables("DBIConnection")`}{
spec_sql_list_tables <- list(
#' Can list the tables in the database, adding and removing tables affects
#' the list. Can also check existence of a table.
list_tables = function(ctx) {
with_connection({
expect_error(dbGetQuery(con, "SELECT * FROM iris"))
tables <- dbListTables(con)
expect_is(tables, "character")
expect_false("iris" %in% tables)
expect_false(dbExistsTable(con, "iris"))
on.exit(expect_error(dbRemoveTable(con, "iris"), NA),
add = TRUE)
iris <- get_iris(ctx)
dbWriteTable(con, "iris", iris)
tables <- dbListTables(con)
expect_true("iris" %in% tables)
expect_true(dbExistsTable(con, "iris"))
dbRemoveTable(con, "iris")
on.exit(NULL, add = FALSE)
tables <- dbListTables(con)
expect_false("iris" %in% tables)
expect_false(dbExistsTable(con, "iris"))
})
},
#' }
NULL
)
DBItest/R/tweaks.R 0000644 0001762 0000144 00000006052 13020260451 013366 0 ustar ligges users #' Tweaks for DBI tests
#'
#' TBD.
#' @name tweaks
#' @aliases NULL
{ # nolint
tweak_names <- c(
#' @param ... `[any]`\cr
#' Unknown tweaks are accepted, with a warning. The ellipsis
#' also asserts that all arguments are named.
"...",
#' @param constructor_name `[character(1)]`\cr
#' Name of the function that constructs the `Driver` object.
"constructor_name",
#' @param constructor_relax_args `[logical(1)]`\cr
#' If `TRUE`, allow a driver constructor with default values for all
#' arguments; otherwise, require a constructor with empty argument list
#' (default).
"constructor_relax_args",
#' @param strict_identifier `[logical(1)]`\cr
#' Set to `TRUE` if the DBMS does not support arbitrarily-named
#' identifiers even when quoting is used.
"strict_identifier",
#' @param omit_blob_tests `[logical(1)]`\cr
#' Set to `TRUE` if the DBMS does not support a `BLOB` data
#' type.
"omit_blob_tests",
#' @param current_needs_parens `[logical(1)]`\cr
#' Set to `TRUE` if the SQL functions `current_date`,
#' `current_time`, and `current_timestamp` require parentheses.
"current_needs_parens",
#' @param union `[function(character)]`\cr
#' Function that combines several subqueries into one so that the
#' resulting query returns the concatenated results of the subqueries
"union",
#' @param placeholder_pattern `[character]`\cr
#' A pattern for placeholders used in [DBI::dbBind()], e.g.,
#' `"?"`, `"$1"`, or `":name"`. See
#' [make_placeholder_fun()] for details.
"placeholder_pattern",
# Dummy argument
NULL
)
}
# A helper function that constructs the tweaks() function in a DRY fashion.
make_tweaks <- function(envir = parent.frame()) {
fmls <- vector(mode = "list", length(tweak_names))
names(fmls) <- tweak_names
fmls["..."] <- alist(`...` = )
tweak_quoted <- lapply(setNames(nm = tweak_names), as.name)
tweak_quoted <- c(tweak_quoted)
list_call <- as.call(c(quote(list), tweak_quoted))
fun <- eval(bquote(function() {
unknown <- list(...)
if (length(unknown) > 0) {
if (is.null(names(unknown)) || any(names(unknown) == "")) {
warning("All tweaks must be named", call. = FALSE)
} else {
warning("Unknown tweaks: ", paste(names(unknown), collapse = ", "),
call. = FALSE)
}
}
ret <- .(list_call)
ret <- ret[!vapply(ret, is.null, logical(1L))]
structure(ret, class = "DBItest_tweaks")
}
, as.environment(list(list_call = list_call))))
formals(fun) <- fmls
environment(fun) <- envir
fun
}
#' @export
#' @rdname tweaks
tweaks <- make_tweaks()
#' @export
format.DBItest_tweaks <- function(x, ...) {
if (length(x) == 0L) {
return("DBItest tweaks: Empty")
}
c(
"DBItest tweaks:",
unlist(mapply(
function(name, value) {
paste0(" ", name, ": ", format(value)[[1]])
},
names(x), unclass(x)))
)
}
#' @export
print.DBItest_tweaks <- function(x, ...) {
cat(format(x), sep = "\n")
}
DBItest/R/spec.R 0000644 0001762 0000144 00000001735 13017553133 013035 0 ustar ligges users #' DBI specification
#'
#' @description
#' The \pkg{DBI} package defines the generic DataBase Interface for R.
#' The connection to individual DBMS is made by packages that import \pkg{DBI}
#' (so-called \emph{DBI backends}).
#' This document formalizes the behavior expected by the functions declared in
#' \pkg{DBI} and implemented by the individal backends.
#'
#' To ensure maximum portability and exchangeability, and to reduce the effort
#' for implementing a new DBI backend, the \pkg{DBItest} package defines
#' a comprehensive set of test cases that test conformance to the DBI
#' specification.
#' In fact, this document is derived from comments in the test definitions of
#' the \pkg{DBItest} package.
#' This ensures that an extension or update to the tests will be reflected in
#' this document.
#'
#' @format NULL
#' @usage NULL
#' @name DBIspec
NULL
#' DBI specification (work in progress)
#'
#' Placeholder page.
#'
#' @format NULL
#' @usage NULL
#' @name DBIspec-wip
NULL
DBItest/R/DBItest.R 0000644 0001762 0000144 00000000570 13020260451 013365 0 ustar ligges users #' @details
#' The two most important functions are [make_context()] and
#' [test_all()]. The former tells the package how to connect to your
#' DBI backend, the latter executes all tests of the test suite. More
#' fine-grained test functions (all with prefix `test_`) are available.
#'
#' See the package's vignette for more details.
#'
#' @author Kirill Müller
"_PACKAGE"
DBItest/R/test-result.R 0000644 0001762 0000144 00000000556 13020260451 014366 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_result()]:
#' Test the "Result" class
NULL
#' Test the "Result" class
#'
#' @inheritParams test_all
#' @include test-connection.R
#' @family tests
#' @export
test_result <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Result"
run_tests(ctx, spec_result, skip, test_suite)
}
DBItest/R/spec-stress-connection.R 0000644 0001762 0000144 00000003541 13017553133 016510 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Connection:
#' \subsection{Stress tests}{
spec_stress_connection <- list(
#' Open 50 simultaneous connections
simultaneous_connections = function(ctx) {
cons <- list()
on.exit(expect_error(lapply(cons, dbDisconnect), NA), add = TRUE)
for (i in seq_len(50L)) {
cons <- c(cons, connect(ctx))
}
inherit_from_connection <-
vapply(cons, is, class2 = "DBIConnection", logical(1))
expect_true(all(inherit_from_connection))
},
#' Open and close 50 connections
stress_connections = function(ctx) {
for (i in seq_len(50L)) {
con <- connect(ctx)
expect_s4_class(con, "DBIConnection")
expect_error(dbDisconnect(con), NA)
}
},
#' Repeated load, instantiation, connection, disconnection, and unload of
#' package in a new R session.
stress_load_connect_unload = function(ctx) {
skip_on_travis()
skip_on_appveyor()
skip_if_not(getRversion() != "3.3.0")
pkg <- get_pkg(ctx)
script_file <- tempfile("DBItest", fileext = ".R")
local({
sink(script_file)
on.exit(sink(), add = TRUE)
cat(
"devtools::RCMD('INSTALL', ", shQuote(pkg$path), ")\n",
"library(DBI, quietly = TRUE)\n",
"connect_args <- ",
sep = ""
)
dput(ctx$connect_args)
cat(
"for (i in 1:50) {\n",
" drv <- ", pkg$package, "::", deparse(ctx$drv_call), "\n",
" con <- do.call(dbConnect, c(drv, connect_args))\n",
" dbDisconnect(con)\n",
" unloadNamespace(getNamespace(\"", pkg$package, "\"))\n",
"}\n",
sep = ""
)
})
with_temp_libpaths({
expect_equal(system(paste0("R -q --vanilla -f ", shQuote(script_file)),
ignore.stdout = TRUE, ignore.stderr = TRUE),
0L)
})
},
#' }
NULL
)
DBItest/R/spec-sql-quote-string.R 0000644 0001762 0000144 00000004002 13017553133 016257 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section SQL:
#' \subsection{`dbQuoteString("DBIConnection")`}{
spec_sql_quote_string <- list(
#' Can quote strings, and create strings that contain quotes and spaces.
quote_string = function(ctx) {
with_connection({
simple <- dbQuoteString(con, "simple")
with_spaces <- dbQuoteString(con, "with spaces")
quoted_simple <- dbQuoteString(con, as.character(simple))
quoted_with_spaces <- dbQuoteString(con, as.character(with_spaces))
null <- dbQuoteString(con, NA_character_)
quoted_null <- dbQuoteString(con, as.character(null))
na <- dbQuoteString(con, "NA")
quoted_na <- dbQuoteString(con, as.character(na))
query <- paste0("SELECT",
simple, "as simple,",
with_spaces, "as with_spaces,",
null, " as null_return,",
na, "as na_return,",
quoted_simple, "as quoted_simple,",
quoted_with_spaces, "as quoted_with_spaces,",
quoted_null, "as quoted_null,",
quoted_na, "as quoted_na")
expect_warning(rows <- dbGetQuery(con, query), NA)
expect_identical(rows$simple, "simple")
expect_identical(rows$with_spaces, "with spaces")
expect_true(is.na(rows$null_return))
expect_identical(rows$na_return, "NA")
expect_identical(rows$quoted_simple, as.character(simple))
expect_identical(rows$quoted_with_spaces, as.character(with_spaces))
expect_identical(rows$quoted_null, as.character(null))
expect_identical(rows$quoted_na, as.character(na))
})
},
#' Can quote more than one string at once by passing a character vector.
quote_string_vectorized = function(ctx) {
with_connection({
simple_out <- dbQuoteString(con, "simple")
expect_equal(length(simple_out), 1L)
letters_out <- dbQuoteString(con, letters)
expect_equal(length(letters_out), length(letters))
})
},
#' }
NULL
)
DBItest/R/test-sql.R 0000644 0001762 0000144 00000000520 13020260451 013636 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_sql()]:
#' Test SQL methods
NULL
#' Test SQL methods
#'
#' @inheritParams test_all
#' @include test-result.R
#' @family tests
#' @export
test_sql <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "SQL"
run_tests(ctx, spec_sql, skip, test_suite)
}
DBItest/R/test-meta.R 0000644 0001762 0000144 00000000543 13020260451 013772 0 ustar ligges users #' @name test_all
#' @aliases NULL
#' @section Tests:
#' [test_meta()]:
#' Test metadata functions
NULL
#' Test metadata functions
#'
#' @inheritParams test_all
#' @include test-sql.R
#' @family tests
#' @export
test_meta <- function(skip = NULL, ctx = get_default_context()) {
test_suite <- "Metadata"
run_tests(ctx, spec_meta, skip, test_suite)
}
DBItest/R/spec-driver-constructor.R 0000644 0001762 0000144 00000003071 13017553133 016704 0 ustar ligges users #' @template dbispec-sub
#' @format NULL
#' @section Driver:
#' \subsection{Construction}{
spec_driver_constructor <- list(
constructor = function(ctx) {
pkg_name <- package_name(ctx)
#' The backend must support creation of an instance of this driver class
#' with a \dfn{constructor function}.
#' By default, its name is the package name without the leading \sQuote{R}
#' (if it exists), e.g., `SQLite` for the \pkg{RSQLite} package.
default_constructor_name <- gsub("^R", "", pkg_name)
#' For the automated tests, the constructor name can be tweaked using the
#' `constructor_name` tweak.
constructor_name <- ctx$tweaks$constructor_name %||% default_constructor_name
#'
#' The constructor must be exported, and
pkg_env <- getNamespace(pkg_name)
eval(bquote(
expect_true(.(constructor_name) %in% getNamespaceExports(pkg_env))))
#' it must be a function
eval(bquote(
expect_true(exists(.(constructor_name), mode = "function", pkg_env))))
constructor <- get(constructor_name, mode = "function", pkg_env)
#' that is callable without arguments.
#' For the automated tests, unless the
#' `constructor_relax_args` tweak is set to `TRUE`,
if (!isTRUE(ctx$tweaks$constructor_relax_args)) {
#' an empty argument list is expected.
expect_that(constructor, arglist_is_empty())
} else {
#' Otherwise, an argument list where all arguments have default values
#' is also accepted.
expect_that(constructor, all_args_have_default_values())
}
#'
},
#' }
NULL
)
DBItest/R/test-all.R 0000644 0001762 0000144 00000001551 13017553133 013624 0 ustar ligges users #' Run all tests
#'
#' This function calls all tests defined in this package (see the section
#' "Tests" below).
#'
#' @section Tests:
#' This function runs the following tests, except the stress tests:
#'
#' @param skip `[character()]`\cr A vector of regular expressions to match
#' against test names; skip test if matching any.
#' @param ctx `[DBItest_context]`\cr A test context as created by
#' [make_context()].
#'
#' @export
test_all <- function(skip = NULL, ctx = get_default_context()) {
test_getting_started(skip = skip, ctx = ctx)
test_driver(skip = skip, ctx = ctx)
test_connection(skip = skip, ctx = ctx)
test_result(skip = skip, ctx = ctx)
test_sql(skip = skip, ctx = ctx)
test_meta(skip = skip, ctx = ctx)
test_transaction(skip = skip, ctx = ctx)
test_compliance(skip = skip, ctx = ctx)
# stress tests are not tested by default (#92)
}
DBItest/R/spec-meta-bind-.R 0000644 0001762 0000144 00000017130 13020263506 014740 0 ustar ligges users # Helpers -----------------------------------------------------------------
test_select_bind <- function(con, placeholder_fun, ...) {
if (is.character(placeholder_fun))
placeholder_fun <- lapply(placeholder_fun, make_placeholder_fun)
else if (is.function(placeholder_fun))
placeholder_fun <- list(placeholder_fun)
if (length(placeholder_fun) == 0) {
skip("Use the placeholder_pattern tweak, or skip all 'bind_.*' tests")
}
lapply(placeholder_fun, test_select_bind_one, con = con, ...)
}
test_select_bind_one <- function(con, placeholder_fun, values,
type = "character(10)",
query = TRUE,
transform_input = as.character,
transform_output = function(x) trimws(x, "right"),
expect = expect_identical,
extra = "none") {
bind_tester <- BindTester$new(con)
bind_tester$placeholder <- placeholder_fun(length(values))
bind_tester$values <- values
bind_tester$type <- type
bind_tester$query <- query
bind_tester$transform$input <- transform_input
bind_tester$transform$output <- transform_output
bind_tester$expect$fun <- expect
bind_tester$extra_obj <- new_extra_imp(extra)
bind_tester$run()
}
new_extra_imp <- function(extra) {
if (length(extra) == 0)
new_extra_imp_one("none")
else if (length(extra) == 1)
new_extra_imp_one(extra)
else {
stop("need BindTesterExtraMulti")
# BindTesterExtraMulti$new(lapply(extra, new_extra_imp_one))
}
}
new_extra_imp_one <- function(extra) {
extra_imp <- switch(
extra,
return_value = BindTesterExtraReturnValue,
too_many = BindTesterExtraTooMany,
not_enough = BindTesterExtraNotEnough,
wrong_name = BindTesterExtraWrongName,
unequal_length = BindTesterExtraUnequalLength,
repeated = BindTesterExtraRepeated,
none = BindTesterExtra,
stop("Unknown extra: ", extra, call. = FALSE)
)
extra_imp$new()
}
# BindTesterExtra ---------------------------------------------------------
BindTesterExtra <- R6::R6Class(
"BindTesterExtra",
portable = TRUE,
public = list(
check_return_value = function(bind_res, res) invisible(NULL),
patch_bind_values = identity,
requires_names = function() FALSE,
is_repeated = function() FALSE
)
)
# BindTesterExtraReturnValue ----------------------------------------------
BindTesterExtraReturnValue <- R6::R6Class(
"BindTesterExtraReturnValue",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
check_return_value = function(bind_res, res) {
expect_false(bind_res$visible)
expect_identical(res, bind_res$value)
}
)
)
# BindTesterExtraTooMany --------------------------------------------------
BindTesterExtraTooMany <- R6::R6Class(
"BindTesterExtraTooMany",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
patch_bind_values = function(bind_values) {
c(bind_values, bind_values[[1L]])
}
)
)
# BindTesterExtraNotEnough --------------------------------------------------
BindTesterExtraNotEnough <- R6::R6Class(
"BindTesterExtraNotEnough",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
patch_bind_values = function(bind_values) {
bind_values[-1L]
}
)
)
# BindTesterExtraWrongName ------------------------------------------------
BindTesterExtraWrongName <- R6::R6Class(
"BindTesterExtraWrongName",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
patch_bind_values = function(bind_values) {
stats::setNames(bind_values, paste0("bogus", names(bind_values)))
},
requires_names = function() TRUE
)
)
# BindTesterExtraUnequalLength --------------------------------------------
BindTesterExtraUnequalLength <- R6::R6Class(
"BindTesterExtraUnequalLength",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
patch_bind_values = function(bind_values) {
bind_values[[2]] <- bind_values[[2]][-1]
bind_values
}
)
)
# BindTesterExtraRepeated -------------------------------------------------
BindTesterExtraRepeated <- R6::R6Class(
"BindTesterExtraRepeated",
inherit = BindTesterExtra,
portable = TRUE,
public = list(
is_repeated = function() TRUE
)
)
# BindTester --------------------------------------------------------------
BindTester <- R6::R6Class(
"BindTester",
portable = FALSE,
public = list(
initialize = function(con) {
self$con <- con
},
run = run_bind_tester$fun,
con = NULL,
placeholder = NULL,
values = NULL,
type = "character(10)",
query = TRUE,
transform = list(input = as.character, output = function(x) trimws(x, "right")),
expect = list(fun = expect_identical),
extra_obj = NULL
),
private = list(
is_query = function() {
query
},
send_query = function() {
value_names <- letters[seq_along(values)]
if (is.null(type)) {
typed_placeholder <- placeholder
} else {
typed_placeholder <- paste0("cast(", placeholder, " as ", type, ")")
}
query <- paste0("SELECT ", paste0(
typed_placeholder, " as ", value_names, collapse = ", "))
dbSendQuery(con, query)
},
send_statement = function() {
data <- data.frame(a = rep(1:5, 1:5))
data$b <- seq_along(data$a)
table_name <- random_table_name()
dbWriteTable(con, table_name, data, temporary = TRUE)
value_names <- letters[seq_along(values)]
statement <- paste0(
"UPDATE ", dbQuoteIdentifier(con, table_name), "SET b = b + 1 WHERE ",
paste(value_names, " = ", placeholder, collapse = " AND "))
dbSendStatement(con, statement)
},
bind = function(res, bind_values) {
error_bind_values <- extra_obj$patch_bind_values(bind_values)
if (!identical(bind_values, error_bind_values)) {
expect_error(dbBind(res, error_bind_values))
return(FALSE)
}
bind_res <- withVisible(dbBind(res, bind_values))
extra_obj$check_return_value(bind_res, res)
TRUE
},
compare = function(rows, values) {
expect$fun(lapply(unname(rows), transform$output),
lapply(unname(values), transform$input))
},
compare_affected = function(rows_affected, values) {
expect_equal(rows_affected, sum(values[[1]]))
}
)
)
# make_placeholder_fun ----------------------------------------------------
#' Create a function that creates n placeholders
#'
#' For internal use by the `placeholder_format` tweak.
#'
#' @param pattern `[character(1)]`\cr Any character, optionally followed by `1` or `name`. Examples: `"?"`, `"$1"`, `":name"`
#'
#' @return `[function(n)]`\cr A function with one argument `n` that
#' returns a vector of length `n` with placeholders of the specified format.
#' Examples: `?, ?, ?, ...`, `$1, $2, $3, ...`, `:a, :b, :c`
#'
#' @keywords internal
make_placeholder_fun <- function(pattern) {
format_rx <- "^(.)(.*)$"
character <- gsub(format_rx, "\\1", pattern)
kind <- gsub(format_rx, "\\2", pattern)
if (character == "") {
stop("placeholder pattern must have at least one character", call. = FALSE)
}
if (kind == "") {
eval(bquote(
function(n) .(character)
))
} else if (kind == "1") {
eval(bquote(
function(n) paste0(.(character), seq_len(n))
))
} else if (kind == "name") {
eval(bquote(
function(n) {
l <- letters[seq_len(n)]
stats::setNames(paste0(.(character), l), l)
}
))
} else {
stop("Pattern must be any character, optionally followed by 1 or name. Examples: $1, :name", call. = FALSE)
}
}
DBItest/R/s4.R 0000644 0001762 0000144 00000002314 13017553133 012423 0 ustar ligges users # http://stackoverflow.com/a/39880324/946850
s4_methods <- function(env, pkg_fun = NULL) {
generics <- methods::getGenerics(env)
if (is.null(pkg_fun)) {
ok <- TRUE
} else {
ok <- pkg_fun(generics@package)
}
res <- Map(
generics@.Data[ok], generics@package[ok], USE.NAMES = TRUE,
f = function(name, package) {
what <- methods::methodsPackageMetaName("T", paste(name, package, sep = ":"))
table <- get(what, envir = env)
mget(ls(table, all.names = TRUE), envir = table)
})
unlist(res, recursive = FALSE)
}
s4_real_argument_names <- function(s4_method) {
expect_is(s4_method, c("function", "MethodDefinition", "derivedDefaultMethod"))
unwrapped <- s4_unwrap(s4_method)
names(formals(unwrapped))
}
s4_unwrap <- function(s4_method) {
# Only unwrap if body is of the following form:
# {
# .local <- function(x, y, z, ...) {
# ...
# }
# ...
# }
method_body <- body(s4_method)
if (inherits(method_body, "{")) {
local_def <- method_body[[2]]
if (inherits(local_def, "<-") && local_def[[2]] == quote(.local)) {
local_fun <- local_def[[3]]
if (inherits(local_fun, "function"))
return(local_fun)
}
}
s4_method
}
DBItest/R/spec-compliance.R 0000644 0001762 0000144 00000000175 13017553133 015142 0 ustar ligges users #' @template dbispec
#' @format NULL
spec_compliance <- c(
spec_compliance_methods,
spec_compliance_read_only,
NULL
)
DBItest/R/spec-driver-class.R 0000644 0001762 0000144 00000000642 13017553133 015425 0 ustar ligges users #' @template dbispec-sub
#' @format NULL
#' @section Driver:
spec_driver_class <- list(
inherits_from_driver = function(ctx) {
#' Each DBI backend implements a \dfn{driver class},
#' which must be an S4 class and inherit from the `DBIDriver` class.
expect_s4_class(ctx$drv, "DBIDriver")
},
#' This section describes the construction of, and the methods defined for,
#' this driver class.
NULL
)
DBItest/R/context.R 0000644 0001762 0000144 00000003405 13020260451 013553 0 ustar ligges users #' Test contexts
#'
#' Create a test context, set and query the default context.
#'
#' @param drv `[DBIDriver]`\cr An expression that constructs a DBI driver,
#' like `SQLite()`.
#' @param connect_args `[named list]`\cr Connection arguments (names and values).
#' @param set_as_default `[logical(1)]`\cr Should the created context be
#' set as default context?
#' @param tweaks `[DBItest_tweaks]`\cr Tweaks as constructed by the
#' [tweaks()] function.
#' @param ctx `[DBItest_context]`\cr A test context.
#' @param name `[character]`\cr An optional name of the context which will
#' be used in test messages.
#' @return `[DBItest_context]`\cr A test context, for
#' `set_default_context` the previous default context (invisibly) or
#' `NULL`.
#'
#' @rdname context
#' @export
make_context <- function(drv, connect_args, set_as_default = TRUE,
tweaks = NULL, name = NULL) {
drv_call <- substitute(drv)
if (is.null(drv)) {
stop("drv cannot be NULL.")
}
if (is.null(tweaks)) {
tweaks <- tweaks()
}
ctx <- structure(
list(
drv = drv,
drv_call = drv_call,
connect_args = connect_args,
tweaks = tweaks,
name = name
),
class = "DBItest_context"
)
if (set_as_default) {
set_default_context(ctx)
}
ctx
}
#' @rdname context
#' @export
set_default_context <- function(ctx) {
old_ctx <- .ctx_env$default_context
.ctx_env$default_context <- ctx
invisible(old_ctx)
}
#' @rdname context
#' @export
get_default_context <- function() {
.ctx_env$default_context
}
package_name <- function(ctx) {
attr(class(ctx$drv), "package")
}
connect <- function(ctx) {
do.call(dbConnect, c(list(ctx$drv), ctx$connect_args))
}
.ctx_env <- new.env(parent = emptyenv())
set_default_context(NULL)
DBItest/R/spec-connection-data-type.R 0000644 0001762 0000144 00000002144 13017553133 017053 0 ustar ligges users #' @template dbispec-sub-wip
#' @format NULL
#' @section Connection:
#' \subsection{`dbDataType("DBIConnection", "ANY")`}{
spec_connection_data_type <- list(
#' SQL Data types exist for all basic R data types. dbDataType() does not
#' throw an error and returns a nonempty atomic character
data_type_connection = function(ctx) {
con <- connect(ctx)
check_conn_data_type <- function(value) {
eval(bquote({
expect_is(dbDataType(con, .(value)), "character")
expect_equal(length(dbDataType(con, .(value))), 1L)
expect_match(dbDataType(con, .(value)), ".")
}))
}
expect_conn_has_data_type <- function(value) {
eval(bquote(
expect_error(check_conn_data_type(.(value)), NA)))
}
expect_conn_has_data_type(logical(1))
expect_conn_has_data_type(integer(1))
expect_conn_has_data_type(numeric(1))
expect_conn_has_data_type(character(1))
expect_conn_has_data_type(Sys.Date())
expect_conn_has_data_type(Sys.time())
if (!isTRUE(ctx$tweaks$omit_blob_tests)) {
expect_conn_has_data_type(list(raw(1)))
}
},
#' }
NULL
)
DBItest/vignettes/ 0000755 0001762 0000144 00000000000 13020472540 013555 5 ustar ligges users DBItest/vignettes/test.Rmd 0000644 0001762 0000144 00000010263 12731771543 015217 0 ustar ligges users ---
title: "Testing DBI backends"
author: "Kirill Müller"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Testing DBI backends}
%\VignetteEngine{knitr::rmarkdown}
\usepackage[utf8]{inputenc}
---
This document shows how to use the `DBItest` package when implementing a new `DBI` backend or when applying it to an existing backend. The `DBItest` package provides a large collection of automated tests.
## Testing a new backend
The test cases in the `DBItest` package are structured very similarly to the sections in the "backend" vignette:
```r
vignette("backend", package = "DBI")
```
Like the "backend" vignette, this vignette assumes that you are implementing the `RKazam` package that has a `Kazam()` function that creates a new `DBIDriver` instance for connecting to a "Kazam" database.
You can add the tests in the `DBItest` package incrementally, as you proceed with implementing the various parts of the DBI. The `DBItest` package builds upon the `testthat` package. To enable it, run the following in your package directory (after installing or updating `devtools`):
```r
devtools::use_testthat()
devtools::use_test("DBItest")
```
This creates, among others, a file `test-DBItest.R` in the `tests/testthat` directory. Replace its entire contents by the following:
```r
DBItest::make_context(Kazam(), NULL)
DBItest::test_getting_started()
```
Now test your package with `devtools::test()`. If you followed at least the "Getting started" section of the `DBI` "backend" vignette, all tests should succeed.
By adding the corresponding test function to your `tests/test-DBItest.R` file *before* implementing a section, you get immediate feedback which functionality of this section still needs to be implemented by running `devtools::test()` again. Therefore, proceed by appending the following to `tests/test-DBItest.R`, to include a test case for the forthcoming section:
```r
DBItest::test_driver()
```
Again, all tests should succeed when you are done with the "Driver" section. Add the call to the next tester function, implement the following section until all tests succeed, and so forth.
In this scenario, you are usually interested only in the first error the test suite finds. The `StopReporter` of `testthat` is most helpful here, activate it by passing `reporter = "stop"` to `devtools::test()`. Alternatively, call the relevant `DBItest::test_()` function directly.
The tests are documented with the corresponding functions: For instance, `?test_driver` shows a coarse description of all tests for the "Driver" test case. Test failures will include the name of the test that is failing; in this case, investigating the documentation or the source code of the `DBItest` package will usually lead to the cause of the error.
Not all tests can be satisfied: For example, there is one test that tests that `logical` variables survive a write-read roundtrip to the database, whereas another test tests that `logical` variables are converted to `integer` in such a case. Tests can be skipped by adding regular expressions for the tests to skip as character vector to the call, as in the following[^termnull]:
```r
DBItest::test_driver(skip = c(
"data_type" # Reason 1...
"constructor.*", # Reason 2...
NULL
))
[^termnull]: The terminating `NULL` allows appending new lines to the end by copy-pasting an existing line, without having to take care of the terminating comma.
```
Some other reasons to skip tests are:
- your database does not support a feature
- you want to postpone or avoid the implementation of a feature
- the test takes too long to run
## Testing an existing backend
For an existing backends, simply enabling all tests may be the quickest way to get started. Run the following in your package directory (after installing or updating `devtools`):
```r
devtools::use_testthat()
devtools::use_test("DBItest")
```
This creates, among others, a file `test-DBItest.R` in the `tests/testthat` directory. Replace its entire contents by the following:
```r
DBItest::make_context(Kazam(), NULL)
DBItest::test_all()
```
The notes about "Kazam" and skipping tests from the previous section apply here as well. The `test_all()` function simply calls all test cases.
DBItest/README.md 0000644 0001762 0000144 00000003013 12731773064 013036 0 ustar ligges users # DBItest [](https://travis-ci.org/rstats-db/DBItest) [](https://ci.appveyor.com/project/rstats-db/DBItest) [](https://cran.r-project.org/package=DBItest)
This package provides a considerable set of test cases which you can easily incorporate in your DBI driver package.
## Usage
Install from CRAN via
```r
install.packages("DBItest")
```
or the development version using
```r
devtools::install_github("rstats-db/DBItest")
```
In your driver backage, add `DBItest` to the `Suggests:`. Then, enable the tests by running
```r
devtools::use_testthat()
devtools::use_test("DBItest")
```
from your package's directory. This enables testing using `testthat` (if necessary) and creates, among others, a file `test-DBItest.R` in the `tests/testthat` directory. Replace its entire contents by the following:
```r
DBItest::make_context(Kazam(), NULL)
DBItest::test_all()
```
(This assumes that `Kazam()` returns an instance of your `DBIDriver` class. Additional arguments to `dbConnect()` are specified as named list instead of the `NULL` argument to `make_context()`.)
The `skip` argument to `test_all()` allows specifying skipped tests.
See the package's documentation and the [feature list](https://github.com/rstats-db/DBItest/wiki/Proposal) for a description of the tests.
DBItest/MD5 0000644 0001762 0000144 00000012122 13020502150 012042 0 ustar ligges users 5fc4ec7955f22b177ff6ec1324b83ca4 *DESCRIPTION
81cd946d3de4c7b9dda883b122c6d728 *NAMESPACE
d8c88467640b146998eb53ae514c26e0 *NEWS.md
f956e8e1290d2316d720831804645f34 *R/DBItest.R
5aff7b5a0aca622d131ff7d6d1721c95 *R/context.R
ac14ecef161e0215338bdbec18e6efa6 *R/expectations.R
33d6bb1e697558fa783c48b4fadeafcd *R/import-dbi.R
d1e36fe1f7d910ebe6ded24c9a2052b3 *R/import-testthat.R
ae71a7343fa7585c7140c8f9f38d6f95 *R/run.R
392269cd7ac8df3e6fbc56b0bea5538b *R/s4.R
c8d4595c9679057b2d2062ccb04d7be2 *R/spec-.R
50461b143db937afc2ac9a4a5f6f0d36 *R/spec-compliance-methods.R
540f3c072b3b4c11d6399ada69511ea2 *R/spec-compliance-read-only.R
9713a34fea629c2af551b92b2286a3ae *R/spec-compliance.R
d2b51be02b7918e4a12e5dd5ed43f3a5 *R/spec-connection-connect.R
613cfa69e2a310ea3c12fa6afda715d7 *R/spec-connection-data-type.R
c4c5e3d7f0dd8051a9f34d88ae8b68c9 *R/spec-connection-get-info.R
4b89a1600c91ceefb43e95fdf6cf3786 *R/spec-connection.R
d2c103c881337a6f77e795661626e22b *R/spec-driver-class.R
e39149bf7d88ad365c717b0fb9cbb9d9 *R/spec-driver-constructor.R
7c0ff9831cd7e3755b9c75016468f4cf *R/spec-driver-data-type.R
978caf381fa28ccf9cc86f6e6dd1829e *R/spec-driver-get-info.R
1e89ea5b2cab75c520a4b84d0f7a266f *R/spec-driver.R
47c6653a4b7f3631a81be59e1e19066a *R/spec-getting-started.R
53e20873912387b7e072b97d3fa7a827 *R/spec-meta-bind-.R
6c85ffbcf0862780619becd6e91d4387 *R/spec-meta-bind-multi-row.R
b6ddec2116deb42841879e3d92ce75b2 *R/spec-meta-bind.R
d5daa12e58b8f4a105fb78d56fb185b5 *R/spec-meta-column-info.R
8baa8e35cca961dbf729f32e64772a8c *R/spec-meta-get-info-result.R
98ef128fd9c3696a2096e1736566bd09 *R/spec-meta-get-row-count.R
7c0cc8f4eefe301c9dbd996e7f9edc05 *R/spec-meta-get-rows-affected.R
c65042cf47857b9d1b80456ca4d9ec2f *R/spec-meta-get-statement.R
8144ef9733640935ce1b6a6cbc1aa0db *R/spec-meta-is-valid-connection.R
d719d353cf89f3bec0fadff81faa9d1d *R/spec-meta-is-valid-result.R
a6c9971e4d04a4d2dbe08e756c1478d6 *R/spec-meta.R
b8f98188cd517505409fb51f7849a5c1 *R/spec-result-create-table-with-data-type.R
df1faf90c7d8b2276bee75efb0690337 *R/spec-result-fetch.R
f0988ce5d7f08d595f891942a7f29724 *R/spec-result-get-query.R
49967036adccaeef8ab7bf3c210f1259 *R/spec-result-roundtrip.R
471c08dd04893fece4639075ae9c884a *R/spec-result-send-query.R
9e8f4e7b38f18382a3693675bdc00a3d *R/spec-result.R
415dda2703baf2b2181839623551a498 *R/spec-sql-list-fields.R
cc10b00b566802e74094323f4aa6f1b8 *R/spec-sql-list-tables.R
4a4308ae632ee0cbeb28facacf391724 *R/spec-sql-quote-identifier.R
c87d982d3ec048485c876eeb11a86404 *R/spec-sql-quote-string.R
ee39cce95d7c16246bedeee7f6c0c46e *R/spec-sql-read-write-roundtrip.R
b142b6fa4661c19ca31024ed3cd7f57f *R/spec-sql-read-write-table.R
96328be15900ec078468ae49cf55963d *R/spec-sql.R
0667076b1e04bbdbc42de060e47a9446 *R/spec-stress-connection.R
cb3218a7f9285a392f2d692d24bddac3 *R/spec-stress-driver.R
73cf07d48bda9a36aa75ea52b2e1d0c4 *R/spec-stress.R
536357374e5a2c280ab5b3de409d3b5f *R/spec-transaction-begin-commit.R
28d4aa077a503dc5443b6d615608a33b *R/spec-transaction-begin-rollback.R
8a72283fb233f4f036bc7f0c667e438b *R/spec-transaction-with-transaction.R
7e1873b2a47fc22f7113db9e3a1e4ff5 *R/spec-transaction.R
4ebba52dcbf2f992f73001f7e4c992b4 *R/spec.R
42930e1c30af1764d829eb72b5f7377b *R/test-all.R
0f3c8fb591881f71dc343a2bbd3cf898 *R/test-compliance.R
5306ca1f57b4cec62b057c38b9acce72 *R/test-connection.R
0395879bafa2c627d4c3f954baf1c3e5 *R/test-driver.R
c206fc81b191714dd7e736e3348666e5 *R/test-getting-started.R
a11b4257b6ee210f7840be0cc32a1fc8 *R/test-meta.R
91549a3a28e40ee333ab44724b5eb46c *R/test-result.R
c23e4b8e51ad324d42d65f45e10eaacc *R/test-sql.R
4f098cdffca1949c4cbe9f96fc270c88 *R/test-stress.R
16036f6126b6d6184b02c9f2978eb75a *R/test-transaction.R
a184497d73f437ab2c1a6506331ff7d3 *R/tweaks.R
5bb7302537533dc370d8aa96bb6d1dfd *R/utf8.R
964c6a1fb51ac4953eec954e40eb0ea9 *R/utils.R
2ac48354a76e3430802052eff9620bac *README.md
ae2fd6ea55bce774f817836f579f6f5b *build/vignette.rds
1994b1ff1f8a4d1ded48cd7a04a8d770 *inst/doc/test.Rmd
c05c2b2466a3d5d513106443f4f768ff *inst/doc/test.html
95db7c3f60b0a8dd95d9b2fe8badb4a6 *man/DBIspec-wip.Rd
91e6a04a3b0565e65f5f012bbac89b39 *man/DBIspec.Rd
2c210cf5334383ea31c9fb433cda01ee *man/DBItest-package.Rd
6dc3d568a3939a41158e4d4ce0cc4244 *man/context.Rd
4567f06e67179b2ef9f5821dc3039922 *man/make_placeholder_fun.Rd
6b085b1c60ce27e321737430f7ce9da6 *man/test_all.Rd
fed4f17ab866041d1096aed7d83ca042 *man/test_compliance.Rd
c6520953292eb0086be311cb0dc58163 *man/test_connection.Rd
5fe3efacc98502dbf6e29aabc06f5e1a *man/test_driver.Rd
067b47bf6df2eedf248c9576f181e7aa *man/test_getting_started.Rd
5cafd1a20f6cc2a2797a65e869d8642c *man/test_meta.Rd
fa7bfdec7b1354fb1c436b43c6abd817 *man/test_result.Rd
8d7d087982f2d0738aad95b1809e009e *man/test_sql.Rd
04b8e7396de9b11026b4778c07792885 *man/test_stress.Rd
a501fdb79764314a9bd20ba58154d8e2 *man/test_transaction.Rd
2eafca654541bff02abd622dc12e12a5 *man/tweaks.Rd
e66cc0201e7914ca0a08d2401d1ac8a8 *tests/testthat.R
3675efbbcc4ee2129cfe7b52a10fd282 *tests/testthat/test-context.R
4c438214a5f4b238d0832ce8b8c9a0ba *tests/testthat/test-lint.R
361b9b8cea0450bd4dc41916dd4da39a *tests/testthat/test-tweaks.R
1994b1ff1f8a4d1ded48cd7a04a8d770 *vignettes/test.Rmd
DBItest/build/ 0000755 0001762 0000144 00000000000 13020472540 012644 5 ustar ligges users DBItest/build/vignette.rds 0000644 0001762 0000144 00000000312 13020472540 015177 0 ustar ligges users b```b`ffb`b2 1# '(I-. MA g+8y*$%&g(A + Cā I5/174v%gx" 5lP5,n90{C2K 7(1
棸(\^o @hrNb1GRKҊA w DBItest/DESCRIPTION 0000644 0001762 0000144 00000004754 13020502150 013254 0 ustar ligges users Package: DBItest
Title: Testing 'DBI' Back Ends
Version: 1.4
Date: 2016-12-02
Authors@R: c( person(given = "Kirill", family = "Müller", role =
c("aut", "cre"), email = "krlmlr+r@mailbox.org"),
person("RStudio", role = "cph") )
Description: A helper that tests 'DBI' back ends for conformity
to the interface.
Depends: R (>= 3.0.0)
Imports: DBI (>= 0.4-9), methods, R6, testthat (>= 1.0.2), withr
Suggests: devtools, knitr, lintr, rmarkdown
License: LGPL (>= 2)
LazyData: true
Encoding: UTF-8
BugReports: https://github.com/rstats-db/DBItest/issues
RoxygenNote: 5.0.1.9000
VignetteBuilder: knitr
Collate: 'DBItest.R' 'context.R' 'expectations.R' 'import-dbi.R'
'import-testthat.R' 'run.R' 's4.R' 'spec.R'
'spec-getting-started.R' 'spec-driver-class.R'
'spec-driver-constructor.R' 'spec-driver-data-type.R'
'spec-driver-get-info.R' 'spec-driver.R'
'spec-connection-connect.R' 'spec-connection-data-type.R'
'spec-connection-get-info.R' 'spec-connection.R'
'spec-result-send-query.R' 'spec-result-fetch.R'
'spec-result-get-query.R'
'spec-result-create-table-with-data-type.R'
'spec-result-roundtrip.R' 'spec-result.R'
'spec-sql-quote-string.R' 'spec-sql-quote-identifier.R'
'spec-sql-read-write-table.R' 'spec-sql-read-write-roundtrip.R'
'spec-sql-list-tables.R' 'spec-sql-list-fields.R' 'spec-sql.R'
'spec-meta-is-valid-connection.R' 'spec-meta-is-valid-result.R'
'spec-meta-get-statement.R' 'spec-meta-column-info.R'
'spec-meta-get-row-count.R' 'spec-meta-get-rows-affected.R'
'spec-meta-get-info-result.R' 'spec-meta-bind.R'
'spec-meta-bind-multi-row.R' 'spec-meta-bind-.R' 'spec-meta.R'
'spec-transaction-begin-commit.R'
'spec-transaction-begin-rollback.R'
'spec-transaction-with-transaction.R' 'spec-transaction.R'
'spec-compliance-methods.R' 'spec-compliance-read-only.R'
'spec-compliance.R' 'spec-stress-driver.R'
'spec-stress-connection.R' 'spec-stress.R' 'spec-.R'
'test-all.R' 'test-getting-started.R' 'test-driver.R'
'test-connection.R' 'test-result.R' 'test-sql.R' 'test-meta.R'
'test-transaction.R' 'test-compliance.R' 'test-stress.R'
'tweaks.R' 'utf8.R' 'utils.R'
NeedsCompilation: no
Packaged: 2016-12-03 07:33:52 UTC; muelleki
Author: Kirill Müller [aut, cre],
RStudio [cph]
Maintainer: Kirill Müller