tests/testthat/test-layout-helper.R

In davidgohel/oxbase: Manipulation of Microsoft Word and PowerPoint Documents

# get_layout ----

test_that("get_layout works as expected", {
  opts <- options(cli.num_colors = 1) # suppress colors for error message check
  on.exit(options(opts))

  # all layouts unique
  x <- read_pptx()

  expect_error(
    get_layout(x, "Title Slide", "xxx"),
    'master "xxx" does not exist'
  )
  expect_error(
    get_layout(x, "xxx", "Office Theme"),
    'Layout "xxx" does not exist in master "Office Theme"'
  )

  expect_error(get_layout(x, 0), "Layout index out of bounds.")
  expect_error(get_layout(x, 10), "Layout index out of bounds.")
  expect_error(get_layout(x, Inf), "Layout index out of bounds.")

  expect_no_error(l1 <- get_layout(x, "Title Slide"))
  expect_s3_class(l1, "layout_info")
  expect_no_error(l2 <- get_layout(x, "Title Slide", "Office Theme"))
  expect_s3_class(l2, "layout_info")

  expect_no_error(la <- get_layout(x, 1))
  expect_equal(la$index, 1)
  expect_error(
    get_layout(x, 1, layout_by_id = FALSE),
    regexp = "`layout` must be <character>"
  )

  # same layout in several masters
  file <- test_path("docs_dir", "test-three-identical-masters.pptx")
  x <- read_pptx(file)

  expect_error(get_layout(x, "xxx", NULL), 'Layout "xxx" does not exist')
  expect_error(
    get_layout(x, "xxx", "Master_1"),
    'Layout "xxx" does not exist in master "Master_1"'
  )
  expect_error(
    get_layout(x, "Title Slide"),
    "Layout \"Title Slide\" exists in more than one master"
  )
  expect_error(
    get_layout(x, "Title Slide", "xxx"),
    'master "xxx" does not exist'
  )

  expect_no_error(la <- get_layout(x, "Title Slide", "Master_1"))
  expect_s3_class(la, "layout_info")

  expect_no_error(la <- get_layout(x, 1))
  expect_equal(la$index, 1)
})


test_that("is_layout_info", {
  x <- read_pptx()
  la <- get_layout(x, "Title Slide")
  expect_true(is_layout_info(la))
  expect_false(is_layout_info(NULL))
  expect_false(is_layout_info(1))
  expect_false(is_layout_info(list()))
})


test_that("incorrect inputs are detected", {
  opts <- options(cli.num_colors = 1) # suppress colors for error message check
  on.exit(options(opts))

  x <- read_pptx()
  layout <- "Comparison"

  expect_error(get_layout("no rpptx object", layout), "Incorrect input for `x`")

  # incorrect layout arg input
  error_msg <- "`layout` must be <numeric> or <character>"
  expect_error(get_layout(x, NA), error_msg)
  expect_error(get_layout(x, NULL), error_msg)
  expect_error(get_layout(x, mtcars), error_msg)

  # out of bound index
  error_msg <- "Layout index out of bounds"
  expect_error(get_layout(x, 0), error_msg)
  expect_error(get_layout(x, -1), error_msg)
  expect_error(get_layout(x, 8), error_msg)
  expect_error(get_layout(x, Inf), error_msg)

  # non existing layout
  expect_error(get_layout(x, "xxx"), 'Layout "xxx" does not exist.')
  expect_error(get_layout(x, ""), 'Layout "" does not exist.')

  # not exactly one layout
  error_msg <- "`layout` is not length 1"
  expect_error(get_layout(x, c("a", "b")), error_msg)
  expect_error(get_layout(x, 1:2), error_msg)
  expect_error(get_layout(x, integer()), error_msg)
  expect_error(get_layout(x, character()), error_msg)

  # layout not unique
  file <- test_path("docs_dir", "test-three-identical-masters.pptx")
  x <- read_pptx(file)
  expect_error(
    get_layout(x, "Title Slide"),
    "Layout \"Title Slide\" exists in more than one master"
  )
})


test_that("<layout_info> prints correctly", {
  x <- read_pptx()
  layout <- "Comparison"
  l <- get_layout(x, layout)
  out <- capture.output(print(l))
  expect_equal(length(out), length(l))
})


test_that("get layout from slide", {
  opts <- options(cli.num_colors = 1) # suppress colors for error message check
  on.exit(options(opts))

  x <- read_pptx()

  # fails if no slides exist
  expect_error(
    get_slide_layout(x, 0),
    "Presentation does not have any slides yet"
  )
  expect_error(
    get_layout_for_current_slide(x),
    "Presentation does not have any slides yet"
  )

  # detect correct slide layout
  layout <- "Comparison"
  x <- add_slide(x, layout)

  expect_error(get_slide_layout(x, 0), "Slide index 0 is out of range")
  expect_error(get_slide_layout(x, 2), "Slide index 2 is out of range")

  error_msg <- "`slide_idx` must be <numeric>"
  expect_error(get_slide_layout(x, "1"), error_msg)
  expect_error(get_slide_layout(x, NA), error_msg)
  expect_error(get_slide_layout(x, NULL), error_msg)

  expect_no_error(get_slide_layout(x, 1))
  expect_no_error(get_layout_for_current_slide(x))

  la_slide <- get_slide_layout(x, 1)
  la_current <- get_layout_for_current_slide(x)
  la_reference <- get_layout(x, layout)
  expect_identical(la_current, la_reference)
  expect_identical(la_slide, la_reference)

  layout <- "Title Slide"
  x <- add_slide(x, layout)
  la_slide <- get_slide_layout(x, 2)
  la_current <- get_layout_for_current_slide(x)
  la_reference <- get_layout(x, layout)
  expect_identical(la_current, la_reference)
  expect_identical(la_slide, la_reference)
})


# layout_default ----

test_that("layout_default", {
  opts <- options(cli.num_colors = 1) # suppress colors for error message check
  on.exit(options(opts))

  x <- read_pptx()
  expect_false(has_layout_default(x))
  la_default <- list(layout = NA, master = NA)
  expect_identical(x$layout_default, la_default)
  expect_identical(get_layout_default(x), la_default)
  expect_identical(layout_default(x, as_list = TRUE), la_default)

  layout <- "Title Slide"
  x <- layout_default(x, layout)
  expect_true(has_layout_default(x))
  expect_identical(
    x$layout_default,
    list(layout = layout, master = "Office Theme")
  )

  x <- layout_default(x, NA)
  expect_false(has_layout_default(x))
  expect_identical(get_layout_default(x), list(layout = NA, master = NA))

  expect_error(layout_default(x, "xxx"), 'Layout "xxx" does not exist')
})