dbg() tweaks

R/method-register.R

@@ -107,7 +107,6 @@ register_S3_method <- function(generic, signature, method, envir = parent.frame(
   }
 
   class <- S7_class_name(signature[[1]])
-  # dbg(generic$name, class, method, envir)
   registerS3method(generic$name, class, method, envir)
 }
 

tests/testthat/helper.R

@@ -93,10 +93,15 @@ named_list <- function(...) {
 
 `add<-` <- `+`
 
-dbg <- function(..., .display = utils::str) {
+dbg <- function(..., .display = utils::str, .file = NULL) {
   out <- NULL
   exprs <- as.list(substitute(list(...)))[-1L]
 
+  if (!is.null(.file)) {
+    sink(.file, append = TRUE)
+    on.exit(sink())
+  }
+
   for (i in seq_len(...length())) {
     ..i <- as.symbol(sprintf("..%i", i))
     if (eval(substitute(missing(..i)))) {
@@ -111,7 +116,7 @@ dbg <- function(..., .display = utils::str) {
     } else {
       sprintf("(%s) `%s`", name, expr)
     }
-    cat(label, ": ", sep = "")
+    cat(label, if (identical(.display, utils::str)) ": " else "\n", sep = "")
     .display(out <- eval(..i))
   }
 
@@ -140,13 +145,15 @@ dbg <- function(..., .display = utils::str) {
     cat(loc, "\n")
   } else {
     cat(sprintf("(from call: %s (srcfile missing))\n", trimws(
-      deparse1(sys.call(-2), width.cutoff = 60)
+      deparse1(sys.call(-2) %error% sys.call(-1), width.cutoff = 60)
     )))
   }
 
   invisible(out)
 }
 
+`%error%` <- function(x, y) tryCatch(x, error = function(e) y)
+
 # prevent new_class() from creating `S7::` prefixed S3 class names in tests.
 local({
   ns <- asNamespace("S7")