Skip to content

Commit

Permalink
options for strict tests; few enhancements (#241)
Browse files Browse the repository at this point in the history
- part of
insightsengineering/coredev-tasks#478
- please read this for more info about the implementation:
insightsengineering/coredev-tasks#478 (comment)
- update Config/Needs/verdepcheck entries
- removed `# nolint` from code-docs (e.g. examples) (this is actually
rendered!).
- removed `teal.reporter::` from code (incl. tests) as this is redundant
inside `teal.reporter`
- removed `teal.reporter::` from docs as this is also redundant here
- removed `pkg::` from vignettes given `library(pkg)` before
- fixed roxygen note about documenting package level Rd

---------

Signed-off-by: Pawel Rucki <[email protected]>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
  • Loading branch information
pawelru and dependabot-preview[bot] authored Mar 18, 2024
1 parent bf2cbcf commit 384f941
Show file tree
Hide file tree
Showing 13 changed files with 106 additions and 29 deletions.
9 changes: 5 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -44,18 +44,19 @@ Suggests:
png,
rtables (>= 0.5.1),
testthat (>= 3.1.5),
tinytex
tinytex,
withr (>= 2.0.0)
VignetteBuilder:
knitr
RdMacros:
lifecycle
Config/Needs/verdepcheck: rstudio/bslib, mllg/checkmate,
Config/Needs/verdepcheck: rstudio/bslib, mllg/checkmate, davidgohel/flextable,
rstudio/htmltools, yihui/knitr, r-lib/lifecycle, r-lib/R6,
rstudio/rmarkdown, rstudio/shiny, dreamRs/shinybusy,
dreamRs/shinyWidgets, yaml=vubiostat/r-yaml, r-lib/zip,
davidgohel/flextable, rstudio/DT, yihui/formatR, tidyverse/ggplot2,
rstudio/DT, yihui/formatR, tidyverse/ggplot2,
deepayan/lattice, cran/png, insightsengineering/rtables,
r-lib/testthat, rstudio/tinytex
r-lib/testthat, rstudio/tinytex, r-lib/withr
Config/Needs/website: insightsengineering/nesttemplate
Encoding: UTF-8
Language: en-US
Expand Down
4 changes: 2 additions & 2 deletions R/Previewer.R
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ reporter_previewer_srv <- function(id,
function(input, output, session) {
ns <- session$ns

teal.reporter::reset_report_button_srv("resetButtonPreviewer", reporter)
reset_report_button_srv("resetButtonPreviewer", reporter)

output$encoding <- shiny::renderUI({
reporter$get_reactive_add_card()
Expand All @@ -106,7 +106,7 @@ reporter_previewer_srv <- function(id,
),
class = if (length(reporter$get_cards())) "" else "disabled"
),
teal.reporter::reset_report_button_ui(ns("resetButtonPreviewer"), label = "Reset Report")
reset_report_button_ui(ns("resetButtonPreviewer"), label = "Reset Report")
)
})

Expand Down
3 changes: 2 additions & 1 deletion R/SimpleReporter.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,9 @@
#' @return `NULL`.
#'
#' @examples
#' library(shiny)
#' if (interactive()) {
#' library(shiny)
#'
#' shinyApp(
#' ui = fluidPage(simple_reporter_ui("simple")),
#' server = function(input, output, session) {
Expand Down
1 change: 0 additions & 1 deletion R/yaml_utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,6 @@ md_header <- function(x) {
#' @return `input` argument or the appropriate `logical` value.
#' @keywords internal
#' @examples
#'
#' conv_str_logi <- getFromNamespace("conv_str_logi", "teal.reporter")
#' conv_str_logi("TRUE")
#' conv_str_logi("True")
Expand Down
1 change: 0 additions & 1 deletion man/conv_str_logi.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 2 additions & 1 deletion man/simple_reporter.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

20 changes: 20 additions & 0 deletions tests/testthat/setup-options.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
# `opts_partial_match_old` is left for exclusions due to partial matching in dependent packages (i.e. not fixable here)
# it might happen that it is not used right now, but it is left for possible future use
# use with: `withr::with_options(opts_partial_match_old, { ... })` inside the test
opts_partial_match_old <- list(
warnPartialMatchDollar = getOption("warnPartialMatchDollar"),
warnPartialMatchArgs = getOption("warnPartialMatchArgs"),
warnPartialMatchAttr = getOption("warnPartialMatchAttr")
)
opts_partial_match_new <- list(
warnPartialMatchDollar = TRUE,
warnPartialMatchArgs = TRUE,
warnPartialMatchAttr = TRUE
)

if (isFALSE(getFromNamespace("on_cran", "testthat")()) && requireNamespace("withr", quietly = TRUE)) {
withr::local_options(
opts_partial_match_new,
.local_envir = testthat::teardown_env()
)
}
10 changes: 8 additions & 2 deletions tests/testthat/test-Archiver.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,14 @@ 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)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
{
card2$append_table(table_res2)
card2$append_table(iris)
}
)

reporter <- Reporter$new()
reporter$append_cards(list(card1, card2))
Expand Down
6 changes: 5 additions & 1 deletion tests/testthat/test-Renderer.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,11 @@ text_block1 <- TextBlock$new()$set_content("text")$set_style("header2")
text_block2 <- TextBlock$new()$set_content("text")
png_path <- system.file("img", "Rlogo.png", package = "png")
picture_block <- PictureBlock$new()$set_content(ggplot2::ggplot(iris))
table_block <- TableBlock$new()$set_content(iris)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
table_block <- TableBlock$new()$set_content(iris)
)
newpage_block <- NewpageBlock$new()
blocks <- list(text_block1, text_block2, picture_block, table_block, newpage_block)

