tests/testthat/test-ctl_colonnade.R

In hadley/pillar: Coloured Formatting for Columns

test_that("output test", {
  expect_snapshot({
    ctl_colonnade(rep(list(paste(letters, collapse = " ")), 4), width = Inf)
  })
})

test_that("tests from tibble", {
  skip_if_not_installed("rlang", "0.4.11.9000")
  local_options(width = 80)

  expect_snapshot({
    ctl_colonnade(mtcars[1:8, ], has_row_id = "*", width = 30)
    ctl_colonnade(trees[1:5, ], width = 20)
    ctl_colonnade(trees[1:5, ], width = 10)
    ctl_colonnade(trees[1:3, ], width = 10)
    ctl_colonnade(df_all, width = 30)
    ctl_colonnade(df_all, width = 300)
    options(width = 70)
    ctl_colonnade(df_all, width = 300)
    options(width = 60)
    ctl_colonnade(df_all, width = 300)
    options(width = 50)
    ctl_colonnade(df_all, width = 300)
    options(width = 40)
    ctl_colonnade(df_all, width = 300)
    options(width = 30)
    ctl_colonnade(df_all, width = 300)
    options(width = 20)
    ctl_colonnade(df_all, width = 300)
    list_with_ctl <- list(c("\n", '"'), factor(c("\n", "\n")))
    names(list_with_ctl) <- c("\n", "\r")
    ctl_colonnade(list_with_ctl, width = 30)
    ctl_colonnade(list(a = c("", " ", "a ", " a")), width = 30)
    ctl_colonnade(list("mean(x)" = 5, "var(x)" = 3), width = 30)
  })
})

test_that("empty", {
  expect_equal(
    format(ctl_colonnade(list(a = character(), b = logical()), width = 30)$body),
    character()
  )
  expect_equal(
    format(ctl_colonnade(trees[1:5, character()], width = 30)$body),
    character()
  )
})

test_that("NA names", {
  expect_snapshot({
    x <- list(`NA` = 1:3, set_to_NA = 4:6)
    names(x)[[2]] <- NA_character_
    ctl_colonnade(x, width = 30)
  })
})

test_that("sep argument", {
  x <- list(sep = 1:3)
  expect_snapshot({
    ctl_colonnade(x, width = 30)
    "dummy"
  })
})

test_that("color", {
  skip_if_not_installed("testthat", "3.1.1")

  local_colors()
  expect_equal(cli::num_ansi_colors(), 16)

  if (l10n_info()$`UTF-8`) {
    local_utf8()
    expect_true(cli::is_utf8_output())
    variant <- "unicode"
  } else {
    variant <- "ansi"
  }

  expect_snapshot(variant = variant, {
    style_na("NA")
    style_neg("-1")
  })

  expect_snapshot(variant = variant, {
    xf <- function() ctl_colonnade(list(x = c((10^(-3:4)) * c(-1, 1), NA)))
    print(xf())
    with_options(pillar.subtle_num = TRUE, print(xf()))
    with_options(pillar.subtle = FALSE, print(xf()))
    with_options(pillar.neg = FALSE, print(xf()))
    with_options(pillar.subtle = FALSE, pillar.neg = FALSE, print(xf()))
    with_options(pillar.bold = TRUE, print(xf()))
  })

  expect_snapshot(variant = variant, {
    ctl_colonnade(list(a_very_long_column_name = 0), width = 20)
  })
})

# Run opposite test to snapshot output but not alter it
if (l10n_info()$`UTF-8`) {
  test_that("color, options: UTF-8 is FALSE", {
    skip("Symmetry")
  })
}

test_that("tibble columns", {
  x <- list(a = 1:3, b = data.frame(c = 4:6, d = 7:9))
  expect_snapshot({
    ctl_colonnade(x, width = 30)
  })
})

test_that("tibble columns (nested)", {
  x <- data_frame(
    a = 1:3,
    b = data_frame(
      c = 4:6, d = 7:9,
      e = data_frame(f = data_frame(g = 10:12, h = 13:15))
    )
  )
  expect_snapshot({
    ctl_colonnade(x, width = 40)
  })
})

