test_that("produces consistent output", { withr::local_options(testthat.edition_ignore = TRUE) local_edition(2) local_mocked_bindings( show_menu = function(choices, title = NULL) { cat(paste0(format(seq_along(choices)), ": ", choices, sep = "\n"), "\n", sep = "") 0L }, sink_number = function() 0L ) withr::local_options(testthat_format_srcrefs = FALSE) expect_snapshot_reporter(DebugReporter$new()) }) get_vars_from_debug_reporter <- function(choice, fun, envir = parent.frame()) { frame <- get_frame_from_debug_reporter(choice, fun, envir) ls(frame) } get_frame_from_debug_reporter <- function(choice, fun, envir = parent.frame()) { local_edition(2) force(choice) test_debug_reporter_parent_frame <- NULL with_mocked_bindings( show_menu = function(choices, title = NULL) { # if (choice > 0) print(choices) my_choice <- choice choice <<- 0L my_choice }, browse_frame = function(frame, skip) { test_debug_reporter_parent_frame <<- frame }, sink_number = function() 0L, with_reporter( "debug", test_that("debug_reporter_test", { fun() }) ) ) test_debug_reporter_parent_frame } success_fun <- function() { aa <- 1 expect_true(TRUE) } test_that("debug reporter is not called for successes", { expect_null(get_frame_from_debug_reporter(2, success_fun)) }) test_that("browser() is called for the correct frame for failures", { fun_1 <- function() { aa <- 1 expect_true(FALSE) } fun_2 <- function() { f <- function() expect_true(FALSE) f() } fun_3 <- function() { f <- function() { g <- function() expect_true(FALSE) g() } f() } expect_equal(get_vars_from_debug_reporter(1, fun_1), character()) expect_equal(get_vars_from_debug_reporter(2, fun_1), "aa") expect_equal(get_vars_from_debug_reporter(1, fun_2), character()) expect_equal(get_vars_from_debug_reporter(2, fun_2), "f") expect_equal(get_vars_from_debug_reporter(3, fun_2), character()) expect_equal(get_vars_from_debug_reporter(1, fun_3), character()) expect_equal(get_vars_from_debug_reporter(2, fun_3), "f") expect_equal(get_vars_from_debug_reporter(3, fun_3), "g") expect_equal(get_vars_from_debug_reporter(4, fun_3), character()) }) test_that("browser() is called for the correct frame for warnings", { fun_1 <- function() { aa <- 1 warning("warn") } fun_2 <- function() { f <- function() warning("warn") f() } fun_3 <- function() { f <- function() { g <- function() warning("warn") g() } f() } expect_equal(get_vars_from_debug_reporter(1, fun_1), character()) expect_equal(get_vars_from_debug_reporter(2, fun_1), "aa") expect_equal(get_vars_from_debug_reporter(1, fun_2), character()) expect_equal(get_vars_from_debug_reporter(2, fun_2), "f") expect_equal(get_vars_from_debug_reporter(3, fun_2), character()) expect_equal(get_vars_from_debug_reporter(1, fun_3), character()) expect_equal(get_vars_from_debug_reporter(2, fun_3), "f") expect_equal(get_vars_from_debug_reporter(3, fun_3), "g") expect_equal(get_vars_from_debug_reporter(4, fun_3), character()) }) test_that("browser() is called for the correct frame for errors", { fun_1 <- function() { aa <- 1 stop("error") } fun_2 <- function() { f <- function() stop("error") f() } fun_3 <- function() { f <- function() { g <- function() stop("error") g() } f() } expect_equal(get_vars_from_debug_reporter(1, fun_1), character()) expect_equal(get_vars_from_debug_reporter(2, fun_1), "aa") expect_equal(get_vars_from_debug_reporter(1, fun_2), character()) expect_equal(get_vars_from_debug_reporter(2, fun_2), "f") expect_equal(get_vars_from_debug_reporter(3, fun_2), character()) expect_equal(get_vars_from_debug_reporter(1, fun_3), character()) expect_equal(get_vars_from_debug_reporter(2, fun_3), "f") expect_equal(get_vars_from_debug_reporter(3, fun_3), "g") expect_equal(get_vars_from_debug_reporter(4, fun_3), character()) }) test_that("browser() is called for the correct frame for skips", { fun_1 <- function() { aa <- 1 skip("skip") } fun_2 <- function() { f <- function() skip("skip") f() } fun_3 <- function() { f <- function() { g <- function() skip("skip") g() } f() } expect_equal(get_vars_from_debug_reporter(1, fun_1), character()) expect_equal(get_vars_from_debug_reporter(2, fun_1), "aa") expect_equal(get_vars_from_debug_reporter(1, fun_2), character()) expect_equal(get_vars_from_debug_reporter(2, fun_2), "f") expect_equal(get_vars_from_debug_reporter(3, fun_2), character()) expect_equal(get_vars_from_debug_reporter(1, fun_3), character()) expect_equal(get_vars_from_debug_reporter(2, fun_3), "f") expect_equal(get_vars_from_debug_reporter(3, fun_3), "g") expect_equal(get_vars_from_debug_reporter(4, fun_3), character()) })