From 4beb3af633a72a50a3ede4bb87a475f202606043 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 25 Jun 2025 18:13:00 +0100 Subject: [PATCH] tests: adds some tests and avoids deprecated function --- R/qenv-eval_code.R | 2 ++ tests/testthat/test-get_outputs.R | 35 +++++++++++++++++++++++++--- tests/testthat/test-qenv_eval_code.R | 8 +++++++ 3 files changed, 42 insertions(+), 3 deletions(-) diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index 49b90aba..cb37d14a 100644 --- a/R/qenv-eval_code.R +++ b/R/qenv-eval_code.R @@ -64,6 +64,8 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co stop_on_error = 1, output_handler = evaluate::new_output_handler(value = identity) ) + out <- evaluate::trim_intermediate_plots(out) + evaluate::inject_funs(old) # remove library() override new_code <- list() diff --git a/tests/testthat/test-get_outputs.R b/tests/testthat/test-get_outputs.R index 0a4b6419..c9ef388e 100644 --- a/tests/testthat/test-get_outputs.R +++ b/tests/testthat/test-get_outputs.R @@ -15,8 +15,24 @@ testthat::describe("get_output", { ) ) testthat::expect_identical(get_outputs(q1), unname(as.list(q1))) - testthat::expect_reference(get_outputs(q1)[[1]], q1$a) - testthat::expect_reference(get_outputs(q1)[[2]], q1$b) + testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$a)) + testthat::expect_true(rlang::is_reference(get_outputs(q1)[[2]], q1$b)) + }) + + testthat::it("implicitly printed S4 object is returned asis in a list and identical to the one in the environment", { + q <- qenv() + q1 <- eval_code( + q, + expression( + methods::setClass("NewS4Class", slots = list(value = "numeric")), + new_obj <- methods::new("NewS4Class", value = 42), + new_obj + ) + ) + withr::defer(removeClass("NewS4Class")) + testthat::expect_identical(get_outputs(q1), unname(as.list(q1))) + testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$new_obj)) + testthat::expect_s4_class(get_outputs(q1)[[1]], "NewS4Class") }) testthat::it("implicitly printed list is returned asis even if its print is overridden", { @@ -57,12 +73,18 @@ testthat::describe("get_output", { testthat::expect_identical(get_outputs(q1), list("[1] \"test_print\"\n")) }) - testthat::it("printed plots are returned as recordedplot in a list", { + testthat::it("printed plots are returned as recordedplot in a list (1)", { q <- qenv() q1 <- eval_code(q, expression(a <- 1L, plot(a))) testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot")) }) + testthat::it("printed plots are returned as recordedplot in a list (2)", { + q <- qenv() + q1 <- eval_code(q, expression(a <- seq_len(10L), hist(a))) + testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot")) + }) + testthat::it("warnings are returned asis in a list", { q <- qenv() q1 <- eval_code(q, expression(warning("test"))) @@ -77,8 +99,15 @@ testthat::describe("get_output", { expected <- simpleMessage("test\n", call = quote(message("test"))) testthat::expect_identical(get_outputs(q1), list(expected)) }) + testthat::it("prints inside for are bundled together", { q <- within(qenv(), for (i in 1:3) print(i)) testthat::expect_identical(get_outputs(q)[[1]], "[1] 1\n[1] 2\n[1] 3\n") }) + + testthat::it("intermediate plots are not kept", { + q <- qenv() + q1 <- eval_code(q, expression(plot(1:10), title("A title"))) + testthat::expect_length(get_outputs(q1), 1) + }) }) diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index c6c40798..01b11353 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -169,3 +169,11 @@ testthat::test_that("plot output is stored as recordedplot in the 'outputs' attr q <- eval_code(qenv(), "plot(1)") testthat::expect_s3_class(attr(q@code[[1]], "outputs")[[1]], "recordedplot") }) + +testthat::test_that("plot cannot modified previous plots when calls are seperate", { + q <- qenv() + q1 <- eval_code(q, expression(plot(1:10))) + + q2 <- eval_code(q1, expression(title("A title"))) + testthat::expect_s3_class(q2, "qenv.error") +})