initial work on with_trace()

.gitignore

@@ -5,3 +5,8 @@
 inst/doc
 docs
 revdep/data.sqlite
+
+# emacs temp files
+\#*\#
+*~
+

DESCRIPTION

@@ -62,13 +62,14 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
 Collate: 
     'aaa.R'
     'collate.R'
     'compat-defer.R'
     'connection.R'
     'db.R'
+    'debug.R'
     'defer.R'
     'wrap.R'
     'local_.R'

NAMESPACE

@@ -39,6 +39,7 @@ export(local_tempdir)
 export(local_tempfile)
 export(local_tiff)
 export(local_timezone)
+export(local_trace)
 export(local_xfig)
 export(makevars_user)
 export(set_makevars)
@@ -77,5 +78,6 @@ export(with_tempdir)
 export(with_tempfile)
 export(with_tiff)
 export(with_timezone)
+export(with_trace)
 export(with_xfig)
 importFrom(stats,setNames)

R/debug.R

@@ -0,0 +1,49 @@
+#' Debugging states which unset themselves
+#'
+#' Create debugging states, which are then automatically unset afterwards.
+#' @template with
+#'
+#' @param file,.file `[named list]`\cr Files to create.
+#' @param ... Additional (possibly named) arguments of files to create.
+#' @param .local_envir `[environment]`\cr The environment to use for scoping.
+#'
+#' @examples
+#' with_file("file1", {
+#'   writeLines("foo", "file1")
+#'   readLines("file1")
+#' })
+#'
+#' with_file(list("file1" = writeLines("foo", "file1")), {
+#'   readLines("file1")
+#' })
+#'
+#' @export
+with_trace <- function(what, code,
+                       tracer = NULL,
+                       exit = NULL,
+                       at = numeric(),
+                       print = TRUE,
+                       signature = NULL,
+                       where = topenv(parent.frame()),
+                       edit = FALSE) {
+  if (!is.character(what)) what <- as.character(substitute(what))
+  methods::.TraceWithMethods(what, tracer, exit, at, print, signature, where, edit)
+  on.exit(untrace(what, signature, where))
+  force(code)
+}
+
+#' @rdname with_trace
+#' @export
+local_trace <- function(what, code,
+                        tracer = NULL,
+                        exit = NULL,
+                        at = numeric(),
+                        print = TRUE,
+                        signature = NULL,
+                        where = topenv(.local_envir),
+                        edit = FALSE,
+                        .local_envir = parent.frame()) {
+  defer(untrace(what, signature, where), envir = .local_envir)
+
+  trace(what, tracer, exit, at, print, signature, where, edit)
+}

tests/testthat/test-debug.R

@@ -0,0 +1,22 @@
+test_that("with_trace sets and unsets tracing", {
+  skip_if(exists("foo", envir = .GlobalEnv))
+  .GlobalEnv$foo <- function(x) x + 1
+  on.exit(rm("foo", envir = .GlobalEnv))
+
+  with_trace(
+    foo,
+    tracer = quote(message("hi")),
+    expect_message(
+      expect_output(
+        expect_identical(foo(1), 2),
+        "Tracing foo(1) on entry",
+        fixed = TRUE
+      ),
+      "hi",
+      fixed = TRUE
+    )
+  )
+
+  # untraced
+  expect_silent(expect_identical(foo(1), 2))
+})