add method checking function for testing (#78)

R/utils-testthat.R

@@ -0,0 +1,44 @@
+#' Check method arguments
+#'
+#' @param object Object to check
+#' @param prefix Prefix to use for method names
+#' @param verbose Print out additional information
+#' @keywords internal
+#' @noRd
+check_methods <- function(object, prefix, verbose = getOption("verbose")) {
+  requireNamespace("testthat")
+
+  for (method in object$methods()) {
+    obj <- get0(method, object$def@refMethods, mode = "function")
+
+    if (is.null(obj)) {
+      next
+    }
+
+    exp <- get0(paste0(prefix, method), mode = "function")
+
+    if (is.null(exp)) {
+      if (verbose) {
+        cat("Skipping method: ", method, "()\n", sep = "")
+      }
+
+      next
+    }
+
+    obj <- as.list(formals(obj))
+
+    if (identical(obj, list())) {
+      # exp will be a named list, but will be empty
+      obj <- structure(list(), names = character())
+    }
+
+    exp <- as.list(formals(exp))[-1L]
+
+    testthat::expect_identical(
+      object = obj,
+      expected = exp,
+      info = paste0("method: ", method, "()"),
+      ignore_srcref = TRUE
+    )
+  }
+}

tests/testthat/test-class-args.R

@@ -19,6 +19,12 @@ test_that("errors", {
   expect_warning(expect_warning(ca$parse()))
 })
 
+test_that("method arguments are correct", {
+  check_methods(scribeArg, "arg_")
+})
+
+# regressions -------------------------------------------------------------
+
 test_that("$get_names() [#10]", {
   x <- new_arg("-f", n = 1L)
   expect_identical(x$get_name(), "f")

tests/testthat/test-class-command-args.R

@@ -381,6 +381,12 @@ test_that("versions", {
   expect_output(ca$version())
 })
 
+test_that("method arguments are correct", {
+  check_methods(scribeCommandArgs, "ca_")
+})
+
+# regressions -------------------------------------------------------------
+
 test_that("positional defaults [#52]", {
   ca <- command_args()
   ca$add_argument("pos", default = 1)
@@ -445,6 +451,8 @@ test_that("'convert' isn't ignored [#70]", {
   expect_error(ca$parse(), "success")
 })
 
+# snapshots ---------------------------------------------------------------
+
 test_that("snapshots", {
   ca <- command_args(string = "foo bar --fizz")
   ca$add_description("this does a thing")