Merge branch 'main' into edwindj-main

.github/workflows/pr-commands.yaml

@@ -45,7 +45,7 @@ jobs:
       - name: Install dependencies
         run: Rscript -e 'install.packages("styler")'
       - name: Style
-        run: Rscript -e 'styler::style_pkg()'
+        run: Rscript -e 'styler::style_pkg(strict = FALSE)'
       - name: commit
         run: |
           git add \*.R

.github/workflows/revdep.yaml

@@ -155,7 +155,7 @@ jobs:
 
       - name: Install local package
         run: |
-          remotes::install_local(".")
+          remotes::install_local(".", force = TRUE)
         shell: Rscript {0}
 
       - name: Session info new

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: RSQLite
 Title: 'SQLite' Interface for R
-Version: 2.2.4.9000
-Date: 2021-03-12
+Version: 2.2.5.9001
+Date: 2021-04-05
 Authors@R: 
     c(person(given = "Kirill",
              family = "M\u00fcller",
@@ -55,7 +55,6 @@ Suggests:
     testthat,
     xml2
 LinkingTo: 
-    BH (>= 1.75.0-0),
     plogr (>= 0.2.0),
     Rcpp
 VignetteBuilder: 

NEWS.md

@@ -1,10 +1,21 @@
 <!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->
 
-# RSQLite 2.2.4.9000 (2021-03-12)
+# RSQLite 2.2.5.9001 (2021-04-05)
+
+- Upgrade bundled SQLite to 3.35.4 (#361).
+
+
+# RSQLite 2.2.5.9000 (2021-03-25)
 
 - Same as previous version.
 
 
+# RSQLite 2.2.5 (2021-03-25)
+
+- Upgrade bundled SQLite to version 3.35.2 (#357).
+- If the busy handler fails, the transaction is aborted explicitly (#348, @gaborcsardi).
+
+
 # RSQLite 2.2.4 (2021-03-12)
 
 ## Features

R/SQLiteConnection.R

@@ -215,10 +215,9 @@ setMethod("dbGetInfo", "SQLiteConnection", function(dbObj, ...) {
 #'
 #' Handler callbacks are useful for debugging concurrent behavior, or to
 #' implement a more sophisticated busy algorithm. The latter is currently
-#' considered experimental in RSQLite, especially with respect to errors and
-#' interruption in the handler function. According to our current tests,
-#' after the handler function fails or is interrupted, the database
-#' connection is still functional, but this might not be always the case.
+#' considered experimental in RSQLite. If the callback function fails, then
+#' RSQLite will print a warning, and the transaction is aborted with a
+#' "database is locked" error.
 #'
 #' Note that every database connection has its own busy timeout or handler
 #' function.
@@ -243,8 +242,8 @@ sqliteSetBusyHandler <- function(dbObj, handler) {
   stopifnot(
     inherits(dbObj, "SQLiteConnection"),
     is.null(handler) ||
-    is.function(handler) ||
-    (is.numeric(handler) && length(handler) == 1 && !is.na(handler))
+      is.function(handler) ||
+      (is.numeric(handler) && length(handler) == 1 && !is.na(handler))
   )
   if (is.numeric(handler)) handler <- as.integer(handler)
   set_busy_handler(dbObj@ptr, handler)

R/SQLiteDriver.R

@@ -21,10 +21,25 @@ setClass("SQLiteDriver",
 
 #' @rdname SQLiteDriver-class
 #' @export
-setMethod("dbDataType", "SQLiteDriver", function(dbObj, obj, ...) {
-  if (is.factor(obj)) return("TEXT")
-  if (is.data.frame(obj)) return(callNextMethod(dbObj, obj))
-  if (is.integer64(obj)) return("INTEGER")
+setMethod("dbDataType", "SQLiteDriver", function(dbObj, obj, ..., extended_types = FALSE) {
+  if (is.factor(obj)) {
+    return("TEXT")
+  }
+  if (is.data.frame(obj)) {
+    return(callNextMethod(dbObj, obj))
+  }
+  if (is.integer64(obj)) {
+    return("INTEGER")
+  }
+  if (extended_types && methods::is(obj, "Date")) {
+    return("DATE")
+  }
+  if (extended_types && methods::is(obj, "POSIXct")) {
+    return("TIMESTAMP")
+  }
+  if (extended_types && methods::is(obj, "hms")) {
+    return("TIME")
+  }
 
   switch(typeof(obj),
     integer = "INTEGER",

R/connect.R

@@ -33,9 +33,9 @@ SQLite <- function(...) {
 
 # From https://www.sqlite.org/c3ref/c_open_autoproxy.html
 #' @export
-SQLITE_RW <-  0x00000002L
+SQLITE_RW <- 0x00000002L
 #' @export
-SQLITE_RO <-  0x00000001L
+SQLITE_RO <- 0x00000001L
 #' @export
 SQLITE_RWC <- bitwOr(bitwOr(0x00000004L, 0x00000002L), 0x00000040L)
 # read/write + create + url
@@ -119,9 +119,9 @@ SQLITE_RWC <- bitwOr(bitwOr(0x00000004L, 0x00000002L), 0x00000040L)
 #'
 #' # Or do it in batches
 #' rs <- dbSendQuery(con, "SELECT * FROM USArrests")
-#' d1 <- dbFetch(rs, n = 10)      # extract data in chunks of 10 rows
+#' d1 <- dbFetch(rs, n = 10) # extract data in chunks of 10 rows
 #' dbHasCompleted(rs)
-#' d2 <- dbFetch(rs, n = -1)      # extract all remaining data
+#' d2 <- dbFetch(rs, n = -1) # extract all remaining data
 #' dbHasCompleted(rs)
 #' dbClearResult(rs)
 #'
@@ -171,7 +171,8 @@ setMethod("dbConnect", "SQLiteDriver",
         error = function(e) {
           warning("Couldn't set cache size: ", conditionMessage(e), "\n",
             "Use `cache_size` = NULL to turn off this warning.",
-            call. = FALSE)
+            call. = FALSE
+          )
         }
       )
     }
@@ -182,8 +183,9 @@ setMethod("dbConnect", "SQLiteDriver",
         dbExecute(conn, sprintf("PRAGMA synchronous=%s", synchronous)),
         error = function(e) {
           warning("Couldn't set synchronous mode: ", conditionMessage(e), "\n",
-                  "Use `synchronous` = NULL to turn off this warning.",
-                  call. = FALSE)
+            "Use `synchronous` = NULL to turn off this warning.",
+            call. = FALSE
+          )
         }
       )
     }
@@ -196,7 +198,7 @@ setMethod("dbConnect", "SQLiteDriver",
       conn@ptr,
       function(x) {
         if (dbIsValid(conn)) {
-          warning_once("call dbDisconnect() when finished working with a connection");
+          warning_once("call dbDisconnect() when finished working with a connection")
         }
       }
     )
@@ -209,16 +211,22 @@ setMethod("dbConnect", "SQLiteDriver",
 )
 
 check_vfs <- function(vfs) {
-  if (is.null(vfs) || vfs == "") return("")
+  if (is.null(vfs) || vfs == "") {
+    return("")
+  }
 
   if (.Platform[["OS.type"]] == "windows") {
     warning("vfs customization not available on this platform.",
-      " Ignoring value: vfs = ", vfs, call. = FALSE)
+      " Ignoring value: vfs = ", vfs,
+      call. = FALSE
+    )
     return("")
   }
 
-  match.arg(vfs, c("unix-posix", "unix-afp", "unix-flock", "unix-dotfile",
-    "unix-none"))
+  match.arg(vfs, c(
+    "unix-posix", "unix-afp", "unix-flock", "unix-dotfile",
+    "unix-none"
+  ))
 }
 
 # From the SQLite docs: If the filename is ":memory:", then a private,
@@ -234,13 +242,15 @@ is_url_or_special_filename <- function(x) grepl("^(?:file|http|ftp|https|):", x)
 
 #' @export
 #' @rdname SQLite
-setMethod("dbConnect", "SQLiteConnection", function(drv, ...){
+setMethod("dbConnect", "SQLiteConnection", function(drv, ...) {
   if (drv@dbname %in% c("", ":memory:", "file::memory:")) {
     stop("Can't clone a temporary database", call. = FALSE)
   }
 
-  dbConnect(SQLite(), drv@dbname, vfs = drv@vfs, flags = drv@flags,
-    loadable.extensions = drv@loadable.extensions)
+  dbConnect(SQLite(), drv@dbname,
+    vfs = drv@vfs, flags = drv@flags,
+    loadable.extensions = drv@loadable.extensions
+  )
 })
 
 

R/copy.R

@@ -25,14 +25,16 @@
 #'
 #' dbDisconnect(con)
 sqliteCopyDatabase <- function(from, to) {
-  if (!is(from, "SQLiteConnection"))
+  if (!is(from, "SQLiteConnection")) {
     stop("'from' must be a SQLiteConnection object")
+  }
   if (is.character(to)) {
     to <- dbConnect(SQLite(), to)
     on.exit(dbDisconnect(to), add = TRUE)
   }
-  if (!is(to, "SQLiteConnection"))
+  if (!is(to, "SQLiteConnection")) {
     stop("'to' must be a SQLiteConnection object")
+  }
 
   connection_copy_database(from@ptr, to@ptr)
   invisible(NULL)

R/datasetsDb.R

@@ -15,5 +15,6 @@
 #' dbDisconnect(db)
 datasetsDb <- function() {
   dbConnect(SQLite(), system.file("db", "datasets.sqlite", package = "RSQLite"),
-            flags = SQLITE_RO)
+    flags = SQLITE_RO
+  )
 }

R/deprecated.R

@@ -59,8 +59,10 @@ sqliteBuildTableDefinition <- function(con, name, value, field.types = NULL,
   value <- sqlColumnToRownames(value, row.names)
 
   if (is.null(field.types)) {
-    field.types <- vapply(value, dbDataType, dbObj = con,
-      FUN.VALUE = character(1))
+    field.types <- vapply(value, dbDataType,
+      dbObj = con,
+      FUN.VALUE = character(1)
+    )
   }
   # Escape field names
   names(field.types) <- dbQuoteIdentifier(con, names(field.types))
@@ -93,7 +95,7 @@ isIdCurrent <- function(obj) {
 #' @keywords internal
 #' @export
 setMethod("make.db.names",
-  signature(dbObj="SQLiteConnection", snames = "character"),
+  signature(dbObj = "SQLiteConnection", snames = "character"),
   function(dbObj, snames, keywords, unique, allow.keywords, ...) {
     warning_once("RSQLite::make.db.names() is deprecated, please switch to DBI::dbQuoteIdentifier().")
     make.db.names.default(snames, keywords, unique, allow.keywords)
@@ -109,7 +111,7 @@ setMethod("SQLKeywords", "SQLiteConnection", function(dbObj, ...) {
 #' @export
 #' @rdname make.db.names-SQLiteConnection-character-method
 setMethod("isSQLKeyword",
-  signature(dbObj="SQLiteConnection", name="character"),
+  signature(dbObj = "SQLiteConnection", name = "character"),
   function(dbObj, name, keywords, case, ...) {
     warning_once("RSQLite::isSQLKeyword() is deprecated, please switch to DBI::dbQuoteIdentifier().")
     isSQLKeyword.default(name, keywords = .SQL92Keywords, case)
@@ -188,11 +190,13 @@ sqliteQuickColumn <- function(con, table, column) {
 #' @export
 setMethod("dbListResults", "SQLiteConnection", function(conn, ...) {
   warning("Querying the results associated with a connection is no longer supported",
-    call. = FALSE)
-  if (is.null(conn@ref$result))
+    call. = FALSE
+  )
+  if (is.null(conn@ref$result)) {
     list()
-  else
+  } else {
     list(conn@ref$result)
+  }
 })
 
 

R/extensions.R

@@ -27,7 +27,8 @@
 initExtension <- function(db) {
   if (!db@loadable.extensions) {
     stop("Loadable extensions are not enabled for this db connection",
-      call. = FALSE)
+      call. = FALSE
+    )
   }
 
   extension_load(db@ptr, get_lib_path(), "sqlite3_math_init")

R/query.R

@@ -67,8 +67,11 @@ db_bind <- function(res, params, ..., allow_named_superset) {
     }
     unmatched_param_indexes <- setdiff(seq_along(params), param_indexes)
     if (length(unmatched_param_indexes) > 0L) {
-      if (allow_named_superset) errorc <- warningc
-      else errorc <- stopc
+      if (allow_named_superset) {
+        errorc <- warningc
+      } else {
+        errorc <- stopc
+      }
 
       errorc(
         "Named parameters not used in query: ",
@@ -103,9 +106,13 @@ setMethod("dbFetch", "SQLiteResult", function(res, n = -1, ...,
 })
 
 convert_bigint <- function(df, bigint) {
-  if (bigint == "integer64") return(df)
+  if (bigint == "integer64") {
+    return(df)
+  }
   is_int64 <- which(vlapply(df, inherits, "integer64"))
-  if (length(is_int64) == 0) return(df)
+  if (length(is_int64) == 0) {
+    return(df)
+  }
 
   as_bigint <- switch(bigint,
     integer = as.integer,

R/regularExpressions.R

@@ -24,7 +24,8 @@
 initRegExp <- function(db) {
   if (!db@loadable.extensions) {
     stop("Loadable extensions are not enabled for this db connection",
-         call. = FALSE)
+      call. = FALSE
+    )
   }
 
   extension_load(db@ptr, get_lib_path(), "sqlite3_regexp_init")