Remove the hacky C code, use tracing only (#167)

* also check devtools::test()

* Oops, need to clear first

* Oops, also need devtools

* Oops passwords

* Go from C drama to tracing

* clean up

* One more mock cleanup

* Stop on failure (Checking that linux will fail...)

* The Linux tests take too long

.github/workflows/check-linux.yaml

@@ -69,7 +69,7 @@ jobs:
       - name: Install R dependencies
         uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: remotes, rcmdcheck, httptest
+          extra-packages: remotes, rcmdcheck, httptest, devtools
 
       - name: Install dev rmarkdown
         run: Rscript -e "remotes::install_github('rstudio/rmarkdown')"

.github/workflows/check-macOS.yaml

@@ -54,7 +54,7 @@ jobs:
       - name: Install R dependencies
         uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: remotes, rcmdcheck, httptest
+          extra-packages: remotes, rcmdcheck, httptest, devtools
 
       - name: Setup databases
         run: bash db-setup/populate-dbs.sh
@@ -73,6 +73,23 @@ jobs:
           name: ${{ runner.os }}-r${{ matrix.config.r }}-results
           path: check
 
+      - name: "devtools::test() check"
+        run: |
+          R CMD INSTALL .
+
+          # wipe databases
+          psql -h 127.0.0.1 -U postgres -f db-setup/postgres-reset.sql
+          mysql -h 127.0.0.1 -u root -e "source db-setup/mariadb-reset.sql"
+
+          # restore
+          psql -h 127.0.0.1 -U postgres -d nycflights -f db-setup/postgres-nycflights.sql
+          mysql -h 127.0.0.1 -u root -e "source db-setup/mariadb-nycflights.sql"
+
+          Rscript -e 'devtools::test(stop_on_failure = TRUE)'
+        env:
+          PGPASSWORD: ${{ env.DBROOTPASS }}
+          MYSQL_PWD: ${{ env.DBROOTPASS }}
+
       - name: Test coverage
         if: contains(matrix.config.r, 'release')
         run: |

NAMESPACE

@@ -5,6 +5,7 @@ export(.dittodb_env)
 export(capture_db_requests)
 export(check_for_pkg)
 export(clean_statement)
+export(dbMockConnect)
 export(db_mock_paths)
 export(db_path_sanitize)
 export(dittodb_debug_level)
@@ -66,4 +67,3 @@ importFrom(methods,new)
 importFrom(methods,setMethod)
 importFrom(utils,head)
 importFrom(utils,tail)
-useDynLib(dittodb, .registration = TRUE)

R/connection.R

@@ -19,6 +19,7 @@
 #' @param dbObj a database object (a connection, result, etc.) for use in
 #'   [`dbGetInfo`]
 #' @param value a value (generally a `data.frame`) for use in [`dbWriteTable`]
+#' @param drv a DB driver for use in [`dbConnect`]
 #'
 #' @name mock-db-methods
 NULL
@@ -46,6 +47,8 @@ setMethod(
 # connection? During tests those won't matter, but for setup and interactive
 # debugging it could be helpful to try and fallback to a real connection if
 # the mock connection isn't working for some reason.
+#' @rdname mock-db-methods
+#' @export
 dbMockConnect <- function(drv, ...) {
   # find a place to store the data
   dots <- list(...)

R/mock-db.R

@@ -83,44 +83,41 @@ with_mock_db <- function(expr) {
   return(eval(expr, parent.frame()))
 }
 
-#' @useDynLib dittodb, .registration = TRUE
-NULL
-
 #' @rdname mockdb
 #' @export
 start_mock_db <- function() {
-  # store the original function for DBI::dbConnect() for use by stop_mock_db()
-  .dittodb_env$orig_dbi_dbconnect <- .Call(
-    duplicate_,
-    get("dbConnect", envir = asNamespace("DBI"), mode = "function")
+  trace_dbi(
+    "dbConnect",
+    # This changes the result of standardGeneric to be our mocked connection,
+    # rather than real S4 dispatch
+    tracer = quote({
+      mock_connection <- dbMockConnect(drv, ...)
+      standardGeneric <- function(...) return(mock_connection)
+    }),
+    where_list = list(sys.frame(), asNamespace("DBI"))
   )
-
-  # TODO: mention which directories are going to be looked in?
-
-  mock_dbconnect(function(...) dbMockConnect(...))
 }
 
 #' @rdname mockdb
 #' @export
 stop_mock_db <- function() {
-  if (is.null(.dittodb_env$orig_dbi_dbconnect)) {
+  mocked_already <- any(
+    inherits(
+      try(get("dbConnect", sys.frame()), silent = TRUE),
+      c("functionWithTrace", "standardGenericWithTrace")
+    ), inherits(
+      try(get("dbConnect", asNamespace("DBI")), silent = TRUE),
+      c("functionWithTrace", "standardGenericWithTrace")
+    )
+  )
+
+  if (!mocked_already) {
     message("There is no mock database being used.")
     return(invisible(NULL))
   }
 
-  mock_dbconnect(.dittodb_env$orig_dbi_dbconnect)
-
-  # "unset" the orig_dbi_dbconnec, not strictly necesary, but could be a good
-  # check if there is a mock db going.
-  .dittodb_env$orig_dbi_dbconnect <- NULL
-}
+  safe_untrace("dbConnect", sys.frame())
+  safe_untrace("dbConnect", asNamespace("DBI"))
 
-mock_dbconnect <- function(new_func) {
-  .Call(
-    reassign_function,
-    as.name("dbConnect"),
-    asNamespace("DBI"),
-    get("dbConnect", envir = asNamespace("DBI"), mode = "function"),
-    new_func
-  )
+  return(invisible(NULL))
 }

R/nycflights13-sql.R

@@ -108,8 +108,6 @@ nycflights13_create_sql <- function(con, schema = "", ...) {
       con,
       table_name,
       df,
-      # unique_indexes = unique_index[[table]],
-      # indexes = index[[table]],
       temporary = FALSE,
       row.names = FALSE,
       overwrite = TRUE