Expand Down
14 changes: 11 additions & 3 deletions tests/testthat/test-ReportCard.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,14 +16,22 @@ testthat::test_that("append_text returns self", {
})

testthat::test_that("append_table accepts a data.frame", {
testthat::expect_no_error(
ReportCard$new()$append_table(iris)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_no_error(
ReportCard$new()$append_table(iris)
)
)
})

testthat::test_that("append_table returns self", {
card <- ReportCard$new()
testthat::expect_identical(card$append_table(iris), card)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_identical(card$append_table(iris), card)
)
})

testthat::test_that("append_plot returns self", {
Expand Down
16 changes: 11 additions & 5 deletions tests/testthat/test-Reporter.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ testthat::test_that("new returns an object of type Reporter", {
testthat::expect_true(inherits(Reporter$new(), "Reporter"))
})

card1 <- teal.reporter::ReportCard$new()
card1 <- ReportCard$new()

card1$append_text("Header 2 text", "header2")
card1$append_text("A paragraph of default text", "header2")
Expand All @@ -15,14 +15,20 @@ card1$append_plot(
ggplot2::geom_histogram()
)

card2 <- teal.reporter::ReportCard$new()
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)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
{
card2$append_table(table_res2)
card2$append_table(iris)
}
)

reporter <- Reporter$new()
reporter$append_cards(list(card1, card2))
Expand Down Expand Up @@ -51,7 +57,7 @@ testthat::test_that("get_blocks and get_cards return empty list by default", {
})

testthat::test_that("The deep copy constructor copies the content files to new files", {
card <- teal.reporter::ReportCard$new()$append_plot(ggplot2::ggplot(iris))
card <- ReportCard$new()$append_plot(ggplot2::ggplot(iris))
reporter <- Reporter$new()$append_cards(list(card))
reporter_copy <- reporter$clone(deep = TRUE)
original_content_file <- reporter$get_blocks()[[1]]$get_content()
Expand Down
42 changes: 35 additions & 7 deletions tests/testthat/test-TableBlock.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,11 @@ testthat::test_that("new returns an object of type TableBlock", {

testthat::test_that("set_content accepts a table object", {
block <- TableBlock$new()
testthat::expect_no_error(block$set_content(iris))
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_no_error(block$set_content(iris))
)
})

testthat::test_that("set_content asserts the argument is a plot", {
Expand All @@ -18,7 +22,11 @@ testthat::test_that("set_content asserts the argument is a plot", {

testthat::test_that("set_content returns the TableBlock object", {
block <- TableBlock$new()
testthat::expect_identical(block$set_content(iris), block)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_identical(block$set_content(iris), block)
)
})

testthat::test_that("get_content returns character(0) on a newly initialized TableBlock", {
Expand All @@ -28,19 +36,31 @@ testthat::test_that("get_content returns character(0) on a newly initialized Tab
temp_dir <- tempdir()

testthat::test_that("to_list returns a named list with a one field, a proper file name", {
block <- TableBlock$new()$set_content(iris)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
block <- TableBlock$new()$set_content(iris)
)
testthat::expect_equal(block$to_list(temp_dir), list(basename = basename(block$get_content())))
})

# to_list
testthat::test_that("to_list returns a named list with a one field, a proper path", {
tblock <- TableBlock$new()$set_content(iris)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
tblock <- TableBlock$new()$set_content(iris)
)
testthat::expect_identical(tblock$to_list(temp_dir), list(basename = basename(tblock$get_content())))
})

# from_list
testthat::test_that("from_list after to_list to save and retrive", {
tblock <- TableBlock$new()$set_content(iris)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
tblock <- TableBlock$new()$set_content(iris)
)
testthat::expect_identical(
file.size(TableBlock$new()$from_list(
tblock$to_list(temp_dir),
Expand All @@ -52,7 +72,11 @@ testthat::test_that("from_list after to_list to save and retrive", {

testthat::test_that("set_content supports data.frame object", {
block <- TableBlock$new()
testthat::expect_no_error(block$set_content(iris))
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_no_error(block$set_content(iris))
)
})

testthat::test_that("set_content supports rtables object", {
Expand All @@ -65,5 +89,9 @@ testthat::test_that("set_content supports rtables object", {
"range" = diff(range(x))
)
})
testthat::expect_no_error(block$set_content(rtables::build_table(l, iris)))
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
testthat::expect_no_error(block$set_content(rtables::build_table(l, iris)))
)
})
6 changes: 5 additions & 1 deletion tests/testthat/test-utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,11 @@ testthat::test_that("panel_item", {

testthat::test_that("to_flextable: supported class", {
data_frame <- data.frame(A = 1:3, B = 4:6)
flextable_output <- to_flextable(data_frame)
# https://github.com/davidgohel/flextable/issues/600
withr::with_options(
opts_partial_match_old,
flextable_output <- to_flextable(data_frame)
)
testthat::expect_s3_class(flextable_output, "flextable")
})

Expand Down

0 comments on commit 384f941

Please sign in to comment.