Merge branch 'master' into f-#96-multi-row

DESCRIPTION

@@ -34,6 +34,7 @@ Collate:
     'import-dbi.R'
     'import-testthat.R'
     'run.R'
+    's4.R'
     'spec.R'
     'spec-getting-started.R'
     'spec-driver-class.R'

R/s4.R

@@ -0,0 +1,49 @@
+# http://stackoverflow.com/a/39880324/946850
+s4_methods <- function(env, pkg_fun = NULL) {
+  generics <- methods::getGenerics(env)
+
+  if (is.null(pkg_fun)) {
+    ok <- TRUE
+  } else {
+    ok <- pkg_fun(generics@package)
+  }
+
+
+  res <- Map(
+    generics@.Data[ok], generics@package[ok], USE.NAMES = TRUE,
+    f = function(name, package) {
+      what <- methods::methodsPackageMetaName("T", paste(name, package, sep = ":"))
+
+      table <- get(what, envir = env)
+
+      mget(ls(table, all.names = TRUE), envir = table)
+    })
+  unlist(res, recursive = FALSE)
+}
+
+s4_real_argument_names <- function(s4_method) {
+  expect_is(s4_method, c("function", "MethodDefinition", "derivedDefaultMethod"))
+  unwrapped <- s4_unwrap(s4_method)
+  names(formals(unwrapped))
+}
+
+s4_unwrap <- function(s4_method) {
+  # Only unwrap if body is of the following form:
+  # {
+  #   .local <- function(x, y, z, ...) {
+  #     ...
+  #   }
+  #   ...
+  # }
+  method_body <- body(s4_method)
+  if (inherits(method_body, "{")) {
+    local_def <- method_body[[2]]
+    if (inherits(local_def, "<-") && local_def[[2]] == quote(.local)) {
+      local_fun <- local_def[[3]]
+      if (inherits(local_fun, "function"))
+        return(local_fun)
+    }
+  }
+
+  s4_method
+}

R/spec-compliance-methods.R

@@ -26,6 +26,16 @@ spec_compliance_methods <- list(
     })
   },
 
+  #' All methods have an ellipsis `...` in their formals.
+  ellipsis = function(ctx) {
+    pkg <- package_name(ctx)
+
+    where <- asNamespace(pkg)
+
+    methods <- s4_methods(where, function(x) x == "DBI")
+    Map(expect_ellipsis_in_formals, methods, names(methods))
+  },
+
   #' }
   NULL
 )
@@ -41,6 +51,14 @@ expect_has_class_method <- function(name, class, args, driver_package) {
   ))
 }
 
+expect_ellipsis_in_formals <- function(method, name) {
+  sym <- as.name(name)
+  eval(bquote({
+    .(sym) <- method
+    expect_true("..." %in% s4_real_argument_names(.(sym)))
+  }))
+}
+
 key_methods <- list(
   Driver = list(
     "dbGetInfo" = NULL,