From 69e9c8188a9ae699c61b8c22ed8b7099f4c7d50a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 18:12:11 +0200 Subject: [PATCH 1/8] move run_bind_tester() --- R/spec-meta-bind.R | 97 +++++++++++++++++++++++----------------------- 1 file changed, 48 insertions(+), 49 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index bb8fe4c65..5e12e802d 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -27,6 +27,51 @@ #' #' \pkg{DBI} clients execute parametrized statements as follows: #' +run_bind_tester <- function() { + extra_obj <- self$extra_imp$new() + + placeholder <- placeholder_fun(length(values)) + + if (extra_obj$requires_names() && is.null(names(placeholder))) { + # wrong_name test only valid for named placeholders + return() + } + + 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 = ", ")) + res <- dbSendQuery(con, query) + on.exit(expect_error(dbClearResult(res), NA)) + + bind_values <- values + if (!is.null(names(placeholder))) { + names(bind_values) <- names(placeholder) + } + + 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))) + extra_obj$check_return_value(bind_res, res) + + rows <- dbFetch(res) + expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) + + if (extra_obj$is_repeated()) { + dbBind(res, as.list(bind_values)) + + rows <- dbFetch(res) + expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) + } #' 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. @@ -51,7 +96,9 @@ #' 1. Repeat 2. and 3. as necessary. #' 1. Close the result set via [DBI::dbClearResult()]. #' -NULL +} + + #' @template dbispec-sub-wip #' @format NULL @@ -259,54 +306,6 @@ test_select_bind_one <- function(con, placeholder_fun, values, bind_tester$run() } -run_bind_tester <- function() { - extra_obj <- self$extra_imp$new() - - placeholder <- placeholder_fun(length(values)) - - if (extra_obj$requires_names() && is.null(names(placeholder))) { - # wrong_name test only valid for named placeholders - return() - } - - 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 = ", ")) - res <- dbSendQuery(con, query) - on.exit(expect_error(dbClearResult(res), NA)) - - bind_values <- values - if (!is.null(names(placeholder))) { - names(bind_values) <- names(placeholder) - } - - 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))) - extra_obj$check_return_value(bind_res, res) - - rows <- dbFetch(res) - expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) - - if (extra_obj$is_repeated()) { - dbBind(res, as.list(bind_values)) - - rows <- dbFetch(res) - expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) - } -} - - # BindTesterExtra --------------------------------------------------------- BindTesterExtra <- R6::R6Class( From eed9a98ea6a6e132a5d437ec33bcd86d3c6d0681 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:37:11 +0200 Subject: [PATCH 2/8] extract send_query() member function --- R/spec-meta-bind.R | 41 +++++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index 5e12e802d..a125fb2b2 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -30,22 +30,17 @@ run_bind_tester <- function() { extra_obj <- self$extra_imp$new() - placeholder <- placeholder_fun(length(values)) - if (extra_obj$requires_names() && is.null(names(placeholder))) { # wrong_name test only valid for named placeholders return() } - 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 = ", ")) - res <- dbSendQuery(con, query) + #' 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. + res <- send_query() on.exit(expect_error(dbClearResult(res), NA)) bind_values <- values @@ -72,11 +67,6 @@ run_bind_tester <- function() { rows <- dbFetch(res) expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) } -#' 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. #' 1. Call [dbBind()] on the `DBIResult` object with a list #' that specifies actual values for the placeholders. #' All elements in this list must have the same lengths and contain values @@ -288,7 +278,7 @@ test_select_bind_one <- function(con, placeholder_fun, values, extra <- match.arg(extra) bind_tester <- BindTester$new(con) - bind_tester$placeholder_fun <- placeholder_fun + bind_tester$placeholder <- placeholder_fun(length(values)) bind_tester$values <- values bind_tester$type <- type bind_tester$transform$input <- transform_input @@ -410,12 +400,27 @@ BindTester <- R6::R6Class( run = run_bind_tester, con = NULL, - placeholder_fun = NULL, + placeholder = 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 + ), + + private = list( + 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) + } ) ) From 089e437eb9454a5bfdc7f4ef9356192bac1c1065 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:41:09 +0200 Subject: [PATCH 3/8] use extra_obj as member --- R/spec-meta-bind.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index a125fb2b2..1d9738ef2 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -28,8 +28,6 @@ #' \pkg{DBI} clients execute parametrized statements as follows: #' run_bind_tester <- function() { - extra_obj <- self$extra_imp$new() - if (extra_obj$requires_names() && is.null(names(placeholder))) { # wrong_name test only valid for named placeholders return() @@ -284,7 +282,8 @@ test_select_bind_one <- function(con, placeholder_fun, values, bind_tester$transform$input <- transform_input bind_tester$transform$output <- transform_output bind_tester$expect$fun <- expect - bind_tester$extra_imp <- switch( + + extra_imp <- switch( extra, return_value = BindTesterExtraReturnValue, too_many = BindTesterExtraTooMany, @@ -293,6 +292,8 @@ test_select_bind_one <- function(con, placeholder_fun, values, repeated = BindTesterExtraRepeated, BindTesterExtra ) + bind_tester$extra_obj <- extra_imp$new() + bind_tester$run() } @@ -405,7 +406,7 @@ BindTester <- R6::R6Class( type = "character(10)", transform = list(input = as.character, output = function(x) trimws(x, "right")), expect = list(fun = expect_identical), - extra_imp = BindTesterExtra + extra_obj = NULL ), private = list( From 7e79138643cf10f2d765ed3f976f8dca6b338d53 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:42:48 +0200 Subject: [PATCH 4/8] on.exit --- R/spec-meta-bind.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index 1d9738ef2..d2948ee94 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -39,6 +39,9 @@ run_bind_tester <- function() { #' Mixing placeholders (in particular, named and unnamed ones) is not #' recommended. res <- send_query() + #' (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)) bind_values <- values From 7eeeb8d0668e9e7e3f51f40c55421c47a99dd401 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:52:35 +0200 Subject: [PATCH 5/8] extract bind() --- R/spec-meta-bind.R | 46 ++++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index d2948ee94..645986b69 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -44,20 +44,25 @@ run_bind_tester <- function() { #' 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) } - - 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))) + #' 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() - } - - bind_res <- withVisible(dbBind(res, as.list(bind_values))) - extra_obj$check_return_value(bind_res, res) rows <- dbFetch(res) expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) @@ -68,15 +73,6 @@ run_bind_tester <- function() { rows <- dbFetch(res) expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) } -#' 1. Call [dbBind()] on the `DBIResult` object with a list -#' that specifies actual values for the placeholders. -#' 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. -#' 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. #' 1. Retrieve the data or the number of affected rows from the `DBIResult` object. #' - For queries issued by `dbSendQuery()`, #' call [DBI::dbFetch()]. @@ -424,6 +420,20 @@ BindTester <- R6::R6Class( typed_placeholder, " as ", value_names, collapse = ", ")) dbSendQuery(con, query) + }, + + 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, as.list(error_bind_values))) + return(FALSE) + } + + bind_res <- withVisible(dbBind(res, as.list(bind_values))) + extra_obj$check_return_value(bind_res, res) + + TRUE } ) ) From 5a8e9a9c02ba62e4d7b85989f9ccce71d74027d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:53:35 +0200 Subject: [PATCH 6/8] move text --- R/spec-meta-bind.R | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index 645986b69..06f99f9e9 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -33,6 +33,7 @@ run_bind_tester <- function() { 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. @@ -64,25 +65,26 @@ run_bind_tester <- function() { if (!bind(res, bind_values)) return() + #' 1. Retrieve the data or the number of affected rows from the `DBIResult` object. + #' - For queries issued by `dbSendQuery()`, + #' call [DBI::dbFetch()]. rows <- dbFetch(res) expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) + #' - For statements issued by `dbSendStatements()`, + #' call [DBI::dbGetRowsAffected()]. + #' (Execution begins immediately after the `dbBind()` call. + #' Calls to `dbFetch()` are ignored.) + # FIXME + #' 1. Repeat 2. and 3. as necessary. if (extra_obj$is_repeated()) { dbBind(res, as.list(bind_values)) rows <- dbFetch(res) expect$fun(transform$output(Reduce(c, rows)), transform$input(unname(values))) } -#' 1. Retrieve the data or the number of affected rows from the `DBIResult` object. -#' - For queries issued by `dbSendQuery()`, -#' call [DBI::dbFetch()]. -#' - For statements issued by `dbSendStatements()`, -#' call [DBI::dbGetRowsAffected()]. -#' (Execution begins immediately after the `dbBind()` call. -#' Calls to `dbFetch()` are ignored.) -#' 1. Repeat 2. and 3. as necessary. -#' 1. Close the result set via [DBI::dbClearResult()]. -#' + + #' 1. Close the result set via [DBI::dbClearResult()]. } From 87629ad8fee93e7754b6823327ae99129365e4c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:55:50 +0200 Subject: [PATCH 7/8] un-paren --- R/spec-meta-bind.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/spec-meta-bind.R b/R/spec-meta-bind.R index 06f99f9e9..178016f77 100644 --- a/R/spec-meta-bind.R +++ b/R/spec-meta-bind.R @@ -40,9 +40,9 @@ run_bind_tester <- function() { #' Mixing placeholders (in particular, named and unnamed ones) is not #' recommended. res <- send_query() - #' (It is good practice to register a call to [DBI::dbClearResult()] via + #' It is good practice to register a call to [DBI::dbClearResult()] via #' [on.exit()] right after calling `dbSendQuery()`, see the last - #' enumeration item.) + #' enumeration item. on.exit(expect_error(dbClearResult(res), NA)) #' 1. Construct a list with parameters From 4b6818e5b426f7b62e700aa375c6d912f5244834 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Oct 2016 22:56:32 +0200 Subject: [PATCH 8/8] document --- man/DBIspec.Rd | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/man/DBIspec.Rd b/man/DBIspec.Rd index b29626dd8..15bf5b24e 100644 --- a/man/DBIspec.Rd +++ b/man/DBIspec.Rd @@ -127,15 +127,20 @@ that contains placeholders, store the returned \code{\linkS4class{DBIResult}} object in a variable. Mixing placeholders (in particular, named and unnamed ones) is not recommended. -\item Call \code{\link[=dbBind]{dbBind()}} on the \code{DBIResult} object with a list -that specifies actual values for the placeholders. -All elements in this list must have the same lengths and contain values -supported by the backend; a \code{\link[=data.frame]{data.frame()}} is internally stored as such -a list. +It is good practice to register a call to \code{\link[DBI:dbClearResult]{DBI::dbClearResult()}} via +\code{\link[=on.exit]{on.exit()}} right after calling \code{dbSendQuery()}, see the last +enumeration item. +\item Construct a list with parameters +that specify actual values for the placeholders. 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. +All elements in this list must have the same lengths and contain values +supported by the backend; a \code{\link[=data.frame]{data.frame()}} is internally stored as such +a list. +The parameter list is passed a call to \code{\link[=dbBind]{dbBind()}} on the \code{DBIResult} +object. \item Retrieve the data or the number of affected rows from the \code{DBIResult} object. \itemize{ \item For queries issued by \code{dbSendQuery()},