Skip to content

Commit 4858a08

Browse files
authored
Adds some tests to use_evaluate feature branch and avoids deprecated function (#261)
### Changes description - Remove intermediate plots by default - Avoids deprecated function in testthat 3rd edition - Adds some tests - Q: Does the S4 test make sense?
1 parent c26c322 commit 4858a08

File tree

3 files changed

+42
-3
lines changed

3 files changed

+42
-3
lines changed

R/qenv-eval_code.R

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,8 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
6464
stop_on_error = 1,
6565
output_handler = evaluate::new_output_handler(value = identity)
6666
)
67+
out <- evaluate::trim_intermediate_plots(out)
68+
6769
evaluate::inject_funs(old) # remove library() override
6870

6971
new_code <- list()

tests/testthat/test-get_outputs.R

Lines changed: 32 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,24 @@ testthat::describe("get_output", {
1515
)
1616
)
1717
testthat::expect_identical(get_outputs(q1), unname(as.list(q1)))
18-
testthat::expect_reference(get_outputs(q1)[[1]], q1$a)
19-
testthat::expect_reference(get_outputs(q1)[[2]], q1$b)
18+
testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$a))
19+
testthat::expect_true(rlang::is_reference(get_outputs(q1)[[2]], q1$b))
20+
})
21+
22+
testthat::it("implicitly printed S4 object is returned asis in a list and identical to the one in the environment", {
23+
q <- qenv()
24+
q1 <- eval_code(
25+
q,
26+
expression(
27+
methods::setClass("NewS4Class", slots = list(value = "numeric")),
28+
new_obj <- methods::new("NewS4Class", value = 42),
29+
new_obj
30+
)
31+
)
32+
withr::defer(removeClass("NewS4Class"))
33+
testthat::expect_identical(get_outputs(q1), unname(as.list(q1)))
34+
testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$new_obj))
35+
testthat::expect_s4_class(get_outputs(q1)[[1]], "NewS4Class")
2036
})
2137

2238
testthat::it("implicitly printed list is returned asis even if its print is overridden", {
@@ -57,12 +73,18 @@ testthat::describe("get_output", {
5773
testthat::expect_identical(get_outputs(q1), list("[1] \"test_print\"\n"))
5874
})
5975

60-
testthat::it("printed plots are returned as recordedplot in a list", {
76+
testthat::it("printed plots are returned as recordedplot in a list (1)", {
6177
q <- qenv()
6278
q1 <- eval_code(q, expression(a <- 1L, plot(a)))
6379
testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
6480
})
6581

82+
testthat::it("printed plots are returned as recordedplot in a list (2)", {
83+
q <- qenv()
84+
q1 <- eval_code(q, expression(a <- seq_len(10L), hist(a)))
85+
testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
86+
})
87+
6688
testthat::it("warnings are returned asis in a list", {
6789
q <- qenv()
6890
q1 <- eval_code(q, expression(warning("test")))
@@ -77,8 +99,15 @@ testthat::describe("get_output", {
7799
expected <- simpleMessage("test\n", call = quote(message("test")))
78100
testthat::expect_identical(get_outputs(q1), list(expected))
79101
})
102+
80103
testthat::it("prints inside for are bundled together", {
81104
q <- within(qenv(), for (i in 1:3) print(i))
82105
testthat::expect_identical(get_outputs(q)[[1]], "[1] 1\n[1] 2\n[1] 3\n")
83106
})
107+
108+
testthat::it("intermediate plots are not kept", {
109+
q <- qenv()
110+
q1 <- eval_code(q, expression(plot(1:10), title("A title")))
111+
testthat::expect_length(get_outputs(q1), 1)
112+
})
84113
})

tests/testthat/test-qenv_eval_code.R

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -169,3 +169,11 @@ testthat::test_that("plot output is stored as recordedplot in the 'outputs' attr
169169
q <- eval_code(qenv(), "plot(1)")
170170
testthat::expect_s3_class(attr(q@code[[1]], "outputs")[[1]], "recordedplot")
171171
})
172+
173+
testthat::test_that("plot cannot modified previous plots when calls are seperate", {
174+
q <- qenv()
175+
q1 <- eval_code(q, expression(plot(1:10)))
176+
177+
q2 <- eval_code(q1, expression(title("A title")))
178+
testthat::expect_s3_class(q2, "qenv.error")
179+
})

0 commit comments

Comments
 (0)