Skip to content

Commit

Permalink
tests: add coverage to rtf
Browse files Browse the repository at this point in the history
  • Loading branch information
Melkiades committed Mar 12, 2024
1 parent 338ea33 commit 5889199
Show file tree
Hide file tree
Showing 6 changed files with 333 additions and 35 deletions.
7 changes: 5 additions & 2 deletions R/rtf.R
Original file line number Diff line number Diff line change
Expand Up @@ -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()]
Expand Down Expand Up @@ -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) {
Expand Down
6 changes: 4 additions & 2 deletions man/to_rtf.Rd

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

22 changes: 22 additions & 0 deletions tests/testthat/test-defunct.R
Original file line number Diff line number Diff line change
@@ -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"
)
})
103 changes: 79 additions & 24 deletions tests/testthat/test-docx-add.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down
120 changes: 113 additions & 7 deletions tests/testthat/test-rtf-add.R
Original file line number Diff line number Diff line change
@@ -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", {
Expand All @@ -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")
})
Loading

0 comments on commit 5889199

Please sign in to comment.