tests: gen_grob testing

Author: davidgohel

tests/testthat/_snaps/gen_grob/long-text-wrapping.png

@@ -1,15 +1,25 @@
 context("check grid grob")
 
-skip_on_cran()
-skip_if_not_installed("doconv")
-skip_if_not(doconv::msoffice_available())
-library(doconv)
 library(officer)
 library(gdtools)
+
 register_liberationsans()
 
 init_flextable_defaults()
-set_flextable_defaults(font.family = "Liberation Sans")
+
+set_flextable_defaults(
+  font.family = "Liberation Sans",
+  border.color = "#333333")
+
+
+test_that("png is created", {
+  ft <- as_flextable(iris)
+  file <- tempfile(fileext = ".png")
+  try(invisible(save_as_image(x = ft, path = file, res = 150)),
+      silent = TRUE)
+  expect_true(file.exists(file))
+  expect_gt(file.info(file)$size, 20000)
+})
 
 test_that("merged borders", {
   local_edition(3)
@@ -24,12 +34,36 @@ test_that("merged borders", {
     border = fp_border(color = "red")
   )
 
-  path <- save_as_image(ft, path = tempfile(fileext = ".png"), res = 150)
-  expect_snapshot_doc(name = "vmerged-borders", x = path, engine = "testthat")
+  gr <- gen_grob(ft)
+
+  expect_length(gr$children, 10)
+
+  expect_equal(gr$children[[3]]$children$borders$children[[1]]$gp$col, "red")
+
+  expect_length(gr$children[[1]]$children$borders$children, 2)
+  expect_equal(gr$children[[1]]$children$borders$children[[1]]$gp$col, "#333333")
+  expect_equal(gr$children[[1]]$children$borders$children[[1]]$x0, grid::unit(0, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[1]]$x1, grid::unit(1, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[1]]$y0, grid::unit(1, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[1]]$y1, grid::unit(1, "npc"))
+
+  expect_equal(gr$children[[1]]$children$borders$children[[2]]$gp$col, "#333333")
+  expect_equal(gr$children[[1]]$children$borders$children[[2]]$x0, grid::unit(0, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[2]]$x1, grid::unit(1, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[2]]$y0, grid::unit(0, "npc"))
+  expect_equal(gr$children[[1]]$children$borders$children[[2]]$y1, grid::unit(0, "npc"))
+
+  expect_length(gr$children[[10]]$children$borders$children, 1)
+
+  expect_equal(gr$children[[10]]$children$borders$children[[1]]$gp$col, "#333333")
+  expect_equal(gr$children[[10]]$children$borders$children[[1]]$x0, grid::unit(0, "npc"))
+  expect_equal(gr$children[[10]]$children$borders$children[[1]]$x1, grid::unit(1, "npc"))
+  expect_equal(gr$children[[10]]$children$borders$children[[1]]$y0, grid::unit(0, "npc"))
+  expect_equal(gr$children[[10]]$children$borders$children[[1]]$y1, grid::unit(0, "npc"))
+
 })
 
 test_that("text wrapping", {
-  local_edition(3)
 
   text <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat."
   source1 <- "DATA_SOURCE_A.COURSE_TITLE\nDATA_SOURCE_A.SUBJECT_DESCR\nDATA_SOURCE_A.CATALOG_NUMBER"
@@ -45,6 +79,52 @@ test_that("text wrapping", {
   ft <- flextable(temp_dat)
   ft <- merge_h(ft, part = "body")
 
-  path <- save_as_image(ft, path = tempfile(fileext = ".png"), res = 150)
-  expect_snapshot_doc(name = "long-text-wrapping", x = path, engine = "testthat")
+  gr <- gen_grob(ft, fit = "fixed")
+
+  expect_length(gr$children, 9)
+  expect_equal(gr$children[[5]]$children$contents$ftgrobs[[1]]$label, source1)
+  expect_equal(gr$children[[6]]$children$contents$ftgrobs[[1]]$label, source2)
+
+  # check wrap on 3 rows
+  expect_length(gr$children[[5]]$children$contents$children, 3)
+  expect_length(gr$children[[6]]$children$contents$children, 3)
+  expect_equal(gr$children[[8]]$children$contents$ftgrobs[[1]]$label, "Notes")
+  expect_length(gr$children[[8]]$children$contents$children, 1)
+  expect_equal(gr$children[[9]]$children$contents$ftgrobs[[1]]$label, text)
+  # check wrap on 3 rows
+  expect_length(gr$children[[9]]$children$contents$children, 3)
+
+  # check that height and width are greater than those of smaller cells
+  expect_gt(gr$children$cell_2_2$children$contents$ftpar$height,
+            gr$children$cell_1_2$children$contents$ftpar$height
+            )
+  expect_gt(gr$children$cell_2_2$children$contents$ftpar$width,
+            gr$children$cell_2_1$children$contents$ftpar$width
+            )
+})
+
+test_that("grid with raster", {
+  skip_if_not_installed("magick")
+
+  img.file <- file.path(
+    R.home("doc"),
+    "html", "logo.jpg"
+  )
+  myft <- flextable(head(iris))
+  myft <- prepend_chunks(
+    x = myft,
+    i = 1:2, j = 1,
+    as_image(src = img.file),
+    part = "body"
+  )
+  ft <- autofit(myft)
+
+  gr <- gen_grob(ft)
+
+  expect_s3_class(gr$children[[6]]$children$contents$ftgrobs[[1]], "rastergrob")
+  expect_s3_class(gr$children[[6]]$children$contents$ftgrobs[[2]], "text")
+  expect_s3_class(gr$children[[11]]$children$contents$ftgrobs[[1]], "rastergrob")
+  expect_s3_class(gr$children[[11]]$children$contents$ftgrobs[[2]], "text")
+  expect_s3_class(gr$children[[12]]$children$contents$ftgrobs[[1]], "text")
 })
+