From 58891995909d49819bad05c4f51c835d59788817 Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Tue, 12 Mar 2024 11:21:02 +0100 Subject: [PATCH] tests: add coverage to rtf --- R/rtf.R | 7 +- man/to_rtf.Rd | 6 +- tests/testthat/test-defunct.R | 22 ++++++ tests/testthat/test-docx-add.R | 103 +++++++++++++++++++++------- tests/testthat/test-rtf-add.R | 120 +++++++++++++++++++++++++++++++-- tests/testthat/test-to_rtf.R | 110 ++++++++++++++++++++++++++++++ 6 files changed, 333 insertions(+), 35 deletions(-) create mode 100644 tests/testthat/test-defunct.R create mode 100644 tests/testthat/test-to_rtf.R diff --git a/R/rtf.R b/R/rtf.R index 32849f1e..fe0901fb 100644 --- a/R/rtf.R +++ b/R/rtf.R @@ -7,10 +7,12 @@ #' objects are: #' - [ftext()] #' - [external_img()] -#' - [run_word_field()] -#' - [run_pagebreak()] +#' - [run_autonum()] #' - [run_columnbreak()] #' - [run_linebreak()] +#' - [run_word_field()] +#' - [run_reference()] +#' - [run_pagebreak()] #' - [hyperlink_ftext()] #' - [block_list()] #' - [fpar()] @@ -958,6 +960,7 @@ rtf_par_style <- function(fp_p = fp_par(), fp_t = NULL) { paste0(ppr_rtf(fp_p), fp_t_rtf) } +# Not used in {officer} rtf_set_paragraph_style <- function(x, style_name, fp_p = fp_par(), fp_t = NULL) { index <- which(x$styles$style_name %in% style_name) style_id <- if (length(index) < 1) { diff --git a/man/to_rtf.Rd b/man/to_rtf.Rd index 947a362b..72907168 100644 --- a/man/to_rtf.Rd +++ b/man/to_rtf.Rd @@ -12,10 +12,12 @@ objects are: \itemize{ \item \code{\link[=ftext]{ftext()}} \item \code{\link[=external_img]{external_img()}} -\item \code{\link[=run_word_field]{run_word_field()}} -\item \code{\link[=run_pagebreak]{run_pagebreak()}} +\item \code{\link[=run_autonum]{run_autonum()}} \item \code{\link[=run_columnbreak]{run_columnbreak()}} \item \code{\link[=run_linebreak]{run_linebreak()}} +\item \code{\link[=run_word_field]{run_word_field()}} +\item \code{\link[=run_reference]{run_reference()}} +\item \code{\link[=run_pagebreak]{run_pagebreak()}} \item \code{\link[=hyperlink_ftext]{hyperlink_ftext()}} \item \code{\link[=block_list]{block_list()}} \item \code{\link[=fpar]{fpar()}} diff --git a/tests/testthat/test-defunct.R b/tests/testthat/test-defunct.R new file mode 100644 index 00000000..129e0f2e --- /dev/null +++ b/tests/testthat/test-defunct.R @@ -0,0 +1,22 @@ +test_that("Defunct functions gives the right messages", { + expect_error( + slip_in_seqfield(), + "run_word_field" + ) + expect_error( + slip_in_column_break(), + "run_columnbreak" + ) + expect_error( + slip_in_xml(), + "fpar" + ) + expect_error( + slip_in_text(), + "fpar" + ) + expect_error( + slip_in_footnote(), + "run_footnote" + ) +}) diff --git a/tests/testthat/test-docx-add.R b/tests/testthat/test-docx-add.R index 6a96f999..5aa628a5 100644 --- a/tests/testthat/test-docx-add.R +++ b/tests/testthat/test-docx-add.R @@ -198,48 +198,103 @@ test_that("add docx into docx", { expect_equal(doc_parts[grepl("\\.docx$", doc_parts)], list.files(file.path(new_dir, "word"), pattern = "\\.docx$") ) }) - - -unlink("*.docx") - -img.file <- file.path( R.home("doc"), "html", "logo.jpg" ) +img.file <- file.path(R.home("doc"), "html", "logo.jpg") fpt_blue_bold <- fp_text(color = "#006699", bold = TRUE) fpt_red_italic <- fp_text(color = "#C32900", italic = TRUE) bl <- block_list( fpar(ftext("hello world", fpt_blue_bold)), - fpar(ftext("hello", fpt_blue_bold), " ", - ftext("world", fpt_red_italic)), + fpar( + ftext("hello", fpt_blue_bold), " ", + ftext("world", fpt_red_italic) + ), fpar( ftext("hello world", fpt_red_italic), external_img( - src = img.file, height = 1.06, width = 1.39))) + src = img.file, height = 1.06, width = 1.39 + ) + ) +) anyplot <- plot_instr(code = { - col <- c("#440154FF", "#443A83FF", "#31688EFF", - "#21908CFF", "#35B779FF", "#8FD744FF", "#FDE725FF") - barplot(1:7, col = col, yaxt="n") + col <- c( + "#440154FF", "#443A83FF", "#31688EFF", + "#21908CFF", "#35B779FF", "#8FD744FF", "#FDE725FF" + ) + barplot(1:7, col = col, yaxt = "n") }) +bl <- block_list( + fpar(ftext("hello world\\t", fpt_blue_bold)), + fpar( + ftext("hello", fpt_blue_bold), " ", + ftext("world", fpt_red_italic) + ), + fpar( + ftext("hello world", fpt_red_italic) + ) +) + +ps <- prop_section( + page_size = page_size(orient = "landscape"), + page_margins = page_mar(top = 2), + type = "continuous" +) +bs <- block_section(ps) + +run_num <- run_autonum( + seq_id = "tab", pre_label = "tab. ", + bkm = "mtcars_table" +) +caption <- block_caption("mtcars table", + style = "Normal", + autonum = run_num +) +fp_t <- fp_text(font.size = 12, bold = TRUE) +an_fpar <- fpar("let's add a break page", run_pagebreak(), ftext("and blah blah!", fp_t)) + test_that("visual testing", { + doc <- read_docx() + # add text and a table ---- + doc <- body_add_par(doc, "Hello World") + doc <- body_add_par(doc, "Hello title", style = "heading 1") + doc <- body_add_par(doc, "Hello title", style = "heading 2") + doc <- body_add_table(doc, head(cars)) + doc <- body_add_par(doc, "Hello base plot", style = "heading 2") + doc <- body_add_plot(doc, anyplot) + doc <- body_add_par(doc, "Hello fpars", style = "heading 2") + doc <- body_add_blocks(doc, blocks = bl) + doc <- body_add(doc, "some char") + doc <- body_add(doc, 1.1) + doc <- body_add(doc, factor("a factor")) + doc <- body_add(doc, fpar(ftext("hello", shortcuts$fp_bold()))) + doc <- body_add(doc, external_img(src = img.file, height = 1.06 / 2, width = 1.39 / 2)) + doc <- body_add(doc, data.frame(mtcars)) + doc <- body_add(doc, bl) + doc <- body_add(doc, bs) + doc <- body_add(doc, caption) + doc <- body_add(doc, block_toc(style = "Table Caption")) + doc <- body_add(doc, an_fpar) + doc <- body_add(doc, run_columnbreak()) + if (require("ggplot2")) { + gg <- gg_plot <- ggplot(data = iris) + + geom_point(mapping = aes(Sepal.Length, Petal.Length)) + doc <- body_add(doc, gg, + width = 3, height = 4 + ) + } + doc <- body_add(doc, anyplot) + + expect_silent(print(doc, target = "external_file.docx")) + local_edition(3) testthat::skip_if_not_installed("doconv") testthat::skip_if_not(doconv::msoffice_available()) library(doconv) - - x <- read_docx() - # add text and a table ---- - x <- body_add_par(x, "Hello World") - x <- body_add_par(x, "Hello title", style = "heading 1") - x <- body_add_par(x, "Hello title", style = "heading 2") - x <- body_add_table(x, head(cars)) - x <- body_add_par(x, "Hello base plot", style = "heading 2") - x <- body_add_plot(x, anyplot) - x <- body_add_par(x, "Hello fpars", style = "heading 2") - x <- body_add_blocks(x = x, blocks = bl) - - expect_snapshot_doc(x = x, name = "docx-elements", engine = "testthat") + expect_snapshot_doc(doc, name = "docx-elements", engine = "testthat") }) +unlink("*.docx") + # test_that("body_add visual testing", { # local_edition(3) # testthat::skip_if_not_installed("doconv") diff --git a/tests/testthat/test-rtf-add.R b/tests/testthat/test-rtf-add.R index 2fc1d4fd..63af0039 100644 --- a/tests/testthat/test-rtf-add.R +++ b/tests/testthat/test-rtf-add.R @@ -1,19 +1,26 @@ -img.file <- file.path( R.home("doc"), "html", "logo.jpg" ) +img.file <- file.path(R.home("doc"), "html", "logo.jpg") fpt_blue_bold <- fp_text(color = "#006699", bold = TRUE) fpt_red_italic <- fp_text(color = "#C32900", italic = TRUE) bl <- block_list( fpar(ftext("hello world", fpt_blue_bold)), - fpar(ftext("hello", fpt_blue_bold), " ", - ftext("world", fpt_red_italic)), + fpar( + ftext("hello", fpt_blue_bold), " ", + ftext("world", fpt_red_italic) + ), fpar( ftext("hello world", fpt_red_italic), external_img( - src = img.file, height = 1.06, width = 1.39))) + src = img.file, height = 1.06, width = 1.39 + ) + ) +) anyplot <- plot_instr(code = { - col <- c("#440154FF", "#443A83FF", "#31688EFF", - "#21908CFF", "#35B779FF", "#8FD744FF", "#FDE725FF") - barplot(1:7, col = col, yaxt="n") + col <- c( + "#440154FF", "#443A83FF", "#31688EFF", + "#21908CFF", "#35B779FF", "#8FD744FF", "#FDE725FF" + ) + barplot(1:7, col = col, yaxt = "n") }) test_that("visual testing", { @@ -30,3 +37,102 @@ test_that("visual testing", { expect_snapshot_doc(x = x, name = "rtf-elements", engine = "testthat") }) +test_that("rtf_add works with text, paragraphs, and plots (ggplot2 too)", { + def_text <- fp_text_lite(color = "#006943", bold = TRUE) + center_par <- fp_par(text.align = "left", padding = 1, line_spacing = 1.3) + + np <- fp_par(line_spacing = 1.4, padding = 3, ) + fpt_def <- fp_text(font.size = 11, italic = TRUE, bold = TRUE, underline = TRUE) + + doc <- rtf_doc(normal_par = np, normal_chunk = fpt_def) + + expect_identical(doc$normal_par, np) + expect_identical(doc$normal_chunk, fpt_def) + expect_identical(doc$content, list()) + + doc <- rtf_add( + x = doc, + value = fpar( + ftext("how are you?", prop = def_text), + fp_p = fp_par(text.align = "center") + ) + ) + + expect_identical(doc$content[[1]]$chunks[[1]], ftext("how are you?", prop = def_text)) + expect_identical(doc$content[[1]]$fp_p, fp_par(text.align = "center")) + + a_paragraph <- fpar( + ftext("Here is a date: ", prop = def_text), + run_word_field(field = "Date \\@ \"MMMM d yyyy\""), + fp_p = center_par + ) + doc <- rtf_add( + x = doc, + value = block_list( + a_paragraph, + a_paragraph, + a_paragraph + ) + ) + + expect_identical(doc$content[[4]]$chunks, a_paragraph$chunks) + + if (require("ggplot2")) { + gg <- gg_plot <- ggplot(data = iris) + + geom_point(mapping = aes(Sepal.Length, Petal.Length)) + doc <- rtf_add(doc, gg, + width = 3, height = 4, + ppr = center_par + ) + + expect_true(grepl("\\.png", doc$content[[5]]$chunks[[1]])) + expect_identical(attr(doc$content[[5]]$chunks[[1]], "dims"), list(width = 3, height = 4)) + } + anyplot <- plot_instr(code = { + barplot(1:5, col = 2:6) + }) + + doc <- rtf_add(doc, anyplot, + width = 5, height = 4, + ppr = center_par + ) + expect_true(grepl("\\.png", doc$content[[6]]$chunks[[1]])) + expect_identical(attr(doc$content[[6]]$chunks[[1]], "dims"), list(width = 5, height = 4)) + + expect_s3_class(doc, "rtf") + + expect_identical(capture.output(print.rtf(doc)), "rtf document with 6 element(s)") + + bl <- block_list( + fpar(ftext("hello world\\t", fpt_blue_bold)), + fpar( + ftext("hello", fpt_blue_bold), " ", + ftext("world", fpt_red_italic) + ), + fpar( + ftext("hello world", fpt_red_italic) + ) + ) + + expect_silent(doc <- rtf_add(doc, bl)) + + ps <- prop_section( + page_size = page_size(orient = "landscape"), + page_margins = page_mar(top = 2), + type = "continuous" + ) + bs <- block_section(ps) + + expect_silent(doc <- rtf_add(doc, bs)) + expect_silent(doc <- rtf_add(doc, "a character")) + expect_silent(doc <- rtf_add(doc, factor("a factor"))) + expect_silent(doc <- rtf_add(doc, 1.1)) + + outfile <- print(doc, target = tempfile(fileext = ".rtf")) + expect_true(file.exists(outfile)) + + local_edition(3) + testthat::skip_if_not_installed("doconv") + testthat::skip_if_not(doconv::msoffice_available()) + doconv::expect_snapshot_doc(x = doc, name = "rtf-elements", engine = "testthat") +}) diff --git a/tests/testthat/test-to_rtf.R b/tests/testthat/test-to_rtf.R new file mode 100644 index 00000000..8a1c41b6 --- /dev/null +++ b/tests/testthat/test-to_rtf.R @@ -0,0 +1,110 @@ +test_that("to_rtf works with default strings and ftext", { + expect_equal(to_rtf(NULL), "") + + str <- "Default string" + expect_equal(to_rtf(str), str) + + properties2 <- fp_text(bold = TRUE, shading.color = "yellow") + ft <- ftext("Some text", properties2) + expect_equal(to_rtf(ft), "%font:Arial%\\b\\fs20%ftcolor:black% %ftshading:yellow%Some text\\highlight0") +}) + +test_that("to_rtf works with fpar and external images", { + img.file <- file.path(R.home("doc"), "html", "logo.jpg") + + bold_face <- shortcuts$fp_bold(font.size = 12) + bold_redface <- update(bold_face, color = "red") + fpar_1 <- fpar( + "Hello World, ", + ftext("how ", prop = bold_redface), + external_img(src = img.file, height = 1.06 / 2, width = 1.39 / 2), + ftext(" you?", prop = bold_face) + ) + expect_true(grepl("Hello World, ", to_rtf(fpar_1))) +}) + +test_that("to_rtf works with run_word_field, run_pagebreak, run_columnbreak, and run_linebreak", { + out <- to_rtf(run_word_field(field = "PAGE \\* MERGEFORMAT")) + + expect_true(grepl("PAGE", out)) + + fp_t <- fp_text(font.size = 12, bold = TRUE) + an_fpar <- fpar("let's add a break page", run_pagebreak(), ftext("and blah blah!", fp_t)) + + expect_true(grepl(" let's add a break page", to_rtf(an_fpar))) + expect_true(grepl("and blah blah", to_rtf(an_fpar))) + + expect_true(grepl("column", to_rtf(run_columnbreak()))) + + fp_t <- fp_text(font.size = 12, bold = TRUE) + an_fpar <- fpar("let's add a line break", run_linebreak(), ftext("and blah blah!", fp_t)) + + expect_true(grepl(" let's add a line break", to_rtf(an_fpar))) + expect_true(grepl("and blah blah", to_rtf(an_fpar))) +}) + +test_that("to_rtf works with hyperlinks and block_list", { + ft <- fp_text(font.size = 12, bold = TRUE) + ft <- hyperlink_ftext( + href = "https://cran.r-project.org/index.html", + text = "some text", prop = ft + ) + + expect_true(grepl("HYPERLINK", to_rtf(ft))) + + fpt_blue_bold <- fp_text(color = "#006699", bold = TRUE) + fpt_red_italic <- fp_text(color = "#C32900", italic = TRUE) + + + value <- block_list( + fpar(ftext("hello world\\t", fpt_blue_bold)), + fpar( + ftext("hello", fpt_blue_bold), " ", + ftext("world", fpt_red_italic) + ), + fpar( + ftext("hello world", fpt_red_italic) + ) + ) + + expect_true(grepl("C32900", to_rtf(value))) + expect_true(grepl("006699", to_rtf(value))) + expect_true(grepl("hello world", to_rtf(value))) +}) + +test_that("to_rtf works for run_autonum", { + ra <- run_autonum( + seq_id = "tab", pre_label = "Table ", bkm = "anytable", + tnd = 2, tns = " " + ) + + expect_true(grepl("bkmkstart anytable", to_rtf(ra))) + expect_true(grepl("SEQ tab", to_rtf(ra))) + + rr <- run_reference("a_ref") + + expect_true(grepl("REF a_ref ", to_rtf(rr))) + + ps <- prop_section( + page_size = page_size(orient = "landscape"), + page_margins = page_mar(top = 2), + type = "continuous" + ) + bs <- block_section(ps) + + expect_true(grepl("lndscpsxn", to_rtf(bs))) + expect_true(grepl("pghsxn11906", to_rtf(bs))) + expect_true(grepl("margt2880", to_rtf(bs))) # top = 2 + + expect_true(grepl("margl1440", to_rtf(page_mar()))) + expect_true(grepl("colw3600", to_rtf(section_columns()))) + expect_true(grepl("pgwsxn16838", to_rtf(page_size(orient = "landscape")))) + expect_true(grepl("lndscpsxn", to_rtf(page_size(orient = "landscape")))) +}) + +test_that("tcpr_rtf is retrieved by format", { + obj <- fp_cell(margin = 1) + fp_c <- update(obj, margin.bottom = 5) + + expect_true(grepl("clvertalc", format(fp_c, "rtf"))) +})