averissimo
commented
9 months ago Note that this is an issue with R6 classes only.
For this issue to go forward we need to decide if we can accept not having examples on the method description (see different options on screenshot below)
- Keep as is without any protection against
Suggestpackages being installed - Use
@examplesIf, but have it being omitted from method definition (JSONArchiver$writein the example below) - Surround example by an if statement
kumamiao
Feature description
Needs to:
#' @examplesIf requireNamespace("pkgname")ggplot2&rtables@examplesIfisn't supported in R6 methods documentationevalproperty to chunks with same logic and using thequietly = TRUEargumentknitr::opts_chunk$setggplot2test-Archiver.Rand diff below)Prototype diff patch to improve on `test-Archiver.R`
```diff diff --git a/tests/testthat/test-Archiver.R b/tests/testthat/test-Archiver.R index aeee449..a791b79 100644 --- a/tests/testthat/test-Archiver.R +++ b/tests/testthat/test-Archiver.R @@ -1,23 +1,39 @@ -card1 <- ReportCard$new() -card1$append_text("Header 2 text", "header2") -card1$append_text("A paragraph of default text", "header2") -card1$append_plot( - ggplot2::ggplot(iris, ggplot2::aes(x = Petal.Length)) + - ggplot2::geom_histogram() -) +# Helper to generate a test reporter on demand instead of common shared object +build_test_reporter <- function() { + card1 <- ReportCard$new() -card2 <- ReportCard$new() + card1$append_text("Header 2 text", "header2") + card1$append_text("A paragraph of default text", "header2") + card1$append_plot( + ggplot2::ggplot(iris, ggplot2::aes(x = Petal.Length)) + + ggplot2::geom_histogram() + ) + + card2 <- ReportCard$new() -card2$append_text("Header 2 text", "header2") -card2$append_text("A paragraph of default text", "header2") -lyt <- rtables::analyze(rtables::split_rows_by(rtables::basic_table(), "Day"), "Ozone", afun = mean) -table_res2 <- rtables::build_table(lyt, airquality) -card2$append_table(table_res2) -card2$append_table(iris) + card2$append_text("Header 2 text", "header2") + card2$append_text("A paragraph of default text", "header2") + lyt <- rtables::analyze(rtables::split_rows_by(rtables::basic_table(), "Day"), "Ozone", afun = mean) + table_res2 <- rtables::build_table(lyt, airquality) + card2$append_table(table_res2) + card2$append_table(iris) -reporter <- Reporter$new() -reporter$append_cards(list(card1, card2)) + reporter <- Reporter$new() + reporter$append_cards(list(card1, card2)) + + reporter +} + +# Helper to initialize a default archiver +build_test_archiver <- function(.env = parent.frame()) { + skip_if_not_installed("ggplot2") + archiver <- JSONArchiver$new() + archiver$write(build_test_reporter()) + archiver +} + +# Start of tests testthat::test_that("intialize Archiver", { testthat::expect_no_error(Archiver$new()) @@ -76,15 +92,13 @@ testthat::test_that("JSONArchiver dectructor removes the temp dir", { testthat::expect_false(dir.exists(temp_dir)) }) -archiver <- JSONArchiver$new() - testthat::test_that("JSONArchiver write a reporter", { - testthat::expect_no_error(archiver$write(reporter)) + archiver <- build_test_archiver() + testthat::expect_no_error(archiver$write(build_test_reporter())) }) -path_with_files <- archiver$get_output_dir() - testthat::test_that("JSONArchiver write a reporter with a json file and static files", { + archiver <- build_test_archiver() testthat::expect_true(dir.exists(archiver$get_output_dir())) files <- list.files(archiver$get_output_dir()) testthat::expect_true(length(files) == 4) @@ -92,12 +106,14 @@ testthat::test_that("JSONArchiver write a reporter with a json file and static f }) testthat::test_that("JSONArchiver read back the Reporter instance", { + archiver <- build_test_archiver() testthat::expect_s3_class(archiver$read(), "Reporter") testthat::expect_length(archiver$read()$get_cards(), 2L) testthat::expect_length(archiver$read()$get_blocks(), 8L) }) testthat::test_that("JSONArchiver read back and all table/picture statics exists", { + archiver <- build_test_archiver() gc() file_blocks <- Filter( function(x) inherits(x, "PictureBlock") || inherits(x, "TableBlock"), @@ -106,8 +122,12 @@ testthat::test_that("JSONArchiver read back and all table/picture statics exists testthat::expect_true(all(vapply(file_blocks, function(f) file.exists(f$get_content()), logical(1)))) }) -archiver2 <- JSONArchiver$new() + testthat::test_that("JSONArchiver read back the Reporter instance, from a path", { + archiver <- build_test_archiver() + path_with_files <- archiver$get_output_dir() + archiver2 <- JSONArchiver$new() + reporter_temp <- archiver2$read(path_with_files) testthat::expect_s3_class(reporter_temp, "Reporter") testthat::expect_length(reporter_temp$get_cards(), 2L) @@ -115,6 +135,10 @@ testthat::test_that("JSONArchiver read back the Reporter instance, from a path", }) testthat::test_that("JSONArchiver read back and all table/picture statics exists, from a path", { + archiver <- build_test_archiver() + path_with_files <- archiver$get_output_dir() + archiver2 <- JSONArchiver$new() + gc() file_blocks <- Filter( function(x) inherits(x, "PictureBlock") || inherits(x, "TableBlock"), @@ -124,9 +148,9 @@ testthat::test_that("JSONArchiver read back and all table/picture statics exists }) testthat::test_that("JSONArchiver with an empty dir", { - temp_dir <- file.path(tempdir(), "test") - dir.create(temp_dir) + temp_dir <- withr::local_tempdir(pattern = "test") + archiver2 <- JSONArchiver$new() testthat::expect_warning( archiver2$read(temp_dir), "The directory provided to the Archiver is empty." @@ -135,7 +159,6 @@ testthat::test_that("JSONArchiver with an empty dir", { unlink(temp_dir, recursive = TRUE) }) - testthat::test_that("JSONArchiver destructor remove its output_dir", { archiver <- JSONArchiver$new() archiver_path <- archiver$get_output_dir() @@ -144,3 +167,4 @@ testthat::test_that("JSONArchiver destructor remove its output_dir", { gc() testthat::expect_false(dir.exists(archiver_path)) }) + ```Code of Conduct
Contribution Guidelines
Security Policy