test_that("tibble columns (empty)", {
  x <- data_frame(
    a = 1:3,
    b = data_frame(
      c = 4:6, d = 7:9,
      e = data_frame(f = 10:12)[, 0]
    ),
    c = 10:12
  )
  expect_snapshot({
    ctl_colonnade(x, width = 40)
  })
})

test_that("matrix columns (unnamed)", {
  x <- list(a = 1:3, b = matrix(4:9, ncol = 2))
  expect_snapshot({
    ctl_colonnade(x, width = 30)
  })
})

test_that("matrix columns (named)", {
  x <- list(a = 1:3, b = matrix(4:9, ncol = 2, dimnames = list(NULL, c("c", "d"))))
  expect_snapshot({
    ctl_colonnade(x, width = 30)
  })
})

test_that("matrix columns (empty)", {
  expect_snapshot({
    ctl_colonnade(
      list(a = 1:3, b = matrix(4:6, ncol = 1)[, 0], c = 4:6),
      width = 30
    )
  })
})

test_that("filling unused width (#331)", {
  new_foo <- function(x = character()) {
    vec_assert(x, character())
    new_vctr(x, class = "foo")
  }

  data <- new_tbl(list(
    month = month.name[1],
    sentences = new_foo(paste(letters, collapse = " ")),
    blah = paste(LETTERS, collapse = " ")
  ))

  pillar_shaft.foo <- function(x, ...) {
    full <- format(x)
    trunc <- format(paste0(substr(x, 1, 7), symbol$continue))
    pillar::new_pillar_shaft(
      list(full = full, trunc = trunc),
      width = pillar::get_max_extent(full),
      min_width = pillar::get_max_extent(trunc),
      class = "pillar_shaft_foo"
    )
  }

  format.pillar_shaft_foo <- function(x, width, ...) {
    if (pillar::get_max_extent(x$full) <= width) {
      ornament <- x$full
    } else {
      ornament <- x$trunc
    }

    pillar::new_ornament(ornament, align = "left")
  }

  local_methods(pillar_shaft.foo = pillar_shaft.foo, format.pillar_shaft_foo = format.pillar_shaft_foo)

  expect_snapshot({
    data
    options(width = 60)
    print(data)
  })
})

test_that("focus columns", {
  skip_if_not_installed("testthat", "3.1.1")

  local_colors()

  if (l10n_info()$`UTF-8`) {
    local_utf8()
    expect_true(cli::is_utf8_output())
    variant <- "unicode"
  } else {
    variant <- "ansi"
  }

  x <- new_tbl(list(a = new_tbl(list(x = 1, y = 2)), b = "long enough"))

  local_options(width = 80)

  expect_snapshot(variant = variant, {
    tbl_format_setup(x, width = 30, focus = "b")
    tbl_format_setup(x, width = 20, focus = "b")
    tbl_format_setup(x, width = 15, focus = "b")
    tbl_format_setup(x, width = 10, focus = "b")
    tbl_format_setup(x[2:1], width = 30, focus = "a")
    tbl_format_setup(x[2:1], width = 20, focus = "a")
    tbl_format_setup(x[2:1], width = 15, focus = "a")
    tbl_format_setup(x[2:1], width = 10, focus = "a")
    tbl_format_setup(x, width = 30, focus = c("a", "b"))
    tbl_format_setup(x, width = 20, focus = c("a", "b"))
    tbl_format_setup(x, width = 15, focus = c("a", "b"))
    tbl_format_setup(x, width = 10, focus = c("a", "b"))
    tbl_format_setup(x[2:1], width = 30, focus = c("a", "b"))
    tbl_format_setup(x[2:1], width = 20, focus = c("a", "b"))
    tbl_format_setup(x[2:1], width = 15, focus = c("a", "b"))
    tbl_format_setup(x[2:1], width = 10, focus = c("a", "b"))
  })
})