skip_on_cran() skip_on_ci() # Init -------------------------------------------------------------------- compare_snapshot_doc = function(name){ doc1 = read_docx(paste0('tests/testthat/docx/4-officer/snap_',name,'.docx')) doc2 = read_docx(paste0('tests/testthat/docx/4-officer/snap_',name,'_new.docx')) x1 = doc1$doc_obj$get() %>% xml2::as_list() %>% jsonlite::serializeJSON(pretty = TRUE) x2 = doc2$doc_obj$get() %>% xml2::as_list() %>% jsonlite::serializeJSON(pretty = TRUE) waldo::compare(x1,x2) } expect_snapshot_doc = function(doc){ skip_on_os(c("mac", "linux", "solaris")) doc_xml = xml2::as_list(doc$doc_obj$get()) sp = testthat:::get_snapshotter() if(is.null(sp)) cli_abort("Can't compare snapshot to reference when testing interactively") test_file = sp$file test_name = sp$test %>% tolower() %>% str_replace_all("\\W+", "_") %>% stringi::stri_trans_general(id = "Latin-ASCII") x = expect_snapshot_value(digest::digest(doc_xml)) folder=paste0("docx/", test_file) filename=paste0(folder, "/snap_", test_name, ".docx") if(!file.exists(filename)){ dir.create(folder, recursive=TRUE, showWarnings=FALSE) print(doc, filename) } filename_new=paste0(folder, "/snap_", test_name, "_new.docx") if(!inherits(x, "expectation_success")){ print(doc, filename_new) #TODO cli cli_warn(glue("Word document snapshot has changed. Explore changes by running:\n", " compare_snapshot_doc('{test_name}')\n", " browseURL('tests/testthat/{filename}')\n", " browseURL('tests/testthat/{filename_new}')\n\n")) } else { if(file.exists(filename_new)) file.remove(filename_new) print(doc, filename) } } # crosstables don't throw errors in officer ------------------------------- crosstables = suppressWarnings({ set.seed(12345) list( Simple = crosstable(esoph, test=TRUE), Double_effect = crosstable(mtcars, c(mpg, cyl, disp), by=am, effect=TRUE), Triple = crosstable(iris, by=Species, showNA="always", total="both") ) }) test_that("crosstables: Simple", { # skip_on_os(c("mac", "linux", "solaris")) i="Simple" ct = crosstables[[i]] expect_s3_class(ct, c("crosstable")) doc = read_docx() %>% body_add_title(i, 1) %>% body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.", x=ncol(ct)) %>% body_add_title("Not compacted", 2) %>% body_add_crosstable(ct, show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", not compacted")) %>% body_add_break() %>% body_add_title("Compacted in function", 2) %>% body_add_crosstable(ct, compact=TRUE) %>% body_add_table_legend(paste0(i, ", compacted inside function")) %>% body_add_break() %>% body_add_normal("Look, there are labels!") %>% body_add_title("Compacted before function", 2) %>% body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", compacted before function")) %>% body_add_break() # expect_snapshot_doc(doc) expect_true(TRUE) }) test_that("crosstables: Double with effects", { # skip_on_os(c("mac", "linux", "solaris")) i="Double_effect" ct = crosstables[[i]] expect_s3_class(ct, c("crosstable")) doc = read_docx() %>% body_add_title(i, 1) %>% body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.", x=ncol(ct)) %>% body_add_title("Not compacted", 2) %>% body_add_crosstable(ct, show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", not compacted")) %>% body_add_break() %>% body_add_title("Compacted in function", 2) %>% body_add_crosstable(ct, compact=TRUE) %>% body_add_table_legend(paste0(i, ", compacted inside function")) %>% body_add_break() %>% body_add_normal("Look, there are labels!") %>% body_add_title("Compacted before function", 2) %>% body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", compacted before function")) %>% body_add_break() # expect_snapshot_doc(doc) expect_true(TRUE) }) test_that("crosstables: Triple", { # skip_on_os(c("mac", "linux", "solaris")) i="Triple" ct = crosstables[[i]] expect_s3_class(ct, c("crosstable")) doc = read_docx() %>% body_add_title(i, 1) %>% body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.", x=ncol(ct)) %>% body_add_title("Not compacted", 2) %>% body_add_crosstable(ct, show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", not compacted")) %>% body_add_break() %>% body_add_title("Compacted in function", 2) %>% body_add_crosstable(ct, compact=TRUE) %>% body_add_table_legend(paste0(i, ", compacted inside function")) %>% body_add_break() %>% body_add_normal("Look, there are labels!") %>% body_add_title("Compacted before function", 2) %>% body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>% body_add_table_legend(paste0(i, ", compacted before function")) %>% body_add_break() # expect_snapshot_doc(doc) expect_true(TRUE) }) # Markdown ------------------------------------------------------------------------------------ test_that("Markdown", { x= read_docx() %>% body_add_normal("This is **bold and *italic* (see Table @ref(my_bkm)). **
This is **bold `console \\*CODE\\*` and *bold _and_ italic* **") %>% body_add_normal("This is red **bold** text, this is ~subscript *italic*~, and this is ^superscript with yellow^") %>% body_add_normal("This is a fancy font and this `is code`!!") %>% #you might need to change "Alibi" to "alibi" here body_add_normal("This is *b*") %>% body_add_normal("This is not formatted at all") %>% body_add_normal("This will eventually throw a warning: *italic text without closing") %>% body_add_normal() %>% body_add_table_legend("Some table legend", bookmark="my_bkm") %>% write_and_open() # write_and_open(x) expect_true(TRUE) }) # Helpers ----------------------------------------------------------------- test_that("Tests body_add_table_list", { ctl = list(iris2=crosstable(iris2, 1), "Just a flextable"=flextable::flextable(mtcars2[1:5,1:5]), "Just a dataframe"=iris2[1:5,1:5]) fun1 = function(doc, .name){ doc %>% body_add_title(" This is table '{.name}' as a flex/crosstable", level=2) %>% body_add_normal("Here is the table:") } fun2 = function(doc, .name){ doc %>% body_add_table_legend("{.name}", bookmark=.name) } read_docx() %>% body_add_title("Separated by subtitle", 1) %>% body_add_table_list(ctl, fun_before="title2") %>% body_add_break() %>% body_add_title("Separated using a custom function", 1) %>% body_add_normal("You can therefore use bookmarks, for instance here are tables \\@ref(iris2), \\@ref(just_a_flextable) and \\@ref(just_a_dataframe).") %>% body_add_table_list(ctl, fun_before=fun1, fun_after=fun2, body_fontsize=8) %>% write_and_open() expect_true(TRUE) }) test_that("Crosstables helpers", { skip_on_os(c("mac", "linux", "solaris")) skip_on_cran() # skip("Run `test-officer > crosstables helpers` manually one in a while!") rlang::local_options(crosstable_style_list_ordered="toc 1", crosstable_style_list_unordered="toc 2", crosstable_style_image="centered", crosstable_units="cm") img.file = file.path( R.home("doc"), "html", "logo.jpg" ) p = ggplot2::ggplot(data = iris ) + ggplot2::geom_point(mapping = ggplot2::aes(Sepal.Length, Petal.Length)) doc = read_docx() %>% body_add_normal("Iris has {nrow(iris)} rows and {x} columns.", x=ncol(iris)) %>% body_add_normal("I can write multiple {x}. ", "Just like {y}.", x="paragraphs", y="this") %>% body_add_normal("You can format in **bold**, *italic*, _underlined_, and `code`, and reference the figure \\@ref(fig1).") %>% body_add_normal("You can ignore refs: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("format", "code")) %>% body_add_normal("You can ignore formats: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("ref", "code")) %>% body_add_normal("You can ignore code: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("ref", "format")) %>% body_add_normal("You can ignore all: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=NULL) %>% body_add_list(c("Numbered item 1", "Numbered item 2"), ordered = TRUE) %>% body_add_list_item("Numbered item 3", ordered = TRUE) %>% body_add_list(c("Bullet item 1", "Bullet item 2"), ordered = FALSE) %>% body_add_list_item("Bullet item 3", ordered = FALSE) %>% body_add_img2(img.file, h=3, w=5, style="Normal") %>% body_add_img2(img.file, h=7, w=10, units="mm") %>% body_add_figure_legend("legend", bookmark="fig1") %>% body_add_gg2(p, w=14, h=10, scale=1.5, style="Normal") %>% body_add_gg2(p, w=14, h=10, scale=1.5, units="mm") %>% body_add_crosstable_footnote() %>% body_add_break() write_and_open(doc) # expect_snapshot_doc(doc) expect_true(TRUE) }) test_that("Utils functions", { skip_on_os(c("mac", "linux", "solaris")) rlang::local_options(crosstable_units="cm") info_rows = c("Also, table iris has {nrow(iris)} rows.", "And table mtcars has {nrow(mtcars)} rows.") img.file = file.path( R.home("doc"), "html", "logo.jpg" ) p = ggplot2::ggplot(data = iris ) + ggplot2::geom_point(mapping = ggplot2::aes(Sepal.Length, Petal.Length)) doc = read_docx() %>% body_add_title("Tests", 1) %>% body_add_normal("Table iris has", ncol(iris), "columns.", .sep=" ") %>% body_add_normal("However, table mtcars has {ncol(mtcars)} columns") %>% body_add_normal(info_rows) %>% body_add_crosstable(crosstables[[2]], show_test_name=FALSE, body_fontsize = 8, header_fontsize = 10) %>% body_add_break() %>% body_add_img2(img.file, h=7.6, w=10, style="centered") %>% body_add_img2(img.file, h=7.6/2.5, w=10/2.5, units="in") %>% body_add_gg2(p, w=14, h=10, scale=1.5) %>% body_add_gg2(p, w=14/2.5, h=10/2.5, scale=1.5, units="in") %>% identity() # expect_snapshot_doc(doc) expect_true(TRUE) }) test_that("Legend fields", { # skip_on_os(c("mac", "linux", "solaris")) #cannot use snapshot as fields are identified with uuid fp = fp_text_lite(bold=FALSE, italic=FALSE, underlined=TRUE, font.size=15) fp2 = fp_text_lite(font.size=9) doc = read_docx() %>% body_add_normal("As you can see in Table \\@ref(tab1) and in Figure @ref(fig1), ", "the iris dataset is about flowers.") %>% body_add_table_legend("standard format (table)", bookmark="tab1") %>% body_add_figure_legend("standard format (figure)", bookmark="fig1") %>% body_add_table_legend("underlined, size 15", name_format=fp, bookmark="tab2") %>% body_add_table_legend("size 9", name_format=fp2, legend_style="Normal", bookmark="tab3") %>% identity() write_and_open(doc) expect_true(TRUE) }) # Warnings and errors ----------------------------------------------------- test_that("Officers warnings and errors", { # skip_on_os(c("mac", "linux", "solaris")) pars1 = c("Paragraphe 1.1", "Paragraphe 1.2") pars2 = c("Paragraphe 2.1", "Paragraphe 2.2") expect_error(body_add_normal(read_docx(), pars1, pars2), class="crosstable_officer_wrong_vector_error") expect_snapshot_error(body_add_table_legend(read_docx(), "xxx", foo=1, fun=mean, 5)) #rlib_error_dots_nonempty lifecycle::expect_deprecated(body_add_glued(read_docx(), "Paragraphe")) ct = crosstable(mtcars3, vs, by=model) expect_error(body_add_crosstable(read_docx(), ct), class="crosstable_body_add_large_error") ll = list("a"=crosstable(iris), crosstable(mtcars)) expect_error(body_add_table_list(read_docx(), ll), class="body_add_table_list_named") ll = list("a"=crosstable(iris), "b"=5, "c"=lm(am~vs, data=mtcars)) expect_error(body_add_table_list(read_docx(), ll), class="body_add_table_list_class") ll = list(iris=crosstable(iris), mtcars=crosstable(mtcars)) expect_error(body_add_table_list(read_docx(), ll, fun_before="foobar"), class="body_add_table_list_fun_name") expect_error(body_add_table_list(read_docx(), ll, fun_before=function(x, y) x), class="body_add_table_list_fun_args") expect_error(body_add_table_list(read_docx(), ll, fun_before=function(doc, .name) .name), class="body_add_table_list_return") expect_error(body_add_table_list(read_docx(), ll, fun_after=function(doc, .name) .name), class="body_add_table_list_return2") }) # Other reporting functions ----------------------------------------------- ## openxlsx workbooks ------------------------------------------------------ test_that("openxlsx is working", { set.seed(1234) #by=NULL x1=crosstable(mtcars2, c(mpg, vs, gear), total=T, test=T) wb1=as_workbook(x1, keep_id=FALSE) wb2=as_workbook(x1, keep_id=TRUE) expect_true(TRUE) #by=cyl x2=crosstable(mtcars2, c(mpg, vs, gear), by=cyl, total=T, test=T) wb3=as_workbook(x2, keep_id=FALSE) wb4=as_workbook(x2, keep_id=TRUE) #by=c(cyl, am) x3=crosstable(mtcars2, c(mpg, vs, gear), by=c(cyl, am), total=T) wb5=as_workbook(x3, keep_id=FALSE) xl=list("with by"=x2, noby=x1, x3) wb6=as_workbook(xl) if(!is_testing()){ openxlsx::saveWorkbook(wb1, file = "tests/testthat/xlsx/test_openxlsx1.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb2, file = "tests/testthat/xlsx/test_openxlsx2.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb3, file = "tests/testthat/xlsx/test_openxlsx3.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb4, file = "tests/testthat/xlsx/test_openxlsx4.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb5, file = "tests/testthat/xlsx/test_openxlsx5.xlsx", overwrite = TRUE) openxlsx::saveWorkbook(wb6, file = "tests/testthat/xlsx/test_openxlsx6.xlsx", overwrite = TRUE) } }) ## gt ---------------------------------------------------------------------- test_that("gt is working", { rlang::local_options(tidyselect_verbosity = "verbose") #oddly needed for as_gt(x2) #by=NULL x1=crosstable(mtcars2, c(mpg, vs, gear), total=T, test=T) as_gt(x1) as_gt(x1, keep_id=TRUE) expect_true(TRUE) #by=cyl x2=crosstable(mtcars2, c(mpg, vs, gear), by=cyl, total=T, test=T) as_gt(x2) as_gt(x2, keep_id=TRUE, show_test_name=FALSE, by_header="Cylinders") #by=c(cyl, am) --> error pour l'instant x3=crosstable(mtcars2, c(mpg, vs, gear), by=c(cyl, am), total=T) expect_snapshot_error(as_gt(x3)) })