diff --git a/DESCRIPTION b/DESCRIPTION index 012b375..34ce3f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,6 +15,7 @@ Imports: S7, utils Suggests: + DBI, testthat (>= 3.0.0) URL: https://github.com/nbenn/sqlr BugReports: https://github.com/nbenn/sqlr/issues @@ -38,3 +39,4 @@ Collate: 'order.R' 'render.R' 'compare.R' + 'conformance.R' diff --git a/NAMESPACE b/NAMESPACE index f6fb647..78a5ee1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ export(sqlr_catalog) export(sqlr_char) export(sqlr_check) export(sqlr_column) +export(sqlr_conformance_types) export(sqlr_constraint) export(sqlr_date) export(sqlr_decimal_type) @@ -46,6 +47,7 @@ export(sqlr_smallint) export(sqlr_sql) export(sqlr_string_type) export(sqlr_table) +export(sqlr_test_types) export(sqlr_text) export(sqlr_time) export(sqlr_time_type) diff --git a/R/conformance.R b/R/conformance.R new file mode 100644 index 0000000..ebbae4c --- /dev/null +++ b/R/conformance.R @@ -0,0 +1,132 @@ +#' Dialect conformance tests +#' +#' A dialect package calls `sqlr_test_types()` from its test suite. It +#' registers one test per entry of `sqlr_conformance_types()`. Each renders a +#' table holding a single column of that type, creates it on a live database, +#' reflects it and expects an empty [sqlr_diff()]. The list covers every type +#' class sqlr models and each parameter it carries, and lives here rather than +#' in the dialects, so a type added to sqlr is tested in every dialect without +#' anyone adding it to a test. +#' +#' A dialect that cannot represent a type declares it in `skip`, with a reason, +#' and the test for that type is skipped citing it. +#' +#' @param connect Function of no arguments returning a `DBIConnection`, or +#' skipping when no database is available. It is called once per type, and +#' the connection is closed afterwards. The dialect is resolved by +#' [sqlr_for()], and the table is created in the connection's default schema +#' and removed again. +#' @param skip Named character vector: each name is an entry of +#' `sqlr_conformance_types()` the dialect cannot represent, each value the +#' reason. +#' +#' @return `sqlr_test_types()` returns `NULL` invisibly; +#' `sqlr_conformance_types()` returns a named list of [sqlr_type]s. +#' +#' @examples +#' names(sqlr_conformance_types()) +#' +#' # in tests/testthat/ of a dialect package, e.g. +#' # sqlr_test_types( +#' # function() DBI::dbConnect(RSQLite::SQLite(), ":memory:"), +#' # skip = c(time_tz = "SQLite has no time zone-aware time type") +#' # ) +#' +#' @export +sqlr_test_types <- function(connect, skip = character()) { + stopifnot(is.function(connect)) + + types <- sqlr_conformance_types() + check_skip(skip, names(types)) + + for (name in names(types)) { + testthat::test_that(paste0("sqlr type round trip: ", name), { + if (name %in% names(skip)) { + testthat::skip(paste0(name, ": ", skip[[name]])) + } + + con <- connect() + on.exit(DBI::dbDisconnect(con)) + + differences <- round_trip_type(con, name, types[[name]]) + testthat::expect( + length(differences) == 0L, + paste(c("Written vs reflected:", differences), collapse = "\n") + ) + }) + } + + invisible(NULL) +} + +#' @rdname sqlr_test_types +#' @export +sqlr_conformance_types <- function() { + list( + tinyint = sqlr_integer_type(bytes = 1L), + smallint = sqlr_smallint(), + integer = sqlr_int(), + bigint = sqlr_bigint(), + integer_unsigned = sqlr_int(unsigned = TRUE), + real = sqlr_real(), + double = sqlr_double(), + numeric = sqlr_numeric(), + numeric_precision = sqlr_numeric(10), + numeric_scale = sqlr_numeric(10, 2), + char = sqlr_char(3), + char_unsized = sqlr_char(), + varchar = sqlr_varchar(255), + text = sqlr_text(), + blob = sqlr_blob(), + varbinary = sqlr_blob(16), + binary = sqlr_binary_type(size = 16L, fixed = TRUE), + boolean = sqlr_boolean(), + date = sqlr_date(), + time = sqlr_time(), + time_precision = sqlr_time(precision = 3), + time_tz = sqlr_time(with_timezone = TRUE), + timestamp = sqlr_timestamp(), + timestamp_precision = sqlr_timestamp(precision = 3), + timestamp_tz = sqlr_timestamp(with_timezone = TRUE), + json = sqlr_json(), + json_binary = sqlr_json(binary = TRUE), + uuid = sqlr_uuid() + ) +} + +check_skip <- function(skip, types) { + named <- length(names(skip)) == length(skip) && all(nzchar(names(skip))) + reasoned <- is.character(skip) && !anyNA(skip) && all(nzchar(skip)) + if (!named || !reasoned) { + stop("`skip` must name each type and give a reason for it", call. = FALSE) + } + + unknown <- setdiff(names(skip), types) + if (length(unknown)) { + stop( + "`skip` names types sqlr_conformance_types() does not have: ", + paste0(unknown, collapse = ", "), + call. = FALSE + ) + } +} + +round_trip_type <- function(con, name, type) { + dialect <- sqlr_for(con) + table <- sqlr_table( + paste0("sqlr_", name, "_", Sys.getpid()), + sqlr_column("x", type) + ) + + on.exit(DBI::dbRemoveTable(con, table@name, fail_if_missing = FALSE)) + for (stmt in sqlr_render(table, dialect)) { + DBI::dbExecute(con, stmt) + } + + reflected <- schema_table(sqlr_reflect(con, dialect = dialect), table@name) + if (is.null(reflected)) { + return(paste0("table ", table@name, " was not reflected")) + } + + sqlr_diff(table, reflected) +} diff --git a/README.Rmd b/README.Rmd index 205f87d..84732b2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -147,7 +147,10 @@ no dialect registered is an error rather than a guess. Writing one means implementing the protocol in `?sqlr_render` and `?sqlr_reflect`: how types spell in both directions, and whatever the engine -does differently. +does differently. Its test suite then calls `sqlr_test_types()`, which writes +every type sqlr models to a live database and checks that each reads back +unchanged. A type the engine cannot represent is declared with a reason and +skipped. ## Scope diff --git a/README.md b/README.md index 731fd76..c16e196 100644 --- a/README.md +++ b/README.md @@ -160,7 +160,10 @@ than a guess. Writing one means implementing the protocol in `?sqlr_render` and `?sqlr_reflect`: how types spell in both directions, and whatever the -engine does differently. +engine does differently. Its test suite then calls `sqlr_test_types()`, +which writes every type sqlr models to a live database and checks that +each reads back unchanged. A type the engine cannot represent is +declared with a reason and skipped. ## Scope diff --git a/man/sqlr_test_types.Rd b/man/sqlr_test_types.Rd new file mode 100644 index 0000000..da8c5c3 --- /dev/null +++ b/man/sqlr_test_types.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/conformance.R +\name{sqlr_test_types} +\alias{sqlr_test_types} +\alias{sqlr_conformance_types} +\title{Dialect conformance tests} +\usage{ +sqlr_test_types(connect, skip = character()) + +sqlr_conformance_types() +} +\arguments{ +\item{connect}{Function of no arguments returning a `DBIConnection`, or +skipping when no database is available. It is called once per type, and +the connection is closed afterwards. The dialect is resolved by +[sqlr_for()], and the table is created in the connection's default schema +and removed again.} + +\item{skip}{Named character vector: each name is an entry of +`sqlr_conformance_types()` the dialect cannot represent, each value the +reason.} +} +\value{ +`sqlr_test_types()` returns `NULL` invisibly; + `sqlr_conformance_types()` returns a named list of [sqlr_type]s. +} +\description{ +A dialect package calls `sqlr_test_types()` from its test suite. It +registers one test per entry of `sqlr_conformance_types()`. Each renders a +table holding a single column of that type, creates it on a live database, +reflects it and expects an empty [sqlr_diff()]. The list covers every type +class sqlr models and each parameter it carries, and lives here rather than +in the dialects, so a type added to sqlr is tested in every dialect without +anyone adding it to a test. +} +\details{ +A dialect that cannot represent a type declares it in `skip`, with a reason, +and the test for that type is skipped citing it. +} +\examples{ +names(sqlr_conformance_types()) + +# in tests/testthat/ of a dialect package, e.g. +# sqlr_test_types( +# function() DBI::dbConnect(RSQLite::SQLite(), ":memory:"), +# skip = c(time_tz = "SQLite has no time zone-aware time type") +# ) + +} diff --git a/tests/testthat/test-conformance.R b/tests/testthat/test-conformance.R new file mode 100644 index 0000000..779edf8 --- /dev/null +++ b/tests/testthat/test-conformance.R @@ -0,0 +1,59 @@ +extends_type <- function(cls) { + parent <- cls@parent + inherits(parent, "S7_class") && + (identical(parent, sqlr_type) || extends_type(parent)) +} + +test_that("the conformance types cover every type class and parameter", { + ns <- asNamespace("sqlr") + classes <- Filter( + function(x) inherits(x, "S7_class") && extends_type(x), + mget(ls(ns), envir = ns) + ) + classes$sqlr_other_type <- NULL + + types <- sqlr_conformance_types() + uncovered <- character() + + for (cls in classes) { + variants <- Filter(function(x) identical(S7_class(x), cls), types) + if (!length(variants)) { + uncovered <- c(uncovered, cls@name) + next + } + + default <- cls() + for (p in setdiff(names(cls@properties), "raw")) { + varied <- vapply( + variants, + function(x) !identical(prop(x, p), prop(default, p)), + logical(1L) + ) + if (!any(varied)) uncovered <- c(uncovered, paste0(cls@name, "@", p)) + } + } + + expect_equal(uncovered, character()) +}) + +test_that("each conformance type has its own name", { + types <- sqlr_conformance_types() + + expect_false(anyDuplicated(names(types)) > 0L) + expect_true(all(nzchar(names(types)))) +}) + +test_that("a skipped type must be known and come with a reason", { + connect <- function() stop("not reached") + + expect_error( + sqlr_test_types(connect, skip = c(no_such_type = "why")), + "no_such_type" + ) + expect_error(sqlr_test_types(connect, skip = c(uuid = "")), "reason") + expect_error(sqlr_test_types(connect, skip = "why"), "reason") +}) + +test_that("a connection rather than a way to open one is rejected", { + expect_error(sqlr_test_types(list()), "is.function") +})