tests: block_caption and block_toc

davidgohel · Feb 4, 2024 · dfd7fc7 · dfd7fc7
1 parent bf656e0
commit dfd7fc7
Show file tree

Hide file tree

Showing 4 changed files with 38 additions and 10 deletions.
diff --git a/R/ooxml_block_objects.R b/R/ooxml_block_objects.R
@@ -25,22 +25,28 @@
 #'
 #' print(doc_1, target = tempfile(fileext = ".docx"))
 #' @family block functions for reporting
-block_caption <- function(label, style, autonum = NULL) {
+block_caption <- function(label, style = NULL, autonum = NULL) {
+
+  if (is.null(style)) {
+    style <- "Normal"
+  }
+
   z <- list(
     label = label,
     autonum = autonum,
     style = style
   )
+
   class(z) <- c("block_caption", "block")
   z
 }
 
 #' @export
 print.block_caption <- function(x, ...) {
   if (is.null(x$autonum)) {
-    auton <- "[anto-num on]"
+    auton <- "[autonum off]"
   } else {
-    auton <- "[antonum off]"
+    auton <- "[autonum on]"
   }
   cat("caption ", auton, ": ", x$label, "\n", sep = "")
 }
@@ -52,11 +58,6 @@ to_wml_block_caption_officer <- function(x, add_ns = FALSE){
     open_tag <- wp_ns_yes
   }
 
-  if (is.null(x$style)) {
-    style <- "Normal"
-  } else {
-    style <- x$style
-  }
   autonum <- ""
   if (!is.null(x$autonum)) {
     autonum <- to_wml(x$autonum)
@@ -67,7 +68,7 @@ to_wml_block_caption_officer <- function(x, add_ns = FALSE){
 
   out <- sprintf(
     "%s<w:pPr><w:pStyle w:stlname=\"%s\"/></w:pPr>%s</w:p>",
-    open_tag, style, run_str
+    open_tag, x$style, run_str
   )
 
   out

diff --git a/man/block_caption.Rd b/man/block_caption.Rd
diff --git a/tests/testthat/test-docx-add.R b/tests/testthat/test-docx-add.R
@@ -98,6 +98,13 @@ test_that("body_add_toc", {
   child_ <- getncheck(node, "w:r/w:instrText")
   expect_equal( xml_text(child_), "TOC \\h \\z \\t \"Normal;1\"" )
 
+  expect_output(print(block_toc(level = 2)), "TOC - max level: 2")
+  expect_output(print(block_toc(level = 2, style = "Normal")), "TOC for style: Normal")
+  expect_output(print(block_toc(level = 2, seq_id = "tab")), "TOC for seq identifier: tab")
+
+  expect_match(to_wml(block_toc(seq_id = "tab")), "TOC \\\\h \\\\z \\\\c \"tab\"")
+  expect_match(to_wml(block_toc(style = "Normal")), "TOC \\\\h \\\\z \\\\t \"Normal;1\"")
+  expect_match(to_wml(block_toc(level = 2)), "TOC \\\\o \"1-2\" \\\\h \\\\z \\\\u")
 })
 
 test_that("body_add_img", {

diff --git a/tests/testthat/test-docx-table.R b/tests/testthat/test-docx-table.R
@@ -14,6 +14,26 @@ test_that("wml structure", {
   expect_length(xml_find_all(node, xpath = "w:tr[not(w:trPr/w:tblHeader)]/w:tc/w:p/w:r/w:t"), ncol(iris) * nrow(iris))
 })
 
+test_that("block_caption", {
+
+  run_num <- run_autonum(seq_id = "tab", pre_label = "tab. ",
+                         bkm = "mtcars_table")
+
+  expect_output(print(block_caption("mtcars table", style = "Normal")),
+                "caption \\[autonum off\\]: mtcars table")
+  expect_output(print(block_caption("mtcars table", style = "Normal", autonum = run_num)),
+                "caption \\[autonum on\\]: mtcars table")
+
+  caption <- block_caption("mtcars table", autonum = run_num)
+  expect_equal(caption$style, "Normal")
+
+  expect_match(to_wml(caption, knitting = TRUE), "::: \\{custom-style=\"Normal\"\\}")
+  expect_match(to_wml(caption, knitting = TRUE), "mtcars table\\n:::")
+  expect_match(to_wml(caption, knitting = FALSE), "^<w:p>")
+  expect_match(to_wml(caption, knitting = FALSE), "</w:p>$")
+  expect_match(to_wml(caption, knitting = FALSE), "mtcars table</w:t>")
+})
+
 test_that("names stay as is", {
   df <- data.frame(
     "hello coco" = c(1, 2), value = c("одно значение", "еще значение"),