diff --git a/DESCRIPTION b/DESCRIPTION index 5685c5c8..7283b1a4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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 diff --git a/R/Previewer.R b/R/Previewer.R index 883ad02f..5e0a81f4 100644 --- a/R/Previewer.R +++ b/R/Previewer.R @@ -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() @@ -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") ) }) diff --git a/R/SimpleReporter.R b/R/SimpleReporter.R index d2da97c0..ce11071e 100644 --- a/R/SimpleReporter.R +++ b/R/SimpleReporter.R @@ -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) { diff --git a/R/yaml_utils.R b/R/yaml_utils.R index d91734a0..c49fa83d 100644 --- a/R/yaml_utils.R +++ b/R/yaml_utils.R @@ -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") diff --git a/man/conv_str_logi.Rd b/man/conv_str_logi.Rd index 6b94e53a..d923faa4 100644 --- a/man/conv_str_logi.Rd +++ b/man/conv_str_logi.Rd @@ -30,7 +30,6 @@ conv_str_logi( Converts a single \code{character} string representing a \code{yaml} boolean value into a logical value in \code{R}. } \examples{ - conv_str_logi <- getFromNamespace("conv_str_logi", "teal.reporter") conv_str_logi("TRUE") conv_str_logi("True") diff --git a/man/simple_reporter.Rd b/man/simple_reporter.Rd index 84b46ce8..9f7d1c92 100644 --- a/man/simple_reporter.Rd +++ b/man/simple_reporter.Rd @@ -61,8 +61,9 @@ use \code{getOption('teal.reporter.global_knitr')}. These defaults include: } } \examples{ -library(shiny) if (interactive()) { + library(shiny) + shinyApp( ui = fluidPage(simple_reporter_ui("simple")), server = function(input, output, session) { diff --git a/tests/testthat/setup-options.R b/tests/testthat/setup-options.R new file mode 100644 index 00000000..78be1f9b --- /dev/null +++ b/tests/testthat/setup-options.R @@ -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() + ) +} diff --git a/tests/testthat/test-Archiver.R b/tests/testthat/test-Archiver.R index aeee4498..9cf88f94 100644 --- a/tests/testthat/test-Archiver.R +++ b/tests/testthat/test-Archiver.R @@ -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)) diff --git a/tests/testthat/test-Renderer.R b/tests/testthat/test-Renderer.R index 139caa06..546862a0 100644 --- a/tests/testthat/test-Renderer.R +++ b/tests/testthat/test-Renderer.R @@ -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) diff --git a/tests/testthat/test-ReportCard.R b/tests/testthat/test-ReportCard.R index 5c0f5a10..85bf3480 100644 --- a/tests/testthat/test-ReportCard.R +++ b/tests/testthat/test-ReportCard.R @@ -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", { diff --git a/tests/testthat/test-Reporter.R b/tests/testthat/test-Reporter.R index d3b90a62..6e59db1c 100644 --- a/tests/testthat/test-Reporter.R +++ b/tests/testthat/test-Reporter.R @@ -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") @@ -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)) @@ -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() diff --git a/tests/testthat/test-TableBlock.R b/tests/testthat/test-TableBlock.R index fe51d90b..bdc66539 100644 --- a/tests/testthat/test-TableBlock.R +++ b/tests/testthat/test-TableBlock.R @@ -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", { @@ -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", { @@ -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), @@ -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", { @@ -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))) + ) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index a21b8a34..98b2cde2 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -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") })