From de07edc49cd0337a0c891cf1ed3cef07a462dcb7 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Fri, 5 Jul 2024 15:15:40 -0700 Subject: [PATCH] Freshen up the tests around crashing --- tests/testthat/_snaps/reprex.md | 19 ++++++++++++++++++- tests/testthat/test-reprex.R | 20 +++++++++++++++----- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/tests/testthat/_snaps/reprex.md b/tests/testthat/_snaps/reprex.md index f5e38a8..6cdaa9c 100644 --- a/tests/testthat/_snaps/reprex.md +++ b/tests/testthat/_snaps/reprex.md @@ -10,9 +10,26 @@ # reprex() errors for an R crash, by default Code - code <- "utils::getFromNamespace(\"crash\", \"callr\")()\n" + code <- "rlang::node_car(0)\n" reprex(input = code) Condition Error in `reprex_render()`: ! This reprex appears to crash R. Call `reprex()` again with `std_out_err = TRUE` to get more info. +# reprex() copes with an R crash, when `std_out_err = TRUE` + + Code + out + Output + [1] "This reprex appears to crash R." + [2] "See standard output and standard error for more details." + [3] "" + [4] "#### Standard output and error" + [5] "" + [6] "``` sh" + [7] "" + [8] " *** caught segfault ***" + [9] "address 0x1, cause 'CAUSE'" + [10] "" + [11] "Traceback:" + diff --git a/tests/testthat/test-reprex.R b/tests/testthat/test-reprex.R index dd44fc1..2e23021 100644 --- a/tests/testthat/test-reprex.R +++ b/tests/testthat/test-reprex.R @@ -61,19 +61,29 @@ test_that("reprex() works even if user uses fancy quotes", { }) test_that("reprex() errors for an R crash, by default", { + skip_on_cran() expect_snapshot(error = TRUE, { - code <- 'utils::getFromNamespace("crash", "callr")()\n' + code <- 'rlang::node_car(0)\n' reprex(input = code) }) }) test_that("reprex() copes with an R crash, when `std_out_err = TRUE`", { - code <- 'utils::getFromNamespace("crash", "callr")()\n' + skip_on_cran() + code <- 'rlang::node_car(0)\n' expect_no_error( out <- reprex(input = code, std_out_err = TRUE) ) + skip_on_os("windows") - expect_match(out, "crash", all = FALSE) - expect_match(out, "segfault", all = FALSE) - expect_match(out, "Traceback", all = FALSE) + + scrubber <- function(x) { + # I don't want to snapshot the actual traceback + out <- x[seq_len(min(grep("Traceback", x)))] + # on macOS and windows, cause is 'invalid permissions' + # on ubuntu, cause is 'memory not mapped' + trimws(sub("cause '.*'", "cause 'CAUSE'", out)) + } + + expect_snapshot(out, transform = scrubber) })