tests/testthat/test-fp_cell.R

In officer: Manipulation of Microsoft Word and PowerPoint Documents

source("utils.R")

test_that("fp_cell", {
  expect_error( fp_cell(text.direction = "sdqsd"), "must be one of" )
  expect_error( fp_cell(margin = -2), "must be a positive integer scalar" )
  expect_error( fp_cell(border = fp_text()), "border must be a fp_border object" )
  expect_error( fp_cell(border.bottom = fp_text()), "border.bottom must be a fp_border object" )
  expect_error( fp_cell(background.color = "#340F2A78d"), " must be a valid color" )
  x <- fp_cell()
  x <- update(x, margin = 3, background.color = "#340F2A78",
              border = fp_border(color = "red"))
  expect_equal(x$background.color, "#340F2A78")
  expect_equal(x$margin.bottom, 3)
  expect_equal(x$margin.left, 3)
  expect_equal(x$border.bottom, fp_border(color = "red"))
})



test_that("print fp_cell", {
  x <- fp_cell()
  expect_output(print(x))
})



pml_cell_node <- function(x){
  xml_ <- pml_str(format(x, type = "pml"))
  doc <- read_xml( xml_ )
  xml_find_first(doc, "//a:tcPr")
}



test_that("pml fp_border", {

  node <- pml_cell_node(fp_cell(background.color = "#00FF0099"))

  col <- xml_attr(xml_child(node, "a:solidFill/a:srgbClr"), "val")
  expect_equal(col, "00FF00")

  alpha <- xml_attr(xml_child(node, "a:solidFill/a:srgbClr/a:alpha"), "val")
  expect_equal(alpha, "60000")

  border_nodes <- xml_find_all(node, "//*[self::a:lnL or self::a:lnR or self::a:lnT or self::a:lnB]")
  expect_length(border_nodes, 4)

  expect_equal(xml_attr(node, "marB"), "0")
  expect_equal(xml_attr(node, "marT"), "0")
  expect_equal(xml_attr(node, "marR"), "0")
  expect_equal(xml_attr(node, "marL"), "0")

  node <- pml_cell_node(fp_cell(margin = 2, margin.bottom = 4))
  expect_equal(as.integer(xml_attr(node, "marB")), 12700 * 4)
  expect_equal(as.integer(xml_attr(node, "marT")), 12700 * 2)
  expect_equal(as.integer(xml_attr(node, "marR")), 12700 * 2)
  expect_equal(as.integer(xml_attr(node, "marL")), 12700 * 2)

  node <- pml_cell_node(fp_cell(vertical.align = "top"))
  expect_equal(xml_attr(node, "anchor"), "t")
  node <- pml_cell_node(fp_cell(vertical.align = "center"))
  expect_equal(xml_attr(node, "anchor"), "ctr")
  node <- pml_cell_node(fp_cell(vertical.align = "bottom"))
  expect_equal(xml_attr(node, "anchor"), "b")

  x <- fp_cell(text.direction = "btlr")
  node <- pml_cell_node(x)
  expect_equal(xml_attr(node, "vert"), "vert270")
  x <- fp_cell(text.direction = "tbrl")
  node <- pml_cell_node(x)
  expect_equal(xml_attr(node, "vert"), "vert")
})




wml_cell_node <- function(x){
  xml_ <- wml_str(format(x, type = "wml"))
  doc <- read_xml( xml_ )
  xml_find_first(doc, "//w:tcPr")
}

test_that("wml fp_border", {

  node <- wml_cell_node(fp_cell(background.color = "#00FF0099", margin = 2))

  col <- xml_attr(xml_child(node, "w:shd"), "fill")
  expect_equal(col, "00FF00")

  margins <- xml_children(xml_child(node, "w:tcMar"))
  margins <- sapply(margins, function(x) xml_attr(x, "w"))
  margins <- as.integer(margins)
  expect_equal( margins, rep(40, 4) )

  node <- wml_cell_node(fp_cell(margin = 2, margin.bottom = 0))
  margins <- xml_children(xml_child(node, "w:tcMar"))
  margins <- sapply(margins, function(x) xml_attr(x, "w"))
  margins <- as.integer(margins)
  expect_equal( margins, c(40, 0, 40, 40) )

  node <- wml_cell_node(fp_cell(border = fp_border()))
  border_nodes <- xml_find_all(node, "w:tcBorders/*[self::w:bottom or self::w:top or self::w:left or self::w:right]")
  expect_length(border_nodes, 4)

  node <- wml_cell_node(fp_cell(vertical.align = "top"))
  valign <- xml_attr(xml_child(node, "w:vAlign"), "val")
  expect_equal(valign, "top")
  node <- wml_cell_node(fp_cell(vertical.align = "center"))
  valign <- xml_attr(xml_child(node, "w:vAlign"), "val")
  expect_equal(valign, "center")
  node <- wml_cell_node(fp_cell(vertical.align = "bottom"))
  valign <- xml_attr(xml_child(node, "w:vAlign"), "val")
  expect_equal(valign, "bottom")

  x <- fp_cell(text.direction = "btlr")
  node <- wml_cell_node(x)
  td <- xml_attr(xml_child(node, "w:textDirection"), "val")
  expect_equal(td, "btLr")
  x <- fp_cell(text.direction = "tbrl")
  node <- wml_cell_node(x)
  td <- xml_attr(xml_child(node, "w:textDirection"), "val")
  expect_equal(td, "tbRl")
})


test_that("css fp_border", {

  x <- fp_cell(background.color = "#00FF0099", margin = 2)
  expect_true(has_css_color(x, "background-color", "rgba\\(0,255,0,0.60\\)"))

  expect_true(has_css_attr(x, "margin-top", "2pt"))
  expect_true(has_css_attr(x, "margin-bottom", "2pt"))
  expect_true(has_css_attr(x, "margin-left", "2pt"))
  expect_true(has_css_attr(x, "margin-right", "2pt"))

  x <- fp_cell(margin = 2, margin.bottom = 0)
  expect_true(has_css_attr(x, "margin-top", "2pt"))
  expect_true(has_css_attr(x, "margin-bottom", "0pt"))
  expect_true(has_css_attr(x, "margin-left", "2pt"))
  expect_true(has_css_attr(x, "margin-right", "2pt"))

  x <- fp_cell(vertical.align = "top")
  expect_true(has_css_attr(x, "vertical-align", "top"))
  x <- fp_cell(vertical.align = "center")
  expect_true(has_css_attr(x, "vertical-align", "middle"))
  x <- fp_cell(vertical.align = "bottom")
  expect_true(has_css_attr(x, "vertical-align", "bottom"))

})