Merge branch 'f-refactor-bind'

- Refactor tests for `dbBind()`, test is run by `BindTester` class, and behavior is specified by members and by instances of the new `BindTesterExtra` class.
r-dbi · Oct 1, 2016 · 854ca9a · 854ca9a
2 parents 861fc76 + f3283c1
commit 854ca9a
Show file tree

Hide file tree

Showing 2 changed files with 156 additions and 26 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -7,14 +7,15 @@ Authors@R: c( person(given = "Kirill", family = "Müller", role =
         person("RStudio", role = "cph") )
 Description: A helper that tests 'DBI' back ends for conformity
     to the interface, currently work in progress.
-Depends: 
+Depends:
     R (>= 3.0.0)
-Imports: 
+Imports:
     methods,
+    R6,
     testthat (>= 1.0.2),
     withr,
     DBI (>= 0.4-9)
-Suggests: 
+Suggests:
     devtools,
     lintr,
     knitr,
@@ -25,7 +26,7 @@ Encoding: UTF-8
 BugReports: https://github.com/rstats-db/DBItest/issues
 RoxygenNote: 5.0.1.9000
 VignetteBuilder: knitr
-Collate: 
+Collate:
     'DBItest.R'
     'context.R'
     'expectations.R'

diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R
@@ -177,17 +177,39 @@ test_select_bind <- function(con, placeholder_fun, ...) {
 }
 
 test_select_bind_one <- function(con, placeholder_fun, values,
-                             type = "character(10)",
-                             transform_input = as.character,
-                             transform_output = function(x) trimws(x, "right"),
-                             expect = expect_identical,
-                             extra = c("none", "return_value", "too_many",
-                                       "not_enough", "wrong_name", "repeated")) {
+                                 type = "character(10)",
+                                 transform_input = as.character,
+                                 transform_output = function(x) trimws(x, "right"),
+                                 expect = expect_identical,
+                                 extra = c("none", "return_value", "too_many",
+                                           "not_enough", "wrong_name", "repeated")) {
   extra <- match.arg(extra)
 
+  bind_tester <- BindTester$new(con)
+  bind_tester$placeholder_fun <- placeholder_fun
+  bind_tester$values <- values
+  bind_tester$type <- type
+  bind_tester$transform$input <- transform_input
+  bind_tester$transform$output <- transform_output
+  bind_tester$expect$fun <- expect_identical
+  bind_tester$extra_imp <- switch(
+    extra,
+    return_value = BindTesterExtraReturnValue,
+    too_many = BindTesterExtraTooMany,
+    not_enough = BindTesterExtraNotEnough,
+    wrong_name = BindTesterExtraWrongName,
+    repeated = BindTesterExtraRepeated,
+    BindTesterExtra
+  )
+  bind_tester$run()
+}
+
+run_bind_tester <- function() {
+  extra_obj <- self$extra_imp$new()
+
   placeholder <- placeholder_fun(length(values))
 
-  if (extra == "wrong_name" && is.null(names(placeholder))) {
+  if (extra_obj$requires_names() && is.null(names(placeholder))) {
     # wrong_name test only valid for named placeholders
     return()
   }
@@ -208,37 +230,144 @@ test_select_bind_one <- function(con, placeholder_fun, values,
     names(bind_values) <- names(placeholder)
   }
 
-  error_bind_values <- switch(
-    extra,
-    too_many = c(bind_values, bind_values[[1L]]),
-    not_enough = bind_values[-1L],
-    wrong_name = stats::setNames(bind_values, paste0("bogus",
-                                                     names(bind_values))),
-    bind_values
-  )
+  error_bind_values <- extra_obj$patch_bind_values(bind_values)
 
   if (!identical(bind_values, error_bind_values)) {
     expect_error(dbBind(res, as.list(error_bind_values)))
     return()
   }
 
   bind_res <- withVisible(dbBind(res, as.list(bind_values)))
-  if (extra == "return_value") {
-    expect_false(bind_res$visible)
-    expect_identical(res, bind_res$value)
-  }
+  extra_obj$check_return_value(bind_res, res)
 
   rows <- dbFetch(res)
-  expect(transform_output(Reduce(c, rows)), transform_input(unname(values)))
+  expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values)))
 
-  if (extra == "repeated") {
+  if (extra_obj$is_repeated()) {
     dbBind(res, as.list(bind_values))
 
     rows <- dbFetch(res)
-    expect(transform_output(Reduce(c, rows)), transform_input(unname(values)))
+    expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values)))
   }
 }
 
+
+# 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
+  )
+)
+
+
+# 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,
+
+    con = NULL,
+    placeholder_fun = NULL,
+    values = NULL,
+    type = "character(10)",
+    transform = list(input = as.character, output = function(x) trimws(x, "right")),
+    expect = list(fun = expect_identical),
+    extra_imp = BindTesterExtra
+  )
+)
+
+
+# make_placeholder_fun ----------------------------------------------------
+
 #' Create a function that creates n placeholders
 #'
 #' For internal use by the \code{placeholder_format} tweak.