From b3444ed54bca52ba4bb662f2c3ef512fe889c72a Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Thu, 21 Mar 2024 22:21:29 +0100 Subject: [PATCH] Fixes in tests + Coverage (#615) - cleaning library calls - new file `tests/testthat/setup.R` - new manual mechanism for visual testing --- DESCRIPTION | 53 +++- R/df_printer.R | 1 - .../docx-grouped-data-no-single.png | Bin .../as_flextable/docx-grouped-data.png | Bin .../html-grouped-data-no-single.png | Bin .../as_flextable/html-grouped-data.png | Bin .../pptx-grouped-data-no-single.png | Bin .../as_flextable/pptx-grouped-data.png | Bin .../borders/docx-borders.png | Bin .../borders/docx-complex-borders.png | Bin .../borders/html-borders.png | Bin .../borders/pdf-complex-borders.png | Bin .../borders/pptx-borders.png | Bin .../borders/pptx-complex-borders.png | Bin .../md-captions/bookdown_html_document2.png | Bin .../md-captions/bookdown_pdf_document2.png | Bin .../md-captions/bookdown_word_document2.png | Bin .../md-captions/officedown_word_document2.png | Bin .../md-captions/rmarkdown_html_document.png | Bin .../md-captions/rmarkdown_pdf_document.png | Bin .../md-captions/rmarkdown_word_document.png | Bin tests/testthat.R | 2 - tests/testthat/setup.R | 148 +++++++++ tests/testthat/test-as-flextable.R | 21 -- tests/testthat/test-as_flextable.R | 294 +++++++++++++----- tests/testthat/test-borders.R | 88 +++--- tests/testthat/test-captions-rmd.R | 37 +-- ...est-cell-content.R => test-cell_content.R} | 8 +- tests/testthat/test-df_printer.R | 6 + tests/testthat/test-dimensions.R | 3 - tests/testthat/test-footers.R | 4 - tests/testthat/test-footnote.R | 2 - tests/testthat/test-gen_grob.R | 5 +- tests/testthat/test-headers.R | 3 - tests/testthat/test-images.R | 3 - .../{test-keep-next.R => test-keep_next.R} | 3 - tests/testthat/test-link.R | 3 - tests/testthat/test-md-captions.R | 52 ++-- tests/testthat/test-merge.R | 3 - tests/testthat/test-new-rows.R | 3 - tests/testthat/test-padding.R | 3 - tests/testthat/test-pptx-tables.R | 4 - tests/testthat/test-proc-freq.R | 3 - tests/testthat/test-rotations.R | 4 - tests/testthat/test-styles.R | 3 - tests/testthat/test-text.R | 3 - tests/testthat/zzzzz.R | 65 ---- 47 files changed, 495 insertions(+), 332 deletions(-) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/docx-grouped-data-no-single.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/docx-grouped-data.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/html-grouped-data-no-single.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/html-grouped-data.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/pptx-grouped-data-no-single.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/as_flextable/pptx-grouped-data.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/docx-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/docx-complex-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/html-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/pdf-complex-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/pptx-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/borders/pptx-complex-borders.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/bookdown_html_document2.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/bookdown_pdf_document2.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/bookdown_word_document2.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/officedown_word_document2.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/rmarkdown_html_document.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/rmarkdown_pdf_document.png (100%) rename {tests/testthat/_snaps => inst/snapshots_for_manual_tests}/md-captions/rmarkdown_word_document.png (100%) create mode 100644 tests/testthat/setup.R delete mode 100644 tests/testthat/test-as-flextable.R rename tests/testthat/{test-cell-content.R => test-cell_content.R} (98%) create mode 100644 tests/testthat/test-df_printer.R rename tests/testthat/{test-keep-next.R => test-keep_next.R} (96%) delete mode 100644 tests/testthat/zzzzz.R diff --git a/DESCRIPTION b/DESCRIPTION index 19e01edf..760522c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -18,7 +18,7 @@ Authors@R: c( person("Rémi", "Thériault", role = "ctb", comment = c(ORCID = "0000-0003-4315-6788", ctb = "theme_apa")), person("Samuel", "Jobert", role = "ctb", comment = "work on pagination") ) -Description: Use a grammar for creating and customizing pretty tables. +Description: Use a grammar for creating and customizing pretty tables. The following formats are supported: 'HTML', 'PDF', 'RTF', 'Microsoft Word', 'Microsoft PowerPoint' and R 'Grid Graphics'. 'R Markdown', 'Quarto' and the package 'officer' can be used to produce @@ -31,22 +31,47 @@ Description: Use a grammar for creating and customizing pretty tables. creation of complex cross tabulations. License: GPL-3 Imports: - stats, utils, grDevices, graphics, grid, - rmarkdown, knitr, htmltools, rlang, ragg, - officer (>= 0.6.5), gdtools (>= 0.3.6), - xml2, data.table (>= 1.13.0), uuid (>= 0.1-4) + data.table (>= 1.13.0), + gdtools (>= 0.3.6), + graphics, + grDevices, + grid, + htmltools, + knitr, + officer (>= 0.6.5), + ragg, + rlang, + rmarkdown (>= 2.0), + stats, + utils, + uuid (>= 0.1-4), + xml2 RoxygenNote: 7.3.1 Roxygen: list(markdown = TRUE) -Suggests: - testthat (>= 2.1.0), - magick, equatags, commonmark, - ggplot2, scales, +Suggests: + bookdown (>= 0.34), + broom, + broom.mixed, + cluster, + chromote, + commonmark, doconv (>= 0.3.0), - xtable, tables (>= 0.9.17), - broom, broom.mixed, - mgcv, cluster, lme4, nlme, - bookdown (>= 0.34), pdftools, officedown, - pkgdown (>= 2.0.0), webshot2, svglite + equatags, + ggplot2, + lme4, + magick, + mgcv, + nlme, + officedown, + pdftools, + pkgdown (>= 2.0.0), + scales, + svglite, + tables (>= 0.9.17), + testthat (>= 2.1.0), + webshot2, + withr, + xtable Encoding: UTF-8 URL: https://ardata-fr.github.io/flextable-book/, https://davidgohel.github.io/flextable/ BugReports: https://github.com/davidgohel/flextable/issues diff --git a/R/df_printer.R b/R/df_printer.R index 76d4630b..582941c5 100644 --- a/R/df_printer.R +++ b/R/df_printer.R @@ -246,7 +246,6 @@ as_flextable.data.frame <- function(x, show_coltype = TRUE, color_coltype = "#999999", ...) { - if (inherits(x, "data.table")) { x <- as.data.frame(x) } else if (inherits(x, "tbl_df")) { diff --git a/tests/testthat/_snaps/as_flextable/docx-grouped-data-no-single.png b/inst/snapshots_for_manual_tests/as_flextable/docx-grouped-data-no-single.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/docx-grouped-data-no-single.png rename to inst/snapshots_for_manual_tests/as_flextable/docx-grouped-data-no-single.png diff --git a/tests/testthat/_snaps/as_flextable/docx-grouped-data.png b/inst/snapshots_for_manual_tests/as_flextable/docx-grouped-data.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/docx-grouped-data.png rename to inst/snapshots_for_manual_tests/as_flextable/docx-grouped-data.png diff --git a/tests/testthat/_snaps/as_flextable/html-grouped-data-no-single.png b/inst/snapshots_for_manual_tests/as_flextable/html-grouped-data-no-single.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/html-grouped-data-no-single.png rename to inst/snapshots_for_manual_tests/as_flextable/html-grouped-data-no-single.png diff --git a/tests/testthat/_snaps/as_flextable/html-grouped-data.png b/inst/snapshots_for_manual_tests/as_flextable/html-grouped-data.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/html-grouped-data.png rename to inst/snapshots_for_manual_tests/as_flextable/html-grouped-data.png diff --git a/tests/testthat/_snaps/as_flextable/pptx-grouped-data-no-single.png b/inst/snapshots_for_manual_tests/as_flextable/pptx-grouped-data-no-single.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/pptx-grouped-data-no-single.png rename to inst/snapshots_for_manual_tests/as_flextable/pptx-grouped-data-no-single.png diff --git a/tests/testthat/_snaps/as_flextable/pptx-grouped-data.png b/inst/snapshots_for_manual_tests/as_flextable/pptx-grouped-data.png similarity index 100% rename from tests/testthat/_snaps/as_flextable/pptx-grouped-data.png rename to inst/snapshots_for_manual_tests/as_flextable/pptx-grouped-data.png diff --git a/tests/testthat/_snaps/borders/docx-borders.png b/inst/snapshots_for_manual_tests/borders/docx-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/docx-borders.png rename to inst/snapshots_for_manual_tests/borders/docx-borders.png diff --git a/tests/testthat/_snaps/borders/docx-complex-borders.png b/inst/snapshots_for_manual_tests/borders/docx-complex-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/docx-complex-borders.png rename to inst/snapshots_for_manual_tests/borders/docx-complex-borders.png diff --git a/tests/testthat/_snaps/borders/html-borders.png b/inst/snapshots_for_manual_tests/borders/html-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/html-borders.png rename to inst/snapshots_for_manual_tests/borders/html-borders.png diff --git a/tests/testthat/_snaps/borders/pdf-complex-borders.png b/inst/snapshots_for_manual_tests/borders/pdf-complex-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/pdf-complex-borders.png rename to inst/snapshots_for_manual_tests/borders/pdf-complex-borders.png diff --git a/tests/testthat/_snaps/borders/pptx-borders.png b/inst/snapshots_for_manual_tests/borders/pptx-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/pptx-borders.png rename to inst/snapshots_for_manual_tests/borders/pptx-borders.png diff --git a/tests/testthat/_snaps/borders/pptx-complex-borders.png b/inst/snapshots_for_manual_tests/borders/pptx-complex-borders.png similarity index 100% rename from tests/testthat/_snaps/borders/pptx-complex-borders.png rename to inst/snapshots_for_manual_tests/borders/pptx-complex-borders.png diff --git a/tests/testthat/_snaps/md-captions/bookdown_html_document2.png b/inst/snapshots_for_manual_tests/md-captions/bookdown_html_document2.png similarity index 100% rename from tests/testthat/_snaps/md-captions/bookdown_html_document2.png rename to inst/snapshots_for_manual_tests/md-captions/bookdown_html_document2.png diff --git a/tests/testthat/_snaps/md-captions/bookdown_pdf_document2.png b/inst/snapshots_for_manual_tests/md-captions/bookdown_pdf_document2.png similarity index 100% rename from tests/testthat/_snaps/md-captions/bookdown_pdf_document2.png rename to inst/snapshots_for_manual_tests/md-captions/bookdown_pdf_document2.png diff --git a/tests/testthat/_snaps/md-captions/bookdown_word_document2.png b/inst/snapshots_for_manual_tests/md-captions/bookdown_word_document2.png similarity index 100% rename from tests/testthat/_snaps/md-captions/bookdown_word_document2.png rename to inst/snapshots_for_manual_tests/md-captions/bookdown_word_document2.png diff --git a/tests/testthat/_snaps/md-captions/officedown_word_document2.png b/inst/snapshots_for_manual_tests/md-captions/officedown_word_document2.png similarity index 100% rename from tests/testthat/_snaps/md-captions/officedown_word_document2.png rename to inst/snapshots_for_manual_tests/md-captions/officedown_word_document2.png diff --git a/tests/testthat/_snaps/md-captions/rmarkdown_html_document.png b/inst/snapshots_for_manual_tests/md-captions/rmarkdown_html_document.png similarity index 100% rename from tests/testthat/_snaps/md-captions/rmarkdown_html_document.png rename to inst/snapshots_for_manual_tests/md-captions/rmarkdown_html_document.png diff --git a/tests/testthat/_snaps/md-captions/rmarkdown_pdf_document.png b/inst/snapshots_for_manual_tests/md-captions/rmarkdown_pdf_document.png similarity index 100% rename from tests/testthat/_snaps/md-captions/rmarkdown_pdf_document.png rename to inst/snapshots_for_manual_tests/md-captions/rmarkdown_pdf_document.png diff --git a/tests/testthat/_snaps/md-captions/rmarkdown_word_document.png b/inst/snapshots_for_manual_tests/md-captions/rmarkdown_word_document.png similarity index 100% rename from tests/testthat/_snaps/md-captions/rmarkdown_word_document.png rename to inst/snapshots_for_manual_tests/md-captions/rmarkdown_word_document.png diff --git a/tests/testthat.R b/tests/testthat.R index 5ed1ce7a..406cf17e 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,3 @@ library(testthat) -library(flextable) -library(officer) test_check("flextable") diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R new file mode 100644 index 00000000..82ac177b --- /dev/null +++ b/tests/testthat/setup.R @@ -0,0 +1,148 @@ +# Collection of functions and data pre-processing to help with testing +library(officer) +library(xml2) + +# xml related functions -------------------------------------------------------- +get_docx_xml <- function(x) { + if (inherits(x, "flextable")) { + docx_file <- tempfile(fileext = ".docx") + doc <- read_docx() + doc <- body_add_flextable(doc, value = x) + print(doc, target = docx_file) + x <- docx_file + } + redoc <- read_docx(x) + xml_child(docx_body_xml(redoc)) +} + +get_pptx_xml <- function(x) { + if (inherits(x, "flextable")) { + pptx_file <- tempfile(fileext = ".pptx") + doc <- read_pptx() + doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme") + doc <- ph_with(doc, x, location = ph_location_type(type = "body")) + print(doc, target = pptx_file) + x <- pptx_file + } + + redoc <- read_pptx(x) + slide <- redoc$slide$get_slide(redoc$cursor) + xml_child(slide$get()) +} + +get_html_xml <- function(x) { + if (inherits(x, "flextable")) { + html_file <- tempfile(fileext = ".html") + save_as_html(tab, path = html_file) + x <- html_file + } + doc <- read_html(x) + xml_child(doc, "body") +} +get_pdf_text <- function(x, extract_fun) { + stopifnot(grepl("\\.pdf$", x)) + + doc <- extract_fun(x) + txtfile <- tempfile() + cat(paste0(doc, collapse = "\n"), file = txtfile) + readLines(txtfile) +} + +render_rmd <- function(file, rmd_format) { + unlink(file, force = TRUE) + sucess <- FALSE + tryCatch( + { + render(rmd_file, + output_format = rmd_format, + output_file = pdf_file, + envir = new.env(), + quiet = TRUE + ) + sucess <- TRUE + }, + warning = function(e) { + }, + error = function(e) { + } + ) + sucess +} + +# Getting snapshots in the _snaps folder for local testing if conditions are met +do_manual_msoffice_snapshot_testing <- FALSE +copy_back_new_snapshots <- FALSE # if snapshots are updated can be rewritten back + +# Utility function to manually test local snapshots ---------------------------- +skip_if_not_local_testing <- function(min_pandoc_version = "2", check_html = FALSE) { + skip_on_cran() # When doing manual testing, it should be always skipped on CRAN + skip_on_ci() # msoffice testing can not be done on ci + skip_if_not(do_manual_msoffice_snapshot_testing) + local_edition(3, .env = parent.frame()) # Set the local_edition at 3 + skip_if_not_installed("doconv") + skip_if_not(doconv::msoffice_available()) + if (!is.null(min_pandoc_version)) { # Can be turned off with NULL + skip_if_not(rmarkdown::pandoc_version() >= numeric_version(min_pandoc_version)) + } + if (isTRUE(check_html)) { + skip_if_not_installed("webshot2") + } + invisible(TRUE) +} + +handle_manual_snapshots <- function(snapshot_folder, snapshot_name) { + skip_if_not_installed("withr") + skip_if_not(do_manual_msoffice_snapshot_testing) + + snapshot_name <- paste0(snapshot_name, ".png") + + # Folder where the snapshots are stored + main_inst_folder <- system.file("snapshots_for_manual_tests", package = "flextable", mustWork = TRUE) + + snapshot_file <- file.path(main_inst_folder, snapshot_folder, snapshot_name) + + if (!file.exists(snapshot_file)) { + stop("Following snapshot file not found in {flextable}:", snapshot_file) + } + + # Construct the path to the _snaps folder + path_to_snaps <- file.path("_snaps", snapshot_folder) + if (!dir.exists("_snaps")) { + dir.create("_snaps") + } + if (!dir.exists(path_to_snaps)) { + dir.create(path_to_snaps) + } + + # Main copy + file.copy(snapshot_file, path_to_snaps, overwrite = TRUE) + + # Copying back and cleaning test folder + withr::defer( + { + snap_file <- file.path(path_to_snaps, snapshot_name) + if (copy_back_new_snapshots) { + file.copy(snap_file, dirname(snapshot_file), overwrite = TRUE) + } + if (file.exists(snap_file)) { + file.remove(snap_file) + } + }, + envir = parent.frame() + ) +} + +defer_cleaning_snapshot_directory <- function(snap_folder_test_file) { + skip_if_not_installed("withr") + skip_if_not(do_manual_msoffice_snapshot_testing) + withr::defer({ + last_folder <- file.path("_snaps", snap_folder_test_file) + files_not_removed_for_error <- list.files(last_folder) + if (length(files_not_removed_for_error)) { + lapply(files_not_removed_for_error, file.remove) + } + if (dir.exists("_snaps")) { + unlink("_snaps", recursive = TRUE) + } + }) +} diff --git a/tests/testthat/test-as-flextable.R b/tests/testthat/test-as-flextable.R deleted file mode 100644 index 349adf29..00000000 --- a/tests/testthat/test-as-flextable.R +++ /dev/null @@ -1,21 +0,0 @@ -context("check as_flextable") - -test_that("data.frame", { - dummy_df <- data.frame( - A = rep(letters[1:3], each = 2), - B = seq(0, 1, length = 6) - ) - ft <- as_flextable(dummy_df) - expect_equal( - information_data_chunk(ft)$txt, - c( - "A", "B", "character", "numeric", "a", "0.0", "a", "0.2", - "b", "0.4", "b", "0.6", "c", "0.8", "c", "1.0", "n: 6", "n: 6" - ) - ) - ft <- as_flextable(dummy_df[1, ]) - expect_equal( - information_data_chunk(ft)$txt, - c("A", "
", "character", "a", "B", "
", "numeric", "0") - ) -}) diff --git a/tests/testthat/test-as_flextable.R b/tests/testthat/test-as_flextable.R index 908a43b4..070436f7 100644 --- a/tests/testthat/test-as_flextable.R +++ b/tests/testthat/test-as_flextable.R @@ -1,88 +1,240 @@ context("check as_flextable") -skip_on_cran() -skip_if_not_installed("doconv") -library(doconv) -skip_if_not(doconv::msoffice_available()) -skip_if_not(pandoc_version() >= numeric_version("2")) -skip_if_not_installed("webshot2") - -init_flextable_defaults() -set_flextable_defaults( - post_process_pptx = function(x) { - set_table_properties(x, layout = "fixed") |> - autofit() - } -) -data_co2 <- - structure( - list( - Treatment = structure(c(3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L), - levels = c("nonchilled", "chilled", "zoubi", "bisou"), class = "factor" - ), - conc = c(85L, 95L, 175L, 250L, 350L, 500L, 675L, 1000L, 95L, 175L, 250L, 350L, 500L, 675L, 1000L, NA, 1000L), - Quebec = c( - 12, 15.2666666666667, 30.0333333333333, 37.4, 40.3666666666667, 39.6, 41.5, 43.1666666666667, - 12.8666666666667, 24.1333333333333, 34.4666666666667, 35.8, 36.6666666666667, - 37.5, 40.8333333333333, 43, 43 +test_that("data.frame", { + dummy_df <- data.frame( + A = rep(letters[1:3], each = 2), + B = seq(0, 1, length = 6) + ) + ft <- as_flextable(dummy_df) + expect_equal( + information_data_chunk(ft)$txt, + c( + "A", "B", "character", "numeric", "a", "0.0", "a", "0.2", + "b", "0.4", "b", "0.6", "c", "0.8", "c", "1.0", "n: 6", "n: 6" + ) + ) + ft <- as_flextable(dummy_df[1, ]) + expect_equal( + information_data_chunk(ft)$txt, + c("A", "
", "character", "a", "B", "
", "numeric", "0") + ) +}) + +test_that("grouped_data", { + my_CO2 <- CO2 + setDT(my_CO2) + my_CO2$conc <- as.integer(my_CO2$conc) + data_co2 <- dcast(my_CO2, Treatment + conc ~ Type, + value.var = "uptake", fun.aggregate = mean + ) + expect_silent( + data_co2 <- as_grouped_data(x = data_co2, groups = c("Treatment")) + ) + expect_equal( + data_co2$Treatment[seq_len(2)], + factor(c("nonchilled", NA), levels = c("nonchilled", "chilled")) + ) + expect_equal( + data_co2$Treatment[c(8, 9, 10)], + factor(c(NA, "chilled", NA), levels = c("nonchilled", "chilled")) + ) + + out_tmp <- data_co2[1, , drop = TRUE] + expect_equal(attr(out_tmp, "groups"), "Treatment") + expect_equal(attr(out_tmp, "columns"), c("conc", "Quebec", "Mississippi")) + expect_equal(unlist(out_tmp, use.names = FALSE), c(1, NA, NA, NA)) + + expect_s3_class(data_co2, "grouped_data") + + expect_silent( + data_co2 <- as_grouped_data(x = data_co2, groups = c("Treatment"), expand_single = TRUE) + ) + expect_true(all(is.na(unlist(data_co2[c(12, 13), , drop = TRUE], use.names = FALSE)))) + + ft <- as_flextable(data_co2) + expect_equal( + information_data_chunk(ft)$txt[seq_len(9)], + c("conc", "Quebec", "Mississippi", "Treatment", ": ", "nonchilled", "", "", "") + ) + expect_equal(information_data_chunk(ft)$txt[15], "95") + + ft <- as_flextable(data_co2, hide_grouplabel = TRUE) + expect_equal( + information_data_chunk(ft)$txt[seq_len(9)], + c("conc", "Quebec", "Mississippi", "nonchilled", "", "", "", "", "") + ) +}) + +test_that("glm and lm", { + skip_if_not_installed("broom") + options("show.signif.stars" = TRUE) + dat <- attitude + dat$high.rating <- (dat$rating > 70) + probit.model <- glm(high.rating ~ learning + critical + + advance, data = dat, family = binomial(link = "probit")) + expect_silent(ft <- as_flextable(probit.model)) + + expect_equal( + information_data_chunk(ft)$txt[5], + "Pr(>|z|)" + ) + expect_equal( + information_data_chunk(ft)$txt[31], + "Signif. codes: 0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05" + ) + + lmod <- lm(rating ~ complaints + privileges + + learning + raises + critical, data = attitude) + ft <- as_flextable(lmod) + expect_equal( + information_data_chunk(ft)$txt[5], + "Pr(>|t|)" + ) + expect_equal( + information_data_chunk(ft)$txt[44], + "Signif. codes: 0 <= '***' < 0.001 < '**' < 0.01 < '*' < 0.05" + ) + expect_equal( + information_data_chunk(ft)$txt[72], + "F-statistic: 12.06 on 24 and 5 DF, p-value: 0.0000" + ) +}) + +test_that("htest", { + set.seed(16) + M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477))) + dimnames(M) <- list( + gender = c("F", "M"), + party = c("Democrat", "Independent", "Republican") + ) + ft <- as_flextable(stats::chisq.test(M)) + expect_equal( + information_data_chunk(ft)$txt[6], + "0.0000" + ) +}) + +test_that("continuous_summary works", { + ft_1 <- continuous_summary(iris, names(iris)[1:4], + by = "Species", + hide_grouplabel = FALSE + ) + expect_identical( + information_data_chunk(ft_1)$txt[c(1, 11, 14, 71)], + c("Species", "# na", "Sepal.Length", "setosa") + ) +}) + +test_that("transformation of mixed models works", { + skip_if_not_installed("broom.mixed") + skip_if_not_installed("nlme") + m1 <- nlme::lme(distance ~ age, data = nlme::Orthodont) + ft <- as_flextable(m1) + expect_equal( + information_data_chunk(ft)$txt[c(18, 108)], + c("(Intercept)", "Akaike Information Criterion: 454.6") + ) +}) + +test_that("kmeans works", { + set.seed(11) + cl <- kmeans(scale(mtcars[1:7]), 5) + ft <- as_flextable(cl) + expect_equal( + information_data_chunk(ft)$txt[c(37, 163)], + c("1.0906", "BSS/TSS ratio: 80.1%") + ) +}) + +test_that("partitioning around medoids works", { + skip_if_not_installed("cluster") + set.seed(11) + dat <- as.data.frame(scale(mtcars[1:7])) + cl <- cluster::pam(dat, 3) + ft <- as_flextable(cl) + expect_equal( + information_data_chunk(ft)$txt[c(37, 163, 17)], + c("", NA, "2.2") + ) +}) + +test_that("grouped data exports work", { + skip_if_not_local_testing(check_html = TRUE) + snap_folder_test_file <- "as_flextable" + defer_cleaning_snapshot_directory(snap_folder_test_file) + + init_flextable_defaults() + set_flextable_defaults( + post_process_pptx = function(x) { + set_table_properties(x, layout = "fixed") |> + autofit() + } + ) + + data_co2 <- + structure( + list( + Treatment = structure(c(3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 4L, 4L), + levels = c("nonchilled", "chilled", "zoubi", "bisou"), class = "factor" + ), + conc = c(85L, 95L, 175L, 250L, 350L, 500L, 675L, 1000L, 95L, 175L, 250L, 350L, 500L, 675L, 1000L, NA, 1000L), + Quebec = c( + 12, 15.2666666666667, 30.0333333333333, 37.4, 40.3666666666667, 39.6, 41.5, 43.1666666666667, + 12.8666666666667, 24.1333333333333, 34.4666666666667, 35.8, 36.6666666666667, + 37.5, 40.8333333333333, 43, 43 + ), + Mississippi = c( + 10, 11.3, 20.2, 27.5333333333333, 29.9, 30.6, 30.5333333333333, 31.6, 9.6, 14.7666666666667, 16.1, + 16.6, 16.6333333333333, 18.2666666666667, 18.7333333333333, 19, 19 + ) ), - Mississippi = c( - 10, 11.3, 20.2, 27.5333333333333, 29.9, 30.6, 30.5333333333333, 31.6, 9.6, 14.7666666666667, 16.1, - 16.6, 16.6333333333333, 18.2666666666667, 18.7333333333333, 19, 19 - ) - ), - row.names = c(NA, -17L), - class = "data.frame" - ) -gdata <- as_grouped_data(x = data_co2, groups = c("Treatment")) - -ft_1 <- as_flextable(gdata) -ft_1 <- colformat_double(ft_1, digits = 2) -ft_1 <- set_table_properties(ft_1, layout = "autofit") - -test_that("pptx grouped-data", { - local_edition(3) + row.names = c(NA, -17L), + class = "data.frame" + ) + gdata <- as_grouped_data(x = data_co2, groups = c("Treatment")) + + ft_1 <- as_flextable(gdata) + ft_1 <- colformat_double(ft_1, digits = 2) + ft_1 <- set_table_properties(ft_1, layout = "autofit") + + # pptx grouped-data path <- save_as_pptx(ft_1, path = tempfile(fileext = ".pptx")) - expect_snapshot_doc(name = "pptx-grouped-data", x = path, engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "pptx-grouped-data") + doconv::expect_snapshot_doc(name = "pptx-grouped-data", x = path, engine = "testthat") -test_that("docx grouped-data", { - local_edition(3) + # docx grouped-data path <- save_as_docx(ft_1, path = tempfile(fileext = ".docx")) - expect_snapshot_doc(x = path, name = "docx-grouped-data", engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "docx-grouped-data") + doconv::expect_snapshot_doc(x = path, name = "docx-grouped-data", engine = "testthat") -test_that("html grouped-data", { - local_edition(3) + # html grouped-data path <- save_as_html(ft_1, path = tempfile(fileext = ".html")) - expect_snapshot_html(name = "html-grouped-data", path, engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "html-grouped-data") + doconv::expect_snapshot_html(name = "html-grouped-data", path, engine = "testthat") -gdata <- as_grouped_data( - x = data_co2, groups = c("Treatment"), - expand_single = FALSE -) + gdata <- as_grouped_data( + x = data_co2, groups = c("Treatment"), + expand_single = FALSE + ) -ft_2 <- as_flextable(gdata) -ft_2 <- colformat_double(ft_2, digits = 2) -ft_2 <- autofit(ft_2) + ft_2 <- as_flextable(gdata) + ft_2 <- colformat_double(ft_2, digits = 2) + ft_2 <- autofit(ft_2) -test_that("pptx grouped-data-no-single", { - local_edition(3) + # pptx grouped-data-no-single path <- save_as_pptx(ft_2, path = tempfile(fileext = ".pptx")) - expect_snapshot_doc(x = path, name = "pptx-grouped-data-no-single", engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "pptx-grouped-data-no-single") + doconv::expect_snapshot_doc(x = path, name = "pptx-grouped-data-no-single", engine = "testthat") -test_that("docx grouped-data-no-single", { - local_edition(3) + # docx grouped-data-no-single path <- save_as_docx(ft_2, path = tempfile(fileext = ".docx")) - expect_snapshot_doc(x = path, name = "docx-grouped-data-no-single", engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "docx-grouped-data-no-single") + doconv::expect_snapshot_doc(x = path, name = "docx-grouped-data-no-single", engine = "testthat") -test_that("html grouped-data-no-single", { - local_edition(3) + # html grouped-data-no-single path <- save_as_html(ft_2, path = tempfile(fileext = ".html")) - expect_snapshot_html(name = "html-grouped-data-no-single", path, engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "html-grouped-data-no-single") + doconv::expect_snapshot_html(name = "html-grouped-data-no-single", path, engine = "testthat") -init_flextable_defaults() + init_flextable_defaults() +}) diff --git a/tests/testthat/test-borders.R b/tests/testthat/test-borders.R index 541afc17..108639a9 100644 --- a/tests/testthat/test-borders.R +++ b/tests/testthat/test-borders.R @@ -1,11 +1,9 @@ context("check borders rendering") -skip_on_cran() -skip_on_ci() - init_flextable_defaults() +snap_folder_test_file <- "borders" +defer_cleaning_snapshot_directory(snap_folder_test_file) -library(data.table) set.seed(2) USUBJID <- sprintf("01-ABC-%04.0f", 1:200) @@ -47,41 +45,40 @@ tab <- tabulator( })) ) -ft_1 <- as_flextable(x = tab, separate_with = "VISIT", label_rows = c(LBTEST = "Lab Test", VISIT = "Visit", BASELINE = "Reference\nRange\nIndicator")) +ft_1 <- as_flextable( + x = tab, separate_with = "VISIT", + label_rows = c( + LBTEST = "Lab Test", + VISIT = "Visit", + BASELINE = "Reference\nRange\nIndicator" + ) +) ft_1 <- width(ft_1, j = 3, width = 1) -test_that("pptx borders", { - skip_if_not(pandoc_version() >= numeric_version("2")) - skip_if_not_installed("doconv") - library(doconv) - skip_if_not(doconv::msoffice_available()) - local_edition(3) - expect_snapshot_doc( +test_that("pptx, docx, and html borders", { + skip_if_not_local_testing(check_html = TRUE) + + # pptx borders + handle_manual_snapshots(snap_folder_test_file, "pptx-borders") + doconv::expect_snapshot_doc( x = save_as_pptx(ft_1, path = tempfile(fileext = ".pptx")), name = "pptx-borders", engine = "testthat" ) -}) -test_that("docx borders", { - skip_if_not(pandoc_version() >= numeric_version("2")) - skip_if_not_installed("doconv") - library(doconv) - skip_if_not(doconv::msoffice_available()) - local_edition(3) - expect_snapshot_doc( + # docx borders + handle_manual_snapshots(snap_folder_test_file, "docx-borders") + doconv::expect_snapshot_doc( x = save_as_docx(ft_1, path = tempfile(fileext = ".docx")), name = "docx-borders", engine = "testthat" ) -}) -test_that("html borders", { - local_edition(3) - skip_if_not(pandoc_version() >= numeric_version("2")) - skip_if_not_installed("doconv") - library(doconv) - skip_if_not_installed("webshot2") + # html borders + handle_manual_snapshots(snap_folder_test_file, "html-borders") path <- save_as_html(ft_1, path = tempfile(fileext = ".html")) - expect_snapshot_html(name = "html-borders", path, engine = "testthat") + skip_if_not_installed("chromote") + suppressMessages(is_there_chrome <- chromote::find_chrome()) + skip_if(is.null(is_there_chrome)) + doconv::expect_snapshot_html(name = "html-borders", path, engine = "testthat") }) @@ -96,45 +93,38 @@ html_file <- gsub("\\.Rmd$", ".html", rmd_file) docx_file <- gsub("\\.Rmd$", ".docx", rmd_file) pdf_file <- gsub("\\.Rmd$", ".pdf", rmd_file) pptx_file <- gsub("\\.Rmd$", ".pptx", rmd_file) -source("zzzzz.R") -test_that("pdf complex borders", { - local_edition(3) - library(rmarkdown) - skip_if_not(pandoc_available()) - skip_if_not(pandoc_version() > numeric_version("2.7.3")) +test_that("pdf and office complex borders", { + skip_if_not_local_testing(min_pandoc_version = "2.7.3") + + # pdf office complex borders render(rmd_file, output_format = rmarkdown::pdf_document(latex_engine = "xelatex"), output_file = pdf_file, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "pdf-complex-borders", pdf_file, engine = "testthat") -}) + handle_manual_snapshots(snap_folder_test_file, "pdf-complex-borders") + doconv::expect_snapshot_doc(name = "pdf-complex-borders", pdf_file, engine = "testthat") -test_that("office complex borders", { - local_edition(3) - library(rmarkdown) - skip_if_not(pandoc_available()) - skip_if_not(pandoc_version() > numeric_version("2.7.3")) - skip_if_not_installed("doconv") - skip_if_not(doconv::msoffice_available()) - library(doconv) + # office complex borders render(rmd_file, - output_format = rmarkdown::word_document(), + output_format = word_document(), output_file = docx_file, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "docx-complex-borders", docx_file, engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "docx-complex-borders") + doconv::expect_snapshot_doc(name = "docx-complex-borders", docx_file, engine = "testthat") + render(rmd_file, - output_format = rmarkdown::powerpoint_presentation(), + output_format = powerpoint_presentation(), output_file = pptx_file, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "pptx-complex-borders", pptx_file, engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "pptx-complex-borders") + doconv::expect_snapshot_doc(name = "pptx-complex-borders", pptx_file, engine = "testthat") }) - init_flextable_defaults() diff --git a/tests/testthat/test-captions-rmd.R b/tests/testthat/test-captions-rmd.R index 70d1ad3b..84a5bfaf 100644 --- a/tests/testthat/test-captions-rmd.R +++ b/tests/testthat/test-captions-rmd.R @@ -1,8 +1,5 @@ context("check captions") -library(rmarkdown) -library(xml2) -library(officer) init_flextable_defaults() rmd_file_0 <- "rmd/captions.Rmd" @@ -16,11 +13,8 @@ html_file <- gsub("\\.Rmd$", ".html", rmd_file) docx_file <- gsub("\\.Rmd$", ".docx", rmd_file) pdf_file <- gsub("\\.Rmd$", ".pdf", rmd_file) -source("zzzzz.R") - -testthat::test_that("with html_document", { - skip_if_not(rmarkdown::pandoc_available()) - skip_if_not(pandoc_version() >= numeric_version("2")) +test_that("with html_document", { + skip_if_not_local_testing() unlink(html_file, force = TRUE) render(rmd_file, output_format = rmarkdown::html_document(), @@ -52,10 +46,9 @@ testthat::test_that("with html_document", { expect_true(all(!grepl("Table [0-9]+:", xml_text(captions)))) }) -testthat::test_that("with html_document2", { - skip_if_not(rmarkdown::pandoc_available()) - skip_if_not(pandoc_version() >= numeric_version("2")) - testthat::skip_if_not_installed("bookdown") +test_that("with html_document2", { + skip_if_not_local_testing() + skip_if_not_installed("bookdown") unlink(html_file, force = TRUE) render(rmd_file, @@ -86,9 +79,8 @@ testthat::test_that("with html_document2", { expect_true(grepl("Table 2:", xml_text(caption))) }) -testthat::test_that("with word_document", { - skip_if_not(rmarkdown::pandoc_available()) - skip_if_not(pandoc_version() >= numeric_version("2")) +test_that("with word_document", { + skip_if_not_local_testing() skip_if(pandoc_version() == numeric_version("2.9.2.1")) unlink(docx_file, force = TRUE) @@ -118,11 +110,10 @@ testthat::test_that("with word_document", { expect_length(bookmarks, 0) }) -testthat::test_that("with word_document2", { - skip_if_not(rmarkdown::pandoc_available(version = )) - skip_if_not(pandoc_version() > numeric_version("2.7.3")) - testthat::skip_if_not_installed("bookdown") +test_that("with word_document2", { + skip_if_not_local_testing(min_pandoc_version = "2.7.3") skip_if(pandoc_version() == numeric_version("2.9.2.1")) + skip_if_not_installed("bookdown") unlink(docx_file, force = TRUE) render(rmd_file, @@ -158,7 +149,7 @@ testthat::test_that("with word_document2", { -testthat::test_that("word with officer", { +test_that("word with officer", { unlink(docx_file, force = TRUE) ft <- flextable(head(cars)) ft <- theme_vanilla(ft) @@ -192,9 +183,7 @@ testthat::test_that("word with officer", { test_that("with pdf_document2", { - skip_on_cran() - skip_if_not(rmarkdown::pandoc_available()) - skip_if_not(pandoc_version() > numeric_version("2.7.3")) + skip_if_not_local_testing(min_pandoc_version = "2.7.3") skip_if_not_installed("bookdown") skip_if_not_installed("pdftools") @@ -204,7 +193,7 @@ test_that("with pdf_document2", { doc <- get_pdf_text(pdf_file, extract_fun = pdftools::pdf_text) expect_true(any(grepl("Cross-reference is there: 2", doc, fixed = TRUE))) } else { - testthat::expect_false(sucess) # only necessary to avoid a note + expect_false(sucess) # only necessary to avoid a note } }) diff --git a/tests/testthat/test-cell-content.R b/tests/testthat/test-cell_content.R similarity index 98% rename from tests/testthat/test-cell-content.R rename to tests/testthat/test-cell_content.R index 2bd89664..6efa475c 100644 --- a/tests/testthat/test-cell-content.R +++ b/tests/testthat/test-cell_content.R @@ -1,10 +1,4 @@ -context("cell content") - -library(utils) -library(xml2) -library(officer) -library(rmarkdown) - +context("check cell content") test_that("void works as expected", { expect_error(void(12, part = "all")) diff --git a/tests/testthat/test-df_printer.R b/tests/testthat/test-df_printer.R new file mode 100644 index 00000000..b25feac6 --- /dev/null +++ b/tests/testthat/test-df_printer.R @@ -0,0 +1,6 @@ +context("df_printer and utilities") + +test_that("use_model_printer and use_df_printer works", { + expect_silent(use_model_printer()) + expect_silent(use_df_printer()) +}) diff --git a/tests/testthat/test-dimensions.R b/tests/testthat/test-dimensions.R index 0541f57a..a90e1a4e 100644 --- a/tests/testthat/test-dimensions.R +++ b/tests/testthat/test-dimensions.R @@ -1,8 +1,5 @@ context("check widths and heights") -library(utils) -library(xml2) - test_that("dimensions are valid", { dummy_df <- data.frame(my_col = rep(letters[1:3], each = 2), stringsAsFactors = FALSE) ft <- flextable(dummy_df) diff --git a/tests/testthat/test-footers.R b/tests/testthat/test-footers.R index 5223b545..c501e31f 100644 --- a/tests/testthat/test-footers.R +++ b/tests/testthat/test-footers.R @@ -1,9 +1,5 @@ context("check footers") -library(xml2) -library(officer) - - test_that("add_footer", { data_ref <- structure( list( diff --git a/tests/testthat/test-footnote.R b/tests/testthat/test-footnote.R index e3f224ee..0454cb93 100644 --- a/tests/testthat/test-footnote.R +++ b/tests/testthat/test-footnote.R @@ -1,7 +1,5 @@ context("check footnotes") -library(data.table) - ft <- flextable(iris[1:5, ]) ft <- footnote( x = ft, i = 1:3, j = 1:3, diff --git a/tests/testthat/test-gen_grob.R b/tests/testthat/test-gen_grob.R index e9d2f968..8fff0b0e 100644 --- a/tests/testthat/test-gen_grob.R +++ b/tests/testthat/test-gen_grob.R @@ -1,9 +1,6 @@ context("check grid grob") -library(officer) -library(gdtools) - -register_liberationsans() +gdtools::register_liberationsans() init_flextable_defaults() diff --git a/tests/testthat/test-headers.R b/tests/testthat/test-headers.R index b1f76bdf..e421783f 100644 --- a/tests/testthat/test-headers.R +++ b/tests/testthat/test-headers.R @@ -1,8 +1,5 @@ context("check headers") -library(xml2) -library(officer) - test_that("set_header_labels", { col_keys <- c( "Species", diff --git a/tests/testthat/test-images.R b/tests/testthat/test-images.R index 20fde8f6..e07ed887 100644 --- a/tests/testthat/test-images.R +++ b/tests/testthat/test-images.R @@ -1,8 +1,5 @@ context("check images") -library(xml2) -library(officer) - data <- iris[c(1:3, 51:53, 101:104), ] col_keys <- c("Species", "sep_1", "Sepal.Length", "Sepal.Width", "sep_2", "Petal.Length", "Petal.Width") img.file <- file.path(R.home("doc"), "html", "logo.jpg") diff --git a/tests/testthat/test-keep-next.R b/tests/testthat/test-keep_next.R similarity index 96% rename from tests/testthat/test-keep-next.R rename to tests/testthat/test-keep_next.R index 8213f862..658fe3a3 100644 --- a/tests/testthat/test-keep-next.R +++ b/tests/testthat/test-keep_next.R @@ -1,8 +1,5 @@ context("check keep with next") -library(officer) -library(xml2) - init_flextable_defaults() iris_sum <- summarizor(iris, by = "Species") diff --git a/tests/testthat/test-link.R b/tests/testthat/test-link.R index 51974e4a..246d05fc 100644 --- a/tests/testthat/test-link.R +++ b/tests/testthat/test-link.R @@ -1,8 +1,5 @@ context("check hyperlink") -library(xml2) -library(officer) - data <- data.frame( code = c("X01", "X02"), name = c("X Number 1", "X Number 2"), diff --git a/tests/testthat/test-md-captions.R b/tests/testthat/test-md-captions.R index 9e71ef3e..c646664b 100644 --- a/tests/testthat/test-md-captions.R +++ b/tests/testthat/test-md-captions.R @@ -1,21 +1,11 @@ context("check markdown captions") -skip_on_cran() -skip_if_not_installed("doconv") -library(doconv) -skip_if_not(doconv::msoffice_available()) -skip_if_not(pandoc_version() >= numeric_version("2")) -skip_if_not_installed("webshot2") - -library(rmarkdown) -library(xml2) -library(officer) - init_flextable_defaults() +skip_if_not_local_testing(check_html = TRUE) +snap_folder_test_file <- "md-captions" +defer_cleaning_snapshot_directory(snap_folder_test_file) test_that("rmarkdown caption", { - local_edition(3) - rmd_file <- tempfile(fileext = ".Rmd") file.copy("rmd/rmarkdown.Rmd", rmd_file) outfile <- tempfile(fileext = ".pdf") @@ -23,7 +13,8 @@ test_that("rmarkdown caption", { output_file = outfile, output_format = rmarkdown::pdf_document(latex_engine = "xelatex"), envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(x = outfile, name = "rmarkdown_pdf_document", engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "rmarkdown_pdf_document") + doconv::expect_snapshot_doc(x = outfile, name = "rmarkdown_pdf_document", engine = "testthat") rmd_file <- tempfile(fileext = ".Rmd") file.copy("rmd/rmarkdown.Rmd", rmd_file) @@ -34,21 +25,24 @@ test_that("rmarkdown caption", { output_file = outfile, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "rmarkdown_word_document", x = outfile, engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "rmarkdown_word_document") + doconv::expect_snapshot_doc(name = "rmarkdown_word_document", x = outfile, engine = "testthat") rmd_file <- tempfile(fileext = ".Rmd") file.copy("rmd/rmarkdown.Rmd", rmd_file) outfile <- tempfile(fileext = ".html") - render(rmd_file, output_format = "rmarkdown::html_document", output_file = outfile, envir = new.env(), quiet = TRUE) - expect_snapshot_html( + render(rmd_file, + output_format = "rmarkdown::html_document", + output_file = outfile, envir = new.env(), quiet = TRUE + ) + handle_manual_snapshots(snap_folder_test_file, "rmarkdown_html_document") + doconv::expect_snapshot_html( name = "rmarkdown_html_document", outfile, engine = "testthat", zoom = 3, expand = 10 ) }) test_that("bookdown caption", { - local_edition(3) - skip_if_not_installed("bookdown") rmd_file <- tempfile(fileext = ".Rmd") @@ -58,7 +52,8 @@ test_that("bookdown caption", { output_file = outfile, output_format = bookdown::pdf_document2(latex_engine = "xelatex"), envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(x = outfile, name = "bookdown_pdf_document2", engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "bookdown_pdf_document2") + doconv::expect_snapshot_doc(x = outfile, name = "bookdown_pdf_document2", engine = "testthat") rmd_file <- tempfile(fileext = ".Rmd") file.copy("rmd/bookdown.Rmd", rmd_file) @@ -69,21 +64,24 @@ test_that("bookdown caption", { output_file = outfile, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "bookdown_word_document2", x = outfile, engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "bookdown_word_document2") + doconv::expect_snapshot_doc(name = "bookdown_word_document2", x = outfile, engine = "testthat") rmd_file <- tempfile(fileext = ".Rmd") file.copy("rmd/bookdown.Rmd", rmd_file) outfile <- tempfile(fileext = ".html") - render(rmd_file, output_format = "bookdown::html_document2", output_file = outfile, envir = new.env(), quiet = TRUE) - expect_snapshot_html( + render(rmd_file, + output_format = "bookdown::html_document2", + output_file = outfile, envir = new.env(), quiet = TRUE + ) + handle_manual_snapshots(snap_folder_test_file, "bookdown_html_document2") + doconv::expect_snapshot_html( name = "bookdown_html_document2", outfile, engine = "testthat", zoom = 3, expand = 10 ) }) test_that("rdocx caption", { - local_edition(3) - skip_if_not_installed("bookdown") skip_if_not_installed("officedown") @@ -96,8 +94,8 @@ test_that("rdocx caption", { output_file = outfile, envir = new.env(), quiet = TRUE ) - expect_snapshot_doc(name = "officedown_word_document2", x = outfile, engine = "testthat") + handle_manual_snapshots(snap_folder_test_file, "officedown_word_document2") + doconv::expect_snapshot_doc(name = "officedown_word_document2", x = outfile, engine = "testthat") }) - init_flextable_defaults() diff --git a/tests/testthat/test-merge.R b/tests/testthat/test-merge.R index d34db67a..0cda95f0 100644 --- a/tests/testthat/test-merge.R +++ b/tests/testthat/test-merge.R @@ -1,8 +1,5 @@ context("check merge operations") -library(utils) -library(xml2) - test_that("identical values within columns are merged", { dummy_df <- data.frame(values = rep(letters[1:3], each = 2), stringsAsFactors = FALSE) ft <- flextable(dummy_df) diff --git a/tests/testthat/test-new-rows.R b/tests/testthat/test-new-rows.R index 472577c3..88215e83 100644 --- a/tests/testthat/test-new-rows.R +++ b/tests/testthat/test-new-rows.R @@ -1,8 +1,5 @@ context("check dim and new rows") -library(officer) - - test_that("nrow_part or ncol_keys checks", { expect_error(nrow_part(12)) expect_error(ncol_keys(12)) diff --git a/tests/testthat/test-padding.R b/tests/testthat/test-padding.R index dda5b79e..b7f3088b 100644 --- a/tests/testthat/test-padding.R +++ b/tests/testthat/test-padding.R @@ -1,8 +1,5 @@ context("check paddings") -library(utils) -library(xml2) - test_that("padding overwrite all paddings", { ft <- flextable(data.frame(a = c("", ""), stringsAsFactors = FALSE)) ft <- padding(ft, padding = 5) diff --git a/tests/testthat/test-pptx-tables.R b/tests/testthat/test-pptx-tables.R index a80d2db6..a08789b6 100644 --- a/tests/testthat/test-pptx-tables.R +++ b/tests/testthat/test-pptx-tables.R @@ -1,9 +1,5 @@ context("ppt table structure") -library(utils) -library(xml2) -library(officer) - test_that("row height is valid", { ft <- flextable(head(iris)) pptx_file <- "test.pptx" diff --git a/tests/testthat/test-proc-freq.R b/tests/testthat/test-proc-freq.R index c8071a55..66a1f5d6 100644 --- a/tests/testthat/test-proc-freq.R +++ b/tests/testthat/test-proc-freq.R @@ -1,8 +1,5 @@ context("check proc_freq") -library(utils) -library(xml2) - p <- structure(list( lengths = c(9894L, 104L, 1L, 1L), values = c("No", "Yes", NA, NA) diff --git a/tests/testthat/test-rotations.R b/tests/testthat/test-rotations.R index af430909..b735f394 100644 --- a/tests/testthat/test-rotations.R +++ b/tests/testthat/test-rotations.R @@ -1,9 +1,5 @@ context("check rotations") -library(officer) -library(xml2) - - dat <- data.frame( a = c("left-top", "left-middle", "left-bottom"), b = c("center-top", "center-middle", "center-bottom"), diff --git a/tests/testthat/test-styles.R b/tests/testthat/test-styles.R index 52e71c13..f25835b5 100644 --- a/tests/testthat/test-styles.R +++ b/tests/testthat/test-styles.R @@ -1,8 +1,5 @@ context("check formatting") -library(xml2) -library(officer) - test_that("shortcut functions", { ft <- flextable(head(mtcars, n = 2)) diff --git a/tests/testthat/test-text.R b/tests/testthat/test-text.R index 333dabd7..f6b9c52e 100644 --- a/tests/testthat/test-text.R +++ b/tests/testthat/test-text.R @@ -1,8 +1,5 @@ context("check cells text") -library(xml2) -library(officer) - ft1 <- flextable(data.frame(a = "1 < 3", stringsAsFactors = FALSE)) get_xml_doc <- function(tab, main_folder = "docx_folder") { diff --git a/tests/testthat/zzzzz.R b/tests/testthat/zzzzz.R deleted file mode 100644 index 2bf41ea7..00000000 --- a/tests/testthat/zzzzz.R +++ /dev/null @@ -1,65 +0,0 @@ -get_docx_xml <- function(x) { - if (inherits(x, "flextable")) { - docx_file <- tempfile(fileext = ".docx") - doc <- read_docx() - doc <- body_add_flextable(doc, value = x) - print(doc, target = docx_file) - x <- docx_file - } - redoc <- read_docx(x) - xml2::xml_child(docx_body_xml(redoc)) -} - -get_pptx_xml <- function(x) { - if (inherits(x, "flextable")) { - pptx_file <- tempfile(fileext = ".pptx") - doc <- read_pptx() - doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme") - doc <- ph_with(doc, x, location = ph_location_type(type = "body")) - print(doc, target = pptx_file) - x <- pptx_file - } - - redoc <- read_pptx(x) - slide <- redoc$slide$get_slide(redoc$cursor) - xml2::xml_child(slide$get()) -} - -get_html_xml <- function(x) { - if (inherits(x, "flextable")) { - html_file <- tempfile(fileext = ".html") - save_as_html(tab, path = html_file) - x <- html_file - } - doc <- read_html(x) - xml_child(doc, "body") -} -get_pdf_text <- function(x, extract_fun) { - stopifnot(grepl("\\.pdf$", x)) - - doc <- extract_fun(x) - txtfile <- tempfile() - cat(paste0(doc, collapse = "\n"), file = txtfile) - readLines(txtfile) -} - -render_rmd <- function(file, rmd_format) { - unlink(file, force = TRUE) - sucess <- FALSE - tryCatch( - { - render(rmd_file, - output_format = rmd_format, - output_file = pdf_file, - envir = new.env(), - quiet = TRUE - ) - sucess <- TRUE - }, - warning = function(e) { - }, - error = function(e) { - } - ) - sucess -}