diff --git a/.Rbuildignore b/.Rbuildignore index 066273d4f7..2c2dfddcf0 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -180,4 +180,6 @@ tests/testthat/test-util_functions.R tests/testthat/test-utils_plots.R tests/testthat/test-utils_render_html.R tests/testthat/test-utils_units.R + +tests/testthat/_snaps/utils.md tests/testthat/test-utils.R diff --git a/R/data_color.R b/R/data_color.R index 954402b910..c3a5d70fe3 100644 --- a/R/data_color.R +++ b/R/data_color.R @@ -1493,7 +1493,7 @@ check_named_colors <- function(named_colors, call = rlang::caller_env()) { ) cli::cli_abort(c( - "{one_several_invalid} used ({str_catalog(invalid_colors, conj = 'and')}).", + "{one_several_invalid} used ({.str {invalid_colors}}).", "*" = "Only R/X11 color names and CSS 3.0 color names can be used." ), call = call diff --git a/R/modify_rows.R b/R/modify_rows.R index a7872313a1..69cee75335 100644 --- a/R/modify_rows.R +++ b/R/modify_rows.R @@ -100,7 +100,7 @@ row_group_order <- function( cli::cli_abort(c( "All values given as `groups` must correspond to `group_id` values.", "*" = "The following `group_id` values can be - used {str_catalog(arrange_groups)}." + used {.str {arrange_groups}}." )) } diff --git a/R/text_transform.R b/R/text_transform.R index 30f6afbef1..2f5126552f 100644 --- a/R/text_transform.R +++ b/R/text_transform.R @@ -110,7 +110,7 @@ text_replace <- function( data = data, locations = locations, fn = function(x) { - str_complete_replace(x, pattern = pattern, replacement = replacement) + gsub(pattern = pattern, replacement = replacement, x, perl = TRUE) } ) } diff --git a/R/utils_general_str_formatting.R b/R/utils_general_str_formatting.R index ffee017176..5cd039b75b 100644 --- a/R/utils_general_str_formatting.R +++ b/R/utils_general_str_formatting.R @@ -329,48 +329,6 @@ is_adjacent_separate <- function(group_1, group_2) { TRUE } -str_catalog <- function( - item_vector, - conj = "and", - surround = c("\"", "`"), - sep = ",", - oxford = TRUE -) { - - item_count <- length(item_vector) - - surround_str_1 <- paste(rev(surround), collapse = "") - surround_str_2 <- paste(surround, collapse = "") - - cat_str <- paste0(surround_str_1, item_vector, surround_str_2) - - if (item_count == 1) { - - return(cat_str) - - } else if (item_count == 2) { - - return(paste(cat_str[1], conj, cat_str[2])) - - } else { - - separators <- rep(paste_right(sep, " "), item_count - 1) - - if (!oxford) { - separators[length(separators)] <- "" - } - - separators[length(separators)] <- - paste_right(paste_right(separators[length(separators)], conj), " ") - - separators[length(separators) + 1] <- "" - - cat_str <- paste(paste0(cat_str, separators), collapse = "") - - return(cat_str) - } -} - str_title_case <- function(x) { title_case_i <- function(y) { @@ -393,10 +351,10 @@ str_substitute <- function(string, start = 1L, end = -1L) { end <- start[, 2L] start <- start[, 1L] } - - start <- recycler(start, string) - end <- recycler(end, string) - + # Error if start or end is incorrect. + vec <- vctrs::vec_recycle_common(start = start, end = end, .size = length(string)) + start <- vec$start + end <- vec$end n <- nchar(string) start <- ifelse(start < 0, start + n + 1, start) end <- ifelse(end < 0, end + n + 1, end) @@ -404,19 +362,6 @@ str_substitute <- function(string, start = 1L, end = -1L) { substr(string, start, end) } -recycler <- function(x, to, arg = deparse(substitute(x))) { - - if (length(x) == length(to)) { - return(x) - } - - if (length(x) != 1) { - stop("Can't recycle `", arg, "` to length ", length(to), call. = FALSE) - } - - rep(x, length(to)) -} - str_complete_locate <- function(string, pattern) { out <- gregexpr(pattern, string, perl = TRUE) lapply(out, location, all = TRUE) @@ -427,14 +372,6 @@ str_single_locate <- function(string, pattern) { location(out) } -str_complete_replace <- function(string, pattern, replacement) { - gsub(pattern, replacement, string, perl = TRUE) -} - -str_single_replace <- function(string, pattern, replacement) { - sub(pattern, replacement, string, perl = TRUE) -} - location <- function(x, all = FALSE) { start <- as.vector(x) diff --git a/R/utils_render_grid.R b/R/utils_render_grid.R index 0fde9c0e52..370f465f33 100644 --- a/R/utils_render_grid.R +++ b/R/utils_render_grid.R @@ -949,9 +949,12 @@ render_grid_svg <- function(label, style, margin) { # Try if any height is declared in style attribute if (any(grepl("^height:", svg_style))) { - height <- gsub("^height:", "", svg_style[grep("^height:", svg_style)]) %>% - parse_fontsize(style$text_gp$fontsize) %>% - grid::unit(.grid_unit) + height <- gsub("^height:", "", svg_style[grep("^height:", svg_style)]) + height <- + grid::unit( + parse_fontsize(height, style$text_gp$fontsize), + .grid_unit + ) } # Try if any width is declared in style attribute @@ -1022,9 +1025,8 @@ render_grid_svg <- function(label, style, margin) { raster <- try_fetch( { - svg_string %>% # charToRaw("") return character(0) - charToRaw() %>% + charToRaw(svg_string) %>% rsvg::rsvg_nativeraster(width = w) %>% grid::rasterGrob( width = width, height = height, diff --git a/R/utils_render_rtf.R b/R/utils_render_rtf.R index ab4392ce1a..57df8edb21 100644 --- a/R/utils_render_rtf.R +++ b/R/utils_render_rtf.R @@ -403,8 +403,7 @@ parse_length_str <- function( cli::cli_abort(c( "Some of the values supplied cannot be interpreted.", - "*" = "Problem values are: - {str_catalog(bad_values, surround = c('\"'))}.", + "*" = "Problem values are: {.str {bad_values}}", "*" = "Use either of: `px`, `pt`, `in`, `cm`, `mm`, or `tw` (e.g., \"12px\")" )) @@ -1019,8 +1018,7 @@ create_heading_component_rtf <- function(data) { # Obtain widths for each visible column label col_widths <- - boxh %>% - dplyr::filter(type %in% c("default", "stub")) %>% + dplyr::filter(boxh, type %in% c("default", "stub")) %>% dplyr::arrange(dplyr::desc(type)) %>% dplyr::pull(column_width) %>% unlist() diff --git a/R/z_utils_render_footnotes.R b/R/z_utils_render_footnotes.R index 0a4a283bc0..b286996ffb 100644 --- a/R/z_utils_render_footnotes.R +++ b/R/z_utils_render_footnotes.R @@ -144,8 +144,9 @@ resolve_footnotes_styles <- function(data, tbl_type) { cond <- tbl$locname != "row_groups" tbl_not_row_groups <- tbl[cond, ] - tbl_row_groups <- tbl[!cond, ] %>% + tbl_row_groups <- dplyr::inner_join( + tbl[!cond, ], groups_rows_df, by = c("grpname" = "group_id") ) @@ -411,9 +412,16 @@ set_footnote_marks_columns <- function(data, context = "html") { if (nrow(footnotes_columns_groups_tbl) > 0) { footnotes_columns_group_marks <- - footnotes_columns_groups_tbl %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>% - dplyr::distinct(grpname, fs_id_coalesced) + dplyr::mutate( + footnotes_columns_groups_tbl, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = "grpname" + ) + footnotes_columns_group_marks <- + dplyr::distinct( + footnotes_columns_group_marks, + grpname, fs_id_coalesced + ) for (i in seq_len(nrow(footnotes_columns_group_marks))) { @@ -464,10 +472,21 @@ set_footnote_marks_columns <- function(data, context = "html") { if (nrow(footnotes_columns_columns_tbl) > 0) { footnotes_columns_column_marks <- - footnotes_columns_columns_tbl %>% - dplyr::filter(locname == "columns_columns") %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "colname") %>% - dplyr::distinct(colname, fs_id_coalesced) + vctrs::vec_slice( + footnotes_columns_columns_tbl, + !is.na(footnotes_columns_columns_tbl$locname) & + footnotes_columns_columns_tbl$locname == "columns_columns" + ) + footnotes_columns_column_marks <- + dplyr::mutate( + footnotes_columns_column_marks, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = "colname" + ) + footnotes_columns_column_marks <- + dplyr::distinct( + footnotes_columns_column_marks, colname, fs_id_coalesced + ) for (i in seq_len(nrow(footnotes_columns_column_marks))) { @@ -515,11 +534,14 @@ set_footnote_marks_stubhead <- function(data, context = "html") { if (nrow(footnotes_tbl) > 0) { footnotes_stubhead_marks <- - footnotes_tbl %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>% - dplyr::distinct(grpname, fs_id_coalesced) %>% - dplyr::pull(fs_id_coalesced) - + dplyr::mutate( + footnotes_tbl, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = "grpname" + ) + footnotes_stubhead_marks <- + dplyr::distinct(footnotes_stubhead_marks, grpname, fs_id_coalesced) + footnotes_stubhead_marks <- footnotes_stubhead_marks$fs_id_coalesced label <- paste0( diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md new file mode 100644 index 0000000000..a3310b6e19 --- /dev/null +++ b/tests/testthat/_snaps/utils.md @@ -0,0 +1,18 @@ +# str_substitute() works well + + Code + str_substitute(c("223", "223", "224"), c(1, 2), 2) + Condition + Error in `str_substitute()`: + ! Can't recycle `start` (size 2) to size 3. + Code + str_substitute(c("223", "223", "224"), c(1), c(2, 3)) + Condition + Error in `str_substitute()`: + ! Can't recycle `end` (size 2) to size 3. + Code + str_substitute(c("223", "223", "224", "225"), c(1, 2, 3, 4), c(2, 3)) + Condition + Error in `str_substitute()`: + ! Can't recycle `end` (size 2) to size 4. + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index ad89d46a3a..0342d211c2 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -27,15 +27,36 @@ html_fragment_within <- function(raw_html, ...) { } # shortcut for expect_match(render_as_html(object), regexp) +expect_match_raw_html <- function(object, + regexp, + perl = FALSE, + fixed = FALSE, + ..., + all = TRUE, + info = NULL, + label = NULL) { + expect_match_html( + object = object, + regexp = regexp, + f = as_raw_html, + perl = perl, + fixed = fixed, + ..., + all = TRUE, + info = NULL, + label = NULL + ) +} expect_match_html <- function(object, regexp, + f = render_as_html, perl = FALSE, fixed = FALSE, ..., all = TRUE, info = NULL, label = NULL) { - rendered <- render_as_html(object) + rendered <- f(object) for (i in seq_along(regexp)) { testthat::expect_match( object = rendered, @@ -53,14 +74,15 @@ expect_match_html <- function(object, # shortcut for expect_match(render_as_html(object), regexp) expect_no_match_html <- function(object, - regexp, - perl = FALSE, - fixed = FALSE, - ..., - all = TRUE, - info = NULL, - label = NULL) { - rendered <- render_as_html(object) + regexp, + f = render_as_html, + perl = FALSE, + fixed = FALSE, + ..., + all = TRUE, + info = NULL, + label = NULL) { + rendered <- f(object) for (i in seq_along(regexp)) { testthat::expect_no_match( object = rendered, @@ -97,6 +119,84 @@ get_row_group_text <- function(tbl_html) { ) } +generate_html_units <- function(input) { + render_units( + define_units(input), + context = "html" + ) +} + +#' Test if two gt tables are equal (or equivalent) +#' +#' @param gt_tbl1,gt_tbl2 A pair of gt tables to test for equality +#' @param f A function to apply to two tables +#' @param ignore_id Whether to ignore the html id +#' @param ... Additional parameters passed on to `expect_equal()` +#' +#' @noRd +expect_equal_gt <- function(gt_tbl1, gt_tbl2, f = render_as_html, ignore_id = FALSE, ...) { + gt_tbl1 <- f(gt_tbl1) + gt_tbl2 <- f(gt_tbl2) + if (ignore_id) { + gt_tbl1 <- gsub("id=\"[a-z]*?\"", "", gt_tbl1) + gt_tbl2 <- gsub("id=\"[a-z]*?\"", "", gt_tbl2) + } + expect_equal( + gt_tbl1, + gt_tbl2, + ... + ) +} + +#' Test that a summary object has the expected types. +#' +#' @param summary Object extracted with `dt_summary_get()` +#' @param length Number of summary +#' @param type A vector of length of summary that indicates a `"summary"` or +#' `"grand_summary"`. +#' @noRd +expect_summary <- function(summary, length, type = "summary") { + rlang::arg_match(type, c("summary", "grand_summary"), multiple = TRUE) + vec <- vctrs::vec_recycle_common(type = type, .size = length) + type <- vec$type + + # The summary object has the following fields + summary_names <- c( + "groups", "columns", "fns", "fmt", "side", + "missing_text", "formatter", "formatter_options" + ) + + # Expect that the internal `summary` list object has a length + # of `length + # We expect this to be 1 if there was only one call of `summary_rows()` + expect_length(summary, length) + + for (i in seq_along(length)) { + expect_named(summary[[i]], summary_names) + + # Expect that `summary[[1]]$missing_text` has a specific value + expect_equal(summary[[i]]$missing_text, "---") + + # Expect that `summary[[1]]$formatter_options` is a list + expect_type(summary[[i]]$formatter_options, "list") + + # Expect the formatter to be NULL + expect_null(summary[[i]]$formatter) + + expect_type(summary[[i]]$fns, "list") + + if (type[[i]] == "summary") { + # Expect that `summary[[1]]$formatter_options` is + # of length 0 if column not formatted + expect_length(summary[[i]]$formatter_options, 0) + + } else if (type[[i]] == "grand_summary") { + expect_equal(summary[[i]]$groups, ":GRAND_SUMMARY:") + } + } +} + + # Create a shortened version of `mtcars` mtcars_short <- datasets::mtcars[1:5, ] diff --git a/tests/testthat/test-as_raw_html.R b/tests/testthat/test-as_raw_html.R index c6b2ba2806..70ebadac38 100644 --- a/tests/testthat/test-as_raw_html.R +++ b/tests/testthat/test-as_raw_html.R @@ -119,24 +119,22 @@ test_that("as_raw_html() produces the same table every time", { # Expect that font family values with multiple words (i.e., have a space # character) added with `tab_style()` preserve single-quote characters - expect_match( + expect_match_raw_html( exibble[1, ] %>% gt() %>% tab_header(title = "Title") %>% - tab_style(style = cell_text(font = "Two Words"), locations = cells_title()) %>% - as_raw_html(), + tab_style(style = cell_text(font = "Two Words"), locations = cells_title()), "font-family: 'Two Words';" ) - expect_match( + expect_match_raw_html( exibble[1, ] %>% gt() %>% tab_header(title = "Title") %>% tab_style( style = cell_text(font = c("Fira Sans", "Droid Sans", "Arial", "sans-serif")), locations = cells_title() - ) %>% - as_raw_html(), + ), "font-family: 'Fira Sans', 'Droid Sans', Arial, sans-serif;" ) }) diff --git a/tests/testthat/test-cols_align.R b/tests/testthat/test-cols_align.R index 750fb15c7a..c55e6a59e1 100644 --- a/tests/testthat/test-cols_align.R +++ b/tests/testthat/test-cols_align.R @@ -1,10 +1,3 @@ -# Create a data frame based on the internal `sp500.csv` -sp500 <- - read.csv( - system.file("extdata", "sp500.csv", package = "gt"), - stringsAsFactors = FALSE - ) - # Function to skip tests if Suggested packages not available on system check_suggests <- function() { skip_if_not_installed("rvest") @@ -105,6 +98,13 @@ test_that("cols_align() works correctly", { rvest::html_text() %>% expect_equal(colnames(mtcars_short)) + # Create a data frame based on the internal `sp500.csv` + sp500 <- + read.csv( + system.file("extdata", "sp500.csv", package = "gt"), + stringsAsFactors = FALSE + ) + # Create a `tbl_html` object with the `sp500` data # frame and `auto`-align all columns tbl_html <- diff --git a/tests/testthat/test-cols_merge.R b/tests/testthat/test-cols_merge.R index 50454bcb1e..6b7b337269 100644 --- a/tests/testthat/test-cols_merge.R +++ b/tests/testthat/test-cols_merge.R @@ -666,10 +666,7 @@ test_that("cols_merge_range() works well", { ) # Expect that the HTML produced from the two tables is the same - expect_identical( - gsub("id=\"[a-z]*?\"", "", as_raw_html(tbl_html_1)), - gsub("id=\"[a-z]*?\"", "", as_raw_html(tbl_html_2)) - ) + expect_equal_gt(tbl_html_1, tbl_html_2, f = as_raw_html, ignore_id = TRUE) # Create another variant that renames `col_2` as `1`, which # might be thought to interfere with the default pattern @@ -684,10 +681,7 @@ test_that("cols_merge_range() works well", { # Expect that the HTML produced from `tbl_html_2` and # `tbl_html_3` is the same - expect_identical( - gsub("id=\"[a-z]*?\"", "", as_raw_html(tbl_html_2)), - gsub("id=\"[a-z]*?\"", "", as_raw_html(tbl_html_3)) - ) + expect_equal_gt(tbl_html_2, tbl_html_3, f = as_raw_html, ignore_id = TRUE) }) test_that("cols_merge_range() produces the correct output", { diff --git a/tests/testthat/test-cols_width.R b/tests/testthat/test-cols_width.R index 3a0c8c5dd5..ff5dc883ab 100644 --- a/tests/testthat/test-cols_width.R +++ b/tests/testthat/test-cols_width.R @@ -978,11 +978,10 @@ test_that("cols_width() correctly specifies LaTeX table when column widths are s ) # Expect that all column widths are expressed as percentage of \linewidth - c(0.5, 0.3, 0.2, 0.1) %>% - pct_string() %>% - build_longtable_regex() %>% - grepl(as_latex(tbl_latex)) %>% - expect_true() + longtable_s <- build_longtable_regex( + pct_string(c(0.5, 0.3, 0.2, 0.1)) + ) + expect_match(as_latex(tbl_latex), longtable_s) # Check that LaTeX is correctly generated when only some diff --git a/tests/testthat/test-gt_group.R b/tests/testthat/test-gt_group.R index 3c797d96b1..9e93ef5987 100644 --- a/tests/testthat/test-gt_group.R +++ b/tests/testthat/test-gt_group.R @@ -391,31 +391,26 @@ test_that("grp_options() can be used to set options for a group", { table.background.color = "gray95", table.font.color = "gray10" ) - # Pull out the individual tables - gt_tbl_1_alt <- gt_tbls_2 %>% grp_pull(which = 1) - gt_tbl_2_alt <- gt_tbls_2 %>% grp_pull(which = 2) - # Expect the default text and background colors for the input gt tables - expect_match( - as_raw_html(gt_tbl_1), - "" + expect_match_raw_html( + gt_tbl_1, "
", ) - expect_match( - as_raw_html(gt_tbl_2), - "
" + expect_match_raw_html( + gt_tbl_2, "
", ) + # Pull out the individual tables + gt_tbl_1_alt <- gt_tbls_2 %>% grp_pull(which = 1) + gt_tbl_2_alt <- gt_tbls_2 %>% grp_pull(which = 2) + # Expect the changed text and background colors for the input gt tables # that were pulled from the group that had group options applied (and # activated via `.use_grp_opts = TRUE`) - expect_match( - as_raw_html(gt_tbl_1_alt), - "
" + expect_match_raw_html( + gt_tbl_1_alt, "
" ) - - expect_match( - as_raw_html(gt_tbl_2_alt), - "
" + expect_match_raw_html( + gt_tbl_2_alt, "
" ) }) diff --git a/tests/testthat/test-l_cols_align.R b/tests/testthat/test-l_cols_align.R index 80c4cd5482..dda20460cb 100644 --- a/tests/testthat/test-l_cols_align.R +++ b/tests/testthat/test-l_cols_align.R @@ -1,9 +1,3 @@ -# Create a data frame based on the internal `sp500.csv` -sp500 <- - read.csv( - system.file("extdata", "sp500.csv", package = "gt"), - stringsAsFactors = FALSE) - test_that("cols_align() works correctly", { # Create a `tbl_latex` object with `gt()`; the `mpg`, @@ -53,6 +47,11 @@ test_that("cols_align() works correctly", { # Expect a characteristic pattern expect_length(tbl_latex, 1) expect_match(tbl_latex, ".*begin\\{longtable\\}\\{lllllllllll\\}.*") + # Create a data frame based on the internal `sp500.csv` + sp500 <- + read.csv( + system.file("extdata", "sp500.csv", package = "gt"), + stringsAsFactors = FALSE) # Create a `tbl_latex` object with the `sp500` data # frame and `auto`-align all columns diff --git a/tests/testthat/test-substitution.R b/tests/testthat/test-substitution.R index 02f1719b46..203d2169b5 100644 --- a/tests/testthat/test-substitution.R +++ b/tests/testthat/test-substitution.R @@ -344,9 +344,9 @@ test_that("sub_zero() works correctly", { c("NA", "74.0000", "NA", "{\\i nil}", "NA", "0.0001", "NA") ) - expect_equal( - tab %>% sub_zero(columns = "lett") %>% render_as_html(), - tab %>% render_as_html() + expect_equal_gt( + tab %>% sub_zero(columns = "lett"), + tab ) # Format columns with `fmt_number()` then use @@ -555,27 +555,19 @@ test_that("sub_small_vals() works correctly", { ) # Expect that the sign of the `threshold` value doesn't affect anything - expect_equal( - tab %>% - sub_small_vals(columns = "num_1", threshold = 3, sign = "-") %>% - render_as_html(), - tab %>% - sub_small_vals(columns = "num_1", threshold = -3, sign = "-") %>% - render_as_html() + expect_equal_gt( + tab %>% sub_small_vals(columns = "num_1", threshold = 3, sign = "-"), + tab %>% sub_small_vals(columns = "num_1", threshold = -3, sign = "-") ) - expect_equal( - tab %>% - sub_small_vals(columns = "num_1", threshold = 10, sign = "+") %>% - render_as_html(), - tab %>% - sub_small_vals(columns = "num_1", threshold = -10, sign = "+") %>% - render_as_html() + expect_equal_gt( + tab %>% sub_small_vals(columns = "num_1", threshold = 10, sign = "+"), + tab %>% sub_small_vals(columns = "num_1", threshold = -10, sign = "+") ) - expect_equal( - tab %>% sub_small_vals(columns = "lett") %>% render_as_html(), - tab %>% render_as_html() + expect_equal_gt( + tab %>% sub_small_vals(columns = "lett"), + tab ) # Expect an error if an invalid `sign` is used @@ -730,39 +722,29 @@ test_that("sub_large_vals() works correctly", { # Expect that the order of `fmt_*()` and `sub_*()` functions shouldn't # make a different in the final outputs - expect_equal( + expect_equal_gt( tab %>% fmt_integer(columns = "int_1") %>% - sub_large_vals(columns = "int_1", threshold = 3, sign = "-") %>% - render_as_html(), + sub_large_vals(columns = "int_1", threshold = 3, sign = "-"), tab %>% sub_large_vals(columns = "int_1", threshold = -3, sign = "-") %>% - fmt_integer(columns = "int_1") %>% - render_as_html() + fmt_integer(columns = "int_1") ) # Expect that the sign of the `threshold` value doesn't affect anything - expect_equal( - tab %>% - sub_large_vals(columns = "int_1", threshold = 3, sign = "-") %>% - render_as_html(), - tab %>% - sub_large_vals(columns = "int_1", threshold = -3, sign = "-") %>% - render_as_html() + expect_equal_gt( + tab %>% sub_large_vals(columns = "int_1", threshold = 3, sign = "-"), + tab %>% sub_large_vals(columns = "int_1", threshold = -3, sign = "-") ) - expect_equal( - tab %>% - sub_large_vals(columns = "num_1", threshold = 10, sign = "+") %>% - render_as_html(), - tab %>% - sub_large_vals(columns = "num_1", threshold = -10, sign = "+") %>% - render_as_html() + expect_equal_gt( + tab %>% sub_large_vals(columns = "num_1", threshold = 10, sign = "+"), + tab %>% sub_large_vals(columns = "num_1", threshold = -10, sign = "+") ) - expect_equal( - tab %>% sub_large_vals(columns = "lett") %>% render_as_html(), - tab %>% render_as_html() + expect_equal_gt( + tab %>% sub_large_vals(columns = "lett"), + tab ) # Expect an error if an invalid `sign` is used diff --git a/tests/testthat/test-summary_rows.R b/tests/testthat/test-summary_rows.R index b1db716a37..c4e36ea9db 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -38,39 +38,20 @@ test_that("summary_rows() can make group-wise summaries", { # Extract the internal `summary` object summary <- dt_summary_get(data = gt_tbl) - # Expect that the internal `summary` list object has a length - # of `1` since there was only one call of `summary_rows()` - expect_length(summary, 1) - - # For the single list component in `summary`, expect specific - # names within it - expect_named( - summary[[1]], - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) + # Expect that the summary has the expected structure + expect_summary(summary, length = 1, type = "summary") # Expect the `groups` provided in `summary[[1]]$groups` expect_equal(summary[[1]]$groups, "W02") # Expect the `columns` provided in `summary[[1]]$columns` - expect_equal(summary[[1]]$columns , c("open", "high", "low", "close")) - expect_type(summary[[1]]$fns, "list") + expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) # Expect that the components of `summary[[1]]$fns` are lists expect_type(summary[[1]]$fns$average, "list") expect_type(summary[[1]]$fns$total, "list") expect_type(summary[[1]]$fns$`std dev`, "list") - # Expect that - expect_equal(summary[[1]]$missing_text, "---") - expect_equal(summary[[1]]$formatter, NULL) - # expect a zero-length list - expect_type(summary[[1]]$formatter_options, "list") - expect_length(summary[[1]]$formatter_options, 0) - # Create a table with summary rows for the `W02` group; # the 3 summary rows for this group represent the mean, sum, # and standard deviation of only the `open` column @@ -89,32 +70,22 @@ test_that("summary_rows() can make group-wise summaries", { # Extract the internal `summary` object summary <- dt_summary_get(data = gt_tbl) + # Expect that the summary has the expected structure + expect_summary(summary, length = 1, type = "summary") + # Expect the `groups` provided in `summary[[1]]$groups` - summary[[1]]$groups %>% expect_equal("W02") + expect_equal(summary[[1]]$groups, "W02") # Expect the `columns` provided in `summary[[1]]$columns` - summary[[1]]$columns %>% expect_equal("open") + expect_equal(summary[[1]]$columns, "open") # Expect that `summary[[1]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") + expect_type(summary[[1]]$fns , "list") # Expect that the components of `summary[[1]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1]]$formatter_options` is - # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total , "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, @@ -134,31 +105,19 @@ test_that("summary_rows() can make group-wise summaries", { # Extract the internal `summary` object summary <- dt_summary_get(data = gt_tbl) + # Expect that the summary has the expected structure + expect_summary(summary, length = 1, type = "summary") + # Expect the `groups` provided in `summary[[1]]$groups` - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) + expect_equal(summary[[1]]$groups, c("W02", "W03")) # Expect the `columns` provided in `summary[[1]]$columns` - summary[[1]]$columns %>% expect_equal("open") - - # Expect that `summary[[1]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, "open") # Expect that the components of `summary[[1]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1]]$formatter_options` is of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average , "list") + expect_type(summary[[1]]$fns$total , "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, @@ -177,34 +136,20 @@ test_that("summary_rows() can make group-wise summaries", { # Extract the internal `summary` object summary <- dt_summary_get(data = gt_tbl) + # Expect that the summary has the expected structure + expect_summary(summary, length = 1, type = "summary") # Expect the `groups` provided in `summary[[1]]$groups` # to resolve to both groups - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) + expect_equal(summary[[1]]$groups, c("W02", "W03")) # Expect the `columns` provided in `summary[[1]]$columns` - summary[[1]]$columns %>% expect_equal("open") - - # Expect that `summary[[1]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, "open") # Expect that the components of `summary[[1]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1]]$formatter_options` is - # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average , "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev` , "list") # Create a table with two sets of summary rows for all groups # and all columns @@ -230,69 +175,25 @@ test_that("summary_rows() can make group-wise summaries", { # Extract the internal `summary` object summary <- dt_summary_get(data = gt_tbl) + # Expect that the summary has the expected structure # Expect that the internal `summary` list # object has a length of `2` since there # were two calls of `summary_rows()` - summary %>% expect_length(2) - - # For the two list components in `summary`, expect specific - # names within them - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - summary[[2]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) + expect_summary(summary, length = 2, type = c("summary", "summary")) # Expect that `summary[[1|2]]$groups` has both resolved groups - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) - - summary[[2]]$groups %>% expect_equal(c("W02", "W03")) + expect_equal(summary[[1]]$groups, c("W02", "W03")) + expect_equal(summary[[2]]$groups, c("W02", "W03")) # Expect that `summary[[1|2]]$columns` has specific values - summary[[1]]$columns %>% - expect_equal(c("open", "high", "low", "close")) - - summary[[2]]$columns %>% - expect_equal(c("open", "high", "low", "close")) - - # Expect that `summary[[1|2]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") - - summary[[2]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) + expect_equal(summary[[2]]$columns, c("open", "high", "low", "close")) # Expect that the components of `summary[[1|2]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - summary[[2]]$fns$max %>% expect_type("list") - - # Expect that `summary[[1|2]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - summary[[2]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1|2]]$formatter` are both NULL - expect_null(summary[[1]]$formatter) - expect_null(summary[[2]]$formatter) - - # Expect that `summary[[1|2]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - summary[[2]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1|2]]$formatter_options` are both - # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) - summary[[2]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") + expect_type(summary[[2]]$fns$max, "list") # Create a table with two sets of summary rows for all groups # and all columns @@ -323,62 +224,23 @@ test_that("summary_rows() can make group-wise summaries", { # Expect that the internal `summary` list # object has a length of `2` since there # were two calls of `summary_rows()` - length(summary) %>% expect_equal(2) - - # For the two list components in `summary`, expect specific - # names within them - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - summary[[2]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) + expect_summary(summary, length = 2, type = c("summary", "summary")) # Expect that `summary[[1|2]]$groups` have both groups resolved - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) - summary[[2]]$groups %>% expect_equal(c("W02", "W03")) + expect_equal(summary[[1]]$groups, c("W02", "W03")) + expect_equal(summary[[2]]$groups, c("W02", "W03")) # Expect that `summary[[1|2]]$columns` has specific values - summary[[1]]$columns %>% expect_equal(c("open", "high")) - summary[[2]]$columns %>% expect_equal(c("low", "close")) - - # Expect that `summary[[1|2]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") - summary[[2]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high")) + expect_equal(summary[[2]]$columns, c("low", "close")) # Expect that the components of `summary[[1|2]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - summary[[2]]$fns$average %>% expect_type("list") - summary[[2]]$fns$total %>% expect_type("list") - summary[[2]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1|2]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1|2]]$formatter` are NULL - expect_null(summary[[1]]$formatter) - expect_null(summary[[2]]$formatter) - - # Expect that `summary[[1|2]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - summary[[2]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1|2]]$formatter_options` are both - # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) - summary[[2]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") + expect_type(summary[[2]]$fns$average, "list") + expect_type(summary[[2]]$fns$total, "list") + expect_type(summary[[2]]$fns$`std dev`, "list") }) test_that("Grand summaries can be generated with `grand_summary_rows()`", { @@ -401,41 +263,16 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { # Expect that the internal `summary` list object has a length of `1` # since there was only one call of `summary_rows()` - length(summary) %>% expect_equal(1) - - # For the single list component in `summary`, expect specific - # names within it - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - # Expect the `groups` provided in `summary[[1]]$groups` is a specific string - summary[[1]]$groups %>% expect_equal(":GRAND_SUMMARY:") + expect_summary(summary, length = 1, type = "grand_summary") # Expect the `columns` provided in `summary[[1]]$columns` # provide names for all columns - summary[[1]]$columns %>% expect_equal(c("open", "high", "low", "close")) - - # Expect that `summary[[1]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) # Expect that the components of `summary[[1]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Create a table with a grand summary; the 3 summary rows for represent # the mean, sum, and standard deviation of all numeric columns; split @@ -466,61 +303,27 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { # Expect that the internal `summary` list object has a length of `2` # since there were two calls of `summary_rows()` - expect_length(summary, 2) - - # For the two list components in `summary`, expect specific - # names within them - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - summary[[2]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - # Expect that `summary[[1|2]]$groups` have a specific string - summary[[1]]$groups %>% expect_equal(":GRAND_SUMMARY:") - summary[[2]]$groups %>% expect_equal(":GRAND_SUMMARY:") + expect_summary(summary, length = 2, type = c("grand_summary", "grand_summary")) # Expect that `summary[[1|2]]$columns` has specific values - summary[[1]]$columns %>% expect_equal(c("open", "high")) - summary[[2]]$columns %>% expect_equal(c("low", "close")) - - # Expect that `summary[[1|2]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") - summary[[2]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high")) + expect_equal(summary[[2]]$columns, c("low", "close")) # Expect that the functions used in each call # are the same expect_identical(summary[[1]]$fns, summary[[1]]$fns) # Expect that the components of `summary[[1|2]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - summary[[2]]$fns$average %>% expect_type("list") - summary[[2]]$fns$total %>% expect_type("list") - summary[[2]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1|2]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1|2]]$formatter_options` are both lists - summary[[1]]$formatter_options %>% expect_type("list") - summary[[2]]$formatter_options %>% expect_type("list") + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") + expect_type(summary[[2]]$fns$average, "list") + expect_type(summary[[2]]$fns$total, "list") + expect_type(summary[[2]]$fns$`std dev`, "list") # Expect that `summary[[1|2]]$formatter_options` are both of length 0 - summary[[1]]$formatter_options %>% expect_length(0) - summary[[2]]$formatter_options %>% expect_length(0) + expect_length(summary[[1]]$formatter_options, 0) + expect_length(summary[[2]]$formatter_options, 0) # Create a table with group-wise summaries and a grand summary; all # summary rows represent the mean, sum, and standard deviation of @@ -551,76 +354,34 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { # Expect that the internal `summary` list # object has a length of `2` since there # were two calls of `summary_rows()` - summary %>% expect_length(2) - - # For the two list components in `summary`, expect specific - # names within them - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) - - summary[[2]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) + expect_summary(summary, length = 2, type = c("summary", "grand_summary")) # Expect that `summary[[1]]$groups` is a character vector - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) - - # Expect that `summary[[2]]$groups` is a character vector - summary[[2]]$groups %>% expect_equal(":GRAND_SUMMARY:") + expect_equal(summary[[1]]$groups, c("W02", "W03")) # Expect that `summary[[1|2]]$columns` has specific values - summary[[1]]$columns %>% expect_equal(c("open", "high", "low", "close")) - summary[[2]]$columns %>% expect_equal(c("open", "high", "low", "close")) - - # Expect that `summary[[1|2]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") - summary[[2]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) + expect_equal(summary[[2]]$columns, c("open", "high", "low", "close")) # Expect that the functions used in each call are the same expect_identical(summary[[1]]$fns, summary[[1]]$fns) # Expect that the components of `summary[[1|2]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - summary[[2]]$fns$average %>% expect_type("list") - summary[[2]]$fns$total %>% expect_type("list") - summary[[2]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1|2]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1|2]]$formatter` are both NULL - expect_null(summary[[1]]$formatter) - expect_null(summary[[2]]$formatter) - - # Expect that `summary[[1|2]]$formatter_options` are both lists - summary[[1]]$formatter_options %>% expect_type("list") - summary[[2]]$formatter_options %>% expect_type("list") + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") + expect_type(summary[[2]]$fns$average, "list") + expect_type(summary[[2]]$fns$total, "list") + expect_type(summary[[2]]$fns$`std dev`, "list") - # Expect that `summary[[1|2]]$formatter_options` are both of length 0 - summary[[1]]$formatter_options %>% expect_length(0) - summary[[2]]$formatter_options %>% expect_length(0) }) test_that("Using `groups = FALSE` in `summary_rows()` returns data unchanged", { # Expect that using `groups = FALSE` with `summary_rows()` # creates no summary rows - expect_equal( - tbl %>% - as_raw_html() %>% - gsub("id=\"[a-z]*?\"", "", .), + expect_equal_gt( + tbl, tbl %>% summary_rows( groups = FALSE, @@ -630,9 +391,9 @@ test_that("Using `groups = FALSE` in `summary_rows()` returns data unchanged", { total = ~ sum(., na.rm = TRUE), `std dev` = ~ sd(., na.rm = TRUE) ) - ) %>% - as_raw_html() %>% - gsub("id=\"[a-z]*?\"", "", .) + ), + f = as_raw_html, + ignore_id = TRUE ) }) @@ -680,10 +441,7 @@ test_that("Using `groups = NULL` in `summary_rows()` is a deprecated option", { ) ) - expect_equal( - summary_tbl_1 %>% render_as_html(), - summary_tbl_2 %>% render_as_html() - ) + expect_equal_gt(summary_tbl_1, summary_tbl_2) }) test_that("Summary rows can be added to the top of any group", { @@ -882,10 +640,7 @@ test_that("The ordering of groups shouldn't affect group/grand summary calcs", { expect_equal(c("3", "20", "99")) # Expect the HTML output tables of `gt_tbl_1` and `gt_tbl_1b` to be the same - expect_identical( - gt_tbl_1 %>% render_as_html(), - gt_tbl_1b %>% render_as_html() - ) + expect_equal_gt(gt_tbl_1, gt_tbl_1b) # Expect the correct values in summary rows of `gt_tbl_2` gt_tbl_2 %>% render_as_html() %>% xml2::read_html() %>% @@ -926,10 +681,7 @@ test_that("The ordering of groups shouldn't affect group/grand summary calcs", { expect_equal(c("122")) # Expect the HTML output tables of `gt_tbl_gs` and `gt_tbl_1b_gs` to be the same - expect_identical( - gt_tbl_1_gs %>% render_as_html(), - gt_tbl_1b_gs %>% render_as_html() - ) + expect_equal_gt(gt_tbl_1_gs, gt_tbl_1b_gs) # Expect the correct value in the grand summary row of `gt_tbl_2_gs` gt_tbl_2_gs %>% render_as_html() %>% xml2::read_html() %>% @@ -1089,23 +841,10 @@ test_that("Summary rows can be created when there is no stub", { # Expect that the grand summary row labels are # available in the rendered output table - expect_match( - gt_tbl %>% - as_raw_html(inline_css = FALSE), - "" - ) - - expect_match( - gt_tbl %>% - as_raw_html(inline_css = FALSE), - "" - ) - - expect_match( - gt_tbl %>% - as_raw_html(inline_css = FALSE), - "" - ) + raw_gt <- as_raw_html(gt_tbl, inline_css = FALSE) + expect_match(raw_gt, "") + expect_match(raw_gt, "") + expect_match(raw_gt, "") }) test_that("Summary row labels are added in narrow and wide tables", { @@ -1273,15 +1012,8 @@ test_that("Multiple ways of expressing formatting work equivalently", { fmt = ~ fmt_number(., decimals = 3) ) - expect_equal( - gt_tbl_1 %>% render_as_html(), - gt_tbl_2 %>% render_as_html() - ) - - expect_equal( - gt_tbl_2 %>% render_as_html(), - gt_tbl_3 %>% render_as_html() - ) + expect_equal_gt(gt_tbl_1, gt_tbl_2) + expect_equal_gt(gt_tbl_2, gt_tbl_3) }) test_that("Labels can be intrepreted from Markdown using `md()`", { @@ -1451,12 +1183,12 @@ test_that("Groups can be formatted selectively with a formatting group directive summary_tbl_3 %>% as_rtf() %>% expect_snapshot() # Equality checks of summary_tbl_[3-9] - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_4 %>% render_as_html()) - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_5 %>% render_as_html()) - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_6 %>% render_as_html()) - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_7 %>% render_as_html()) - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_8 %>% render_as_html()) - expect_equal(summary_tbl_3 %>% render_as_html(), summary_tbl_9 %>% render_as_html()) + expect_equal_gt(summary_tbl_3, summary_tbl_4) + expect_equal_gt(summary_tbl_3, summary_tbl_5) + expect_equal_gt(summary_tbl_3, summary_tbl_6) + expect_equal_gt(summary_tbl_3, summary_tbl_7) + expect_equal_gt(summary_tbl_3, summary_tbl_8) + expect_equal_gt(summary_tbl_3, summary_tbl_9) # These summary tables should all be the same (using different ways to # express the same formatting for grand summary rows); importantly, any @@ -1512,9 +1244,9 @@ test_that("Groups can be formatted selectively with a formatting group directive summary_tbl_10 %>% as_rtf() %>% expect_snapshot() # Equality checks of summary_tbl_[10-13] - expect_equal(summary_tbl_10 %>% render_as_html(), summary_tbl_11 %>% render_as_html()) - expect_equal(summary_tbl_10 %>% render_as_html(), summary_tbl_12 %>% render_as_html()) - expect_equal(summary_tbl_10 %>% render_as_html(), summary_tbl_13 %>% render_as_html()) + expect_equal_gt(summary_tbl_10, summary_tbl_11) + expect_equal_gt(summary_tbl_10, summary_tbl_12) + expect_equal_gt(summary_tbl_10, summary_tbl_13) }) test_that("Formatting can be performed on summary cells in certain columns and rows", { @@ -1675,10 +1407,7 @@ test_that("Formatting can be performed on summary cells in certain columns and r ) ) - expect_equal( - summary_tbl_5 %>% render_as_html(), - summary_tbl_8 %>% render_as_html() - ) + expect_equal_gt(summary_tbl_5, summary_tbl_8) # Perform formatting at two columns of both groups summary_tbl_9 <- @@ -1721,14 +1450,8 @@ test_that("Formatting can be performed on summary cells in certain columns and r ) ) - expect_equal( - summary_tbl_9 %>% render_as_html(), - summary_tbl_10 %>% render_as_html() - ) - expect_equal( - summary_tbl_9 %>% render_as_html(), - summary_tbl_11 %>% render_as_html() - ) + expect_equal_gt(summary_tbl_9, summary_tbl_10) + expect_equal_gt(summary_tbl_9, summary_tbl_11) }) test_that("Extracting a summary from a gt table is possible", { @@ -1923,64 +1646,32 @@ test_that("Creating summary rows works for hidden columns", { # Expect that the internal `summary` list # object has a length of `1` since there was # only one call of `summary_rows()` - expect_length(summary, 1) - - # For the single list component in `summary`, expect specific - # names within it - summary[[1]] %>% - expect_named( - c( - "groups", "columns", "fns", "fmt", "side", - "missing_text", "formatter", "formatter_options" - ) - ) + expect_summary(summary, length = 1, type = "summary") # Expect the `groups` provided in `summary[[1]]$groups` - summary[[1]]$groups %>% expect_equal("W02") + expect_equal(summary[[1]]$groups, "W02") # Expect the `columns` provided in `summary[[1]]$columns` - summary[[1]]$columns %>% expect_equal(c("open", "high", "low", "close")) - - # Expect that `summary[[1]]$fns` is a `list` object - summary[[1]]$fns %>% expect_type("list") + expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) # Expect that the components of `summary[[1]]$fns` are lists - summary[[1]]$fns$average %>% expect_type("list") - summary[[1]]$fns$total %>% expect_type("list") - summary[[1]]$fns$`std dev` %>% expect_type("list") - - # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - # Expect that `summary[[1]]$formatter` is a NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - summary[[1]]$formatter_options %>% expect_type("list") - - # Expect that `summary[[1]]$formatter_options` is - # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Extract the summary from `gt_tbl` and obtain the # tibble containing the summary for the `W02` group - summary_extract <- gt::extract_summary(gt_tbl) + summary_extract <- extract_summary(gt_tbl) summary_w02 <- summary_extract$summary_df_data_list$W02 # Expect that all columns are present in `summary_w02` - expect_equal( - colnames(summary_w02), - c( - "group_id", "row_id", "rowname", "date", "open", "high", - "low", "close", "week" - ) - ) + expect_named(summary_w02, c("group_id", "row_id", "rowname", "date", "open", "high", "low", "close", "week")) # Expect non-NA values in all columns that had summaries computed - expect_true(!anyNA(summary_w02$open)) - expect_true(!anyNA(summary_w02$high)) - expect_true(!anyNA(summary_w02$low)) - expect_true(!anyNA(summary_w02$close)) + expect_false(anyNA(summary_w02$open)) + expect_false(anyNA(summary_w02$high)) + expect_false(anyNA(summary_w02$low)) + expect_false(anyNA(summary_w02$close)) # TODO: test gt table for values and expect that # when `cols_unhide()`ing 'open' and 'low' their summary diff --git a/tests/testthat/test-tab_footnote.R b/tests/testthat/test-tab_footnote.R index 5719f5365e..e61c4f51f4 100644 --- a/tests/testthat/test-tab_footnote.R +++ b/tests/testthat/test-tab_footnote.R @@ -757,16 +757,9 @@ test_that("Footnotes with no location are rendered correctly", { # Expect that `gt_footnotes_2` and `gt_footnotes_3` should be rendered the # same across the supported formats - expect_equal( - gt_footnotes_2 %>% render_as_html(), gt_footnotes_3 %>% render_as_html() - ) - expect_equal( - gt_footnotes_2 %>% as_latex() %>% as.character(), - gt_footnotes_3 %>% as_latex() %>% as.character() - ) - expect_equal( - gt_footnotes_2 %>% as_rtf(), gt_footnotes_3 %>% as_rtf() - ) + expect_equal_gt(gt_footnotes_2, gt_footnotes_3, f = render_as_html) + expect_equal_gt(gt_footnotes_2, gt_footnotes_3, f = as_latex) + expect_equal_gt(gt_footnotes_2, gt_footnotes_3, f = as_rtf) gt_footnotes_4 <- gt_tbl %>% diff --git a/tests/testthat/test-tab_options.R b/tests/testthat/test-tab_options.R index b7e32f3a71..7aaaf7c1d0 100644 --- a/tests/testthat/test-tab_options.R +++ b/tests/testthat/test-tab_options.R @@ -1431,7 +1431,7 @@ test_that("The internal `opts_df` table can be correctly modified", { test_that("The `opts_df` getter/setter functions properly", { # Obtain a local copy of the internal `_options` table - dt_options_get(data = data) %>% expect_s3_class("tbl_df") + expect_s3_class(dt_options_get(data = data), "tbl_df") # Get a value dt_options_get_value(data = data, option = "footnotes_font_size") %>% @@ -1460,7 +1460,8 @@ test_that("All column labels can be entirely hidden from view", { render_as_html() %>% xml2::read_html() %>% selection_text("[class='gt_col_heading gt_right']"), - 0) + 0 + ) # Expect that not hiding the column labels yields a length # four vector when using the same search @@ -1471,7 +1472,8 @@ test_that("All column labels can be entirely hidden from view", { render_as_html() %>% xml2::read_html() %>% selection_text("[class='gt_col_heading gt_columns_bottom_border gt_right']"), - 4) + 4 + ) }) test_that("The row striping options work correctly", { @@ -1486,7 +1488,8 @@ test_that("The row striping options work correctly", { render_as_html() %>% xml2::read_html() %>% selection_text("[class='gt_row gt_left gt_stub gt_striped']"), - 0) + 0 + ) # TODO: determine why this doesn't work as expected @@ -1512,7 +1515,8 @@ test_that("The row striping options work correctly", { render_as_html() %>% xml2::read_html() %>% selection_text("[class='gt_row gt_right gt_striped']"), - 25) + 25 + ) # Expect that the options `row.striping.include_table_body = TRUE` # and `row.striping.include_stub = TRUE` will result in cells that diff --git a/tests/testthat/test-tab_remove.R b/tests/testthat/test-tab_remove.R index 80ec16b735..03b3c2f98c 100644 --- a/tests/testthat/test-tab_remove.R +++ b/tests/testthat/test-tab_remove.R @@ -17,22 +17,20 @@ test_that("A table header can be removed using `rm_header()`", { # Expect that removing a header creates a table no different than # one never having a header in the table object - expect_equal( + expect_equal_gt( exibble %>% gt() %>% tab_header(title = "test title", subtitle = "test subtitle") %>% - rm_header() %>% - render_as_html(), + rm_header(), exibble %>% - gt() %>% - render_as_html() + gt() ) # Expect that removing a non-existent header isn't different that # never having one in the table object - expect_equal( - exibble %>% gt() %>% render_as_html(), - exibble %>% gt() %>% rm_header() %>% render_as_html() + expect_equal_gt( + exibble %>% gt(), + exibble %>% gt() %>% rm_header() ) # If there isn't a header in the input table the function should @@ -75,9 +73,9 @@ test_that("Stubhead labels can be removed using `rm_stubhead()`", { # Expect that removing a non-existent stubhead label isn't different that # never having one in the table object - expect_equal( - exibble %>% gt(rowname_col = "row") %>% render_as_html(), - exibble %>% gt(rowname_col = "row") %>% rm_stubhead() %>% render_as_html() + expect_equal_gt( + exibble %>% gt(rowname_col = "row"), + exibble %>% gt(rowname_col = "row") %>% rm_stubhead() ) # If there isn't a stubhead label or even a stub in the input table diff --git a/tests/testthat/test-tab_spanner_delim.R b/tests/testthat/test-tab_spanner_delim.R index 69b6c22f1c..0bdfadfc9a 100644 --- a/tests/testthat/test-tab_spanner_delim.R +++ b/tests/testthat/test-tab_spanner_delim.R @@ -55,10 +55,7 @@ test_that("tab_spanner_delim() works correctly", { tab_spanner_delim(delim = ".", split = "first") # Expect the same table as with the `split = "last"` (default) option - expect_equal( - tbl_html_first %>% render_as_html(), - tbl_html %>% render_as_html() - ) + expect_equal_gt(tbl_html_first, tbl_html) # Create a `tbl_html` object with `gt()`; split the column # names into spanner headings and column labels but constrain @@ -936,10 +933,7 @@ test_that("tab_spanner_delim() works on higher-order spanning", { # Take snapshots of `gt_tbl_spanner_A_1` gt_tbl_spanner_A_2 %>% render_as_html() %>% expect_snapshot() - expect_equal( - gt_tbl_spanner_A_1 %>% render_as_html(), - gt_tbl_spanner_A_2 %>% render_as_html() - ) + expect_equal_gt(gt_tbl_spanner_A_1, gt_tbl_spanner_A_2) # # Highly specific placements of spanners @@ -1150,18 +1144,9 @@ test_that("tab_spanner_delim() works on higher-order spanning", { gt_tbl_7a %>% render_as_html() %>% expect_snapshot() # Expect all tables to be the same - expect_equal( - gt_tbl_7a %>% render_as_html(), - gt_tbl_7b %>% render_as_html() - ) - expect_equal( - gt_tbl_7a %>% render_as_html(), - gt_tbl_7c %>% render_as_html() - ) - expect_equal( - gt_tbl_7a %>% render_as_html(), - gt_tbl_7d %>% render_as_html() - ) + expect_equal_gt(gt_tbl_7a, gt_tbl_7b) + expect_equal_gt(gt_tbl_7a, gt_tbl_7c) + expect_equal_gt(gt_tbl_7a, gt_tbl_7d) tbl_8 <- @@ -1193,18 +1178,9 @@ test_that("tab_spanner_delim() works on higher-order spanning", { gt_tbl_8a %>% render_as_html() %>% expect_snapshot() # Expect all tables to be the same - expect_equal( - gt_tbl_8a %>% render_as_html(), - gt_tbl_8b %>% render_as_html() - ) - expect_equal( - gt_tbl_8a %>% render_as_html(), - gt_tbl_8c %>% render_as_html() - ) - expect_equal( - gt_tbl_8a %>% render_as_html(), - gt_tbl_8d %>% render_as_html() - ) + expect_equal_gt(gt_tbl_8a, gt_tbl_8b) + expect_equal_gt(gt_tbl_8a, gt_tbl_8b) + expect_equal_gt(gt_tbl_8a, gt_tbl_8d) tbl_9 <- @@ -1236,18 +1212,9 @@ test_that("tab_spanner_delim() works on higher-order spanning", { gt_tbl_9a %>% render_as_html() %>% expect_snapshot() # Expect all tables to be the same - expect_equal( - gt_tbl_9a %>% render_as_html(), - gt_tbl_9b %>% render_as_html() - ) - expect_equal( - gt_tbl_9a %>% render_as_html(), - gt_tbl_9c %>% render_as_html() - ) - expect_equal( - gt_tbl_9a %>% render_as_html(), - gt_tbl_9d %>% render_as_html() - ) + expect_equal_gt(gt_tbl_9a, gt_tbl_9b) + expect_equal_gt(gt_tbl_9a, gt_tbl_9c) + expect_equal_gt(gt_tbl_9a, gt_tbl_9d) }) test_that("tab_spanner_delim() works with complex splits", { @@ -1357,10 +1324,7 @@ test_that("tab_spanner_delim() won't overwrite any set column labels", { tab_spanner_delim(".") %>% cols_label(Sepal.Width = md("Sepal.*W*idth")) - expect_equal( - tbl_1 %>% render_as_html(), - tbl_2 %>% render_as_html() - ) + expect_equal_gt(tbl_1, tbl_2) tbl_3 <- iris_short %>% @@ -1374,10 +1338,7 @@ test_that("tab_spanner_delim() won't overwrite any set column labels", { tab_spanner_delim(".") %>% cols_label(Sepal.Width = html("Sepal.Width")) - expect_equal( - tbl_3 %>% render_as_html(), - tbl_4 %>% render_as_html() - ) + expect_equal_gt(tbl_3, tbl_4) data_tbl <- dplyr::tibble( @@ -1398,10 +1359,7 @@ test_that("tab_spanner_delim() won't overwrite any set column labels", { tab_spanner_delim(delim = ".", reverse = TRUE) %>% cols_label(A.B.C.D.E = "ABCDE") - expect_equal( - gt_tbl_reverse_1 %>% render_as_html(), - gt_tbl_reverse_2 %>% render_as_html() - ) + expect_equal_gt(gt_tbl_reverse_1, gt_tbl_reverse_2) gt_tbl_last_1 <- gt(data_tbl) %>% @@ -1413,10 +1371,7 @@ test_that("tab_spanner_delim() won't overwrite any set column labels", { tab_spanner_delim(delim = ".", split = "last") %>% cols_label(A.B.C.D.E = "ABCDE") - expect_equal( - gt_tbl_last_1 %>% render_as_html(), - gt_tbl_last_2 %>% render_as_html() - ) + expect_equal_gt(gt_tbl_last_1, gt_tbl_last_2) }) test_that("tab_spanner_delim() resolves duplicate spanner IDs (#1821)", { diff --git a/tests/testthat/test-tab_stub_indent.R b/tests/testthat/test-tab_stub_indent.R index 71d6e6f88e..f26fac5da2 100644 --- a/tests/testthat/test-tab_stub_indent.R +++ b/tests/testthat/test-tab_stub_indent.R @@ -30,14 +30,8 @@ test_that("A gt table can contain indentation in the stub", { tab_options(latex.use_longtable = TRUE) # Expect that `tbl_2` and `tbl_3` are the same - expect_equal( - tbl_2 %>% render_as_html(), - tbl_3 %>% render_as_html() - ) - expect_equal( - tbl_2 %>% as_latex() %>% as.character(), - tbl_3 %>% as_latex() %>% as.character() - ) + expect_equal_gt(tbl_2, tbl_3, f = render_as_html) + expect_equal_gt(tbl_2, tbl_3, f = as_latex) # Indent the three row labels by a level and then decrease by # the same amount; should be the same as no indentation at all @@ -48,9 +42,9 @@ test_that("A gt table can contain indentation in the stub", { tab_stub_indent(rows = c(1, 2, 3), indent = "decrease") %>% tab_options(latex.use_longtable = TRUE) - expect_equal( - tbl_4 %>% render_as_html(), - exibble %>% gt(rowname_col = "row") %>% render_as_html() + expect_equal_gt( + tbl_4, + gt(exibble, rowname_col = "row") ) # Indent using a `matches()` expression; this matches rows diff --git a/tests/testthat/test-tab_style.R b/tests/testthat/test-tab_style.R index b9d08d177c..23e1d1b56c 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -414,41 +414,41 @@ test_that("tab_style() works with a single cell", { test_that("Using fonts in `cell_text()` works", { # Prepare a small gt table for all tests - tbl <- exibble %>% dplyr::select(char, time) %>% gt() + tbl <- gt(dplyr::select(exibble, char, time)) # Expect that system fonts can be combined with default fonts # and set at a specific location - tbl %>% + expect_match_raw_html( tab_style( + tbl, style = cell_text(font = c("Comic Sans MS", "Menlo", default_fonts())), locations = cells_body(columns = time, rows = 1) - ) %>% - as_raw_html() %>% - expect_match( - "" - ) + ), + "" + ) # Expect that a Google Fonts and system fonts can be combined # (using a list or `c()`) with default fonts and set at a specific location - tbl %>% + expect_match_raw_html( tab_style( + tbl, style = cell_text(font = c(google_font(name = "Dancing Script"), default_fonts())), locations = cells_body(columns = time, rows = 1) - ) %>% - as_raw_html() %>% - expect_match( - "" - ) + ), + "" + ) - tbl %>% + expect_match_raw_html( tab_style( + tbl, style = cell_text(font = list(google_font(name = "Dancing Script"), default_fonts())), locations = cells_body(columns = time, rows = 1) - ) %>% - as_raw_html() %>% - expect_match( - "" - ) + ), + "" + ) +}) + +test_that("tab_style() works with different locations.", { gtcars_tbl <- gtcars %>% @@ -457,103 +457,74 @@ test_that("Using fonts in `cell_text()` works", { gt() # Expect no difference in output when using styles within a list or without - expect_equal( - gtcars_tbl %>% - tab_style( - style = - cell_text( - weight = "bold", - font = c("Helvetica", "Times New Roman"), - color = "red" - ), - locations = cells_body(columns = hp, rows = 1:2) - ) %>% - as_raw_html() %>% - gsub("id=\"[a-z]*?\"", "", .), - gtcars_tbl %>% - tab_style( - style = - list( - cell_text( - weight = "bold", - font = c("Helvetica", "Times New Roman"), - color = "red" - ) - ), - locations = cells_body(columns = hp, rows = 1:2) - ) %>% - as_raw_html() %>% - gsub("id=\"[a-z]*?\"", "", .) - ) + hp_styling <- cell_text(weight = "bold", font = c("Helvetica", "Times New Roman"), color = "red") + hp_location <- cells_body(columns = hp, rows = 1:2) + + gt_tbl1 <- tab_style(gtcars_tbl, style = hp_styling, locations = hp_location) + gt_tbl2 <- tab_style(gtcars_tbl, style = list(hp_styling), locations = hp_location) + + expect_equal_gt(gt_tbl1, gt_tbl2, f = as_raw_html, ignore_id = TRUE) # Don't expect any errors when styling with different fonts expect_no_error( - gtcars_tbl %>% - tab_style( - style = list(cell_text(font = c("Helvetica", "serif")), "font-size: 14px;"), - locations = cells_body(columns = hp) - ) - ) - expect_no_error( - gtcars_tbl %>% - tab_style( - style = list("font-size: 14px;", cell_text(font = c("Helvetica", "serif"))), - locations = cells_body(columns = hp) - ) + tab_style( + gtcars_tbl, + style = list(cell_text(font = c("Helvetica", "serif")), "font-size: 14px;"), + locations = cells_body(columns = hp) + ) ) expect_no_error( - gtcars_tbl %>% - tab_style( - style = list(cell_text(font = c("Helvetica", "serif")), cell_borders()), - locations = cells_body(columns = hp) - ) + tab_style( + gtcars_tbl, + style = list("font-size: 14px;", cell_text(font = c("Helvetica", "serif"))), + locations = cells_body(columns = hp) + ) ) expect_no_error( - gtcars_tbl %>% - tab_style( - style = list(cell_borders(), cell_text(font = c("Helvetica", "serif"))), - locations = cells_body(columns = hp) - ) + tab_style( + gtcars_tbl, + style = list(cell_text(font = c("Helvetica", "serif")), cell_borders()), + locations = cells_body(columns = hp) + ) ) expect_no_error( - gtcars_tbl %>% - tab_style( - style = list( - cell_borders(sides = "b", color = "blue", weight = px(3)), - cell_text(size = px(18), font = c("Helvetica", "serif"), weight = "bold"), - cell_fill(color = "red", alpha = 0.5) - ), - locations = cells_body(columns = hp) - ) + tab_style( + gtcars_tbl, + style = list(cell_borders(), cell_text(font = c("Helvetica", "serif"))), + locations = cells_body(columns = hp) + ) ) expect_no_error( - gtcars_tbl %>% - tab_style( - style = cell_text(font = c("Times New Roman", "serif")), - locations = cells_body(columns = hp) - ) + tab_style( + gtcars_tbl, + style = list( + cell_borders(sides = "b", color = "blue", weight = px(3)), + cell_text(size = px(18), font = c("Helvetica", "serif"), weight = "bold"), + cell_fill(color = "red", alpha = 0.5) + ), + locations = cells_body(columns = hp) + ) ) }) test_that("Setting white-space options in `cell_text()` works", { tbl_ws <- - dplyr::tibble( - ws = c(" space ", " space", "space ", " a b c d e f") - ) %>% - gt() + gt(data.frame( + ws = c(" space ", " space", "space ", " a b c d e f"), + stringsAsFactors = FALSE + )) # Expect that the white space `"pre"` style option will be present # when using `tab_style(style = cell_text(whitespace = "pre"), ... )` - tbl_ws %>% + expect_match_raw_html( tab_style( + tbl_ws, style = cell_text(whitespace = "pre"), locations = cells_body() - ) %>% - as_raw_html() %>% - expect_match( - "" - ) + ), + "" + ) }) test_that("Hiding columns that have styles does not result in errors/warnings", { diff --git a/tests/testthat/test-table_parts.R b/tests/testthat/test-table_parts.R index 3e12e6fc7f..fbb096c319 100644 --- a/tests/testthat/test-table_parts.R +++ b/tests/testthat/test-table_parts.R @@ -313,12 +313,9 @@ test_that("tab_row_group() gives the correct output", { # When specifying a row group that captures no rows, expect that # the rendered table is essentially unaffected by this function call - expect_equal( - gt(exibble, rowname_col = "row") %>% - tab_row_group(label = "group", rows = FALSE) %>% - render_as_html(), - gt(exibble, rowname_col = "row") %>% - render_as_html() + expect_equal_gt( + gt(exibble, rowname_col = "row") %>% tab_row_group(label = "group", rows = FALSE), + gt(exibble, rowname_col = "row") ) }) diff --git a/tests/testthat/test-text_transform.R b/tests/testthat/test-text_transform.R index 90909ee853..e314364381 100644 --- a/tests/testthat/test-text_transform.R +++ b/tests/testthat/test-text_transform.R @@ -125,25 +125,23 @@ test_that("text_transform() works correctly", { transforms <- dt_transforms_get(data = tbl_html) # Expect two components to be held within `transforms` - transforms %>% expect_length(2) + expect_length(transforms, 2) # Expect that each component of `transforms` has the names # `resolved` and `fn` - transforms[[1]] %>% expect_named(c("resolved", "fn")) - transforms[[2]] %>% expect_named(c("resolved", "fn")) + expect_named(transforms[[1]] , c("resolved", "fn")) + expect_named(transforms[[2]] , c("resolved", "fn")) # Expect that `resolved` subcomponent of `transforms` has the names # `columns` and `rows` - transforms[[1]]$resolved %>% expect_named(c("columns", "rows", "colnames")) - transforms[[2]]$resolved %>% expect_named(c("columns", "rows", "colnames")) + expect_named(transforms[[1]]$resolved, c("columns", "rows", "colnames")) + expect_named(transforms[[2]]$resolved, c("columns", "rows", "colnames")) # Expect that `resolved` subcomponent of `transforms` has the class # names and `resolved`, `cells_body`, `location_cells` - transforms[[1]]$resolved %>% - expect_s3_class(c("resolved", "cells_body", "location_cells")) - - transforms[[2]]$resolved %>% - expect_s3_class(c("resolved", "cells_body", "location_cells")) + resolved_class <- c("resolved", "cells_body", "location_cells") + expect_s3_class(transforms[[1]]$resolved, resolved_class) + expect_s3_class(transforms[[2]]$resolved, resolved_class) # Expect that `fn` subcomponent of `transforms` is a function expect_true(is.function(transforms[[1]]$fn)) @@ -334,20 +332,14 @@ test_that("text_case_match() works on the tab_spanner()", { .replace = "partial", .locations = cells_column_spanners() )) - expect_match_html( - new_tb, - "awesome spanner" - ) + expect_match_html(new_tb, "awesome spanner") expect_no_error(new_tb2 <- gt_tbl %>% text_case_match( "the boring spanner" ~ "awesome spanner2", .replace = "all", .locations = cells_column_spanners() )) - expect_match_html( - new_tb2, - "awesome spanner" - ) + expect_match_html(new_tb2, "awesome spanner2") }) test_that("text_transform() works on row group labels", { @@ -463,10 +455,7 @@ test_that("text_case_when() + text_case_match() work", { text_case_match(NA ~ "---") ) # they are not changing numeric NA - expect_equal( - render_as_html(cw), - render_as_html(cm) - ) + expect_equal_gt(cw, cm) }) test_that("text_replace() works", { @@ -475,8 +464,5 @@ test_that("text_replace() works", { gt() %>% text_replace("NA", "---") ) - expect_match_html( - tr, - "---" - ) + expect_match_html(tr, "---") }) diff --git a/tests/testthat/test-util_functions.R b/tests/testthat/test-util_functions.R index 84d74f7639..9794587bc4 100644 --- a/tests/testthat/test-util_functions.R +++ b/tests/testthat/test-util_functions.R @@ -267,10 +267,14 @@ test_that("process_text() works correctly", { # Create the `md_text` variable, which is markdown text # with the class `from_markdown` (via the `md()` helper) md_text <- md("this is *text* interpreted as **markdown**") + expect_s3_class(md_text, "from_markdown") + expect_type(md_text, "character") # Create the `html_text` variable, which is HTML text with # the classes `html`/`character` (via the `html()` helper) html_text <- html("this is text that's HTML") + expect_s3_class(html_text, "html") + expect_type(html_text, "character") # Expect that text with the class `character` will # be returned from `process_text` as is @@ -281,21 +285,17 @@ test_that("process_text() works correctly", { # Expect that text with the class `from_markdown` will # be returned from `process_text` as character-based # text that's been transformed to HTML - process_text(text = md_text) %>% - expect_equal("this is text interpreted as markdown") - expect_s3_class(md_text, "from_markdown") - process_text(text = md_text) %>% expect_type("character") + processed_md <- process_text(text = md_text) + expect_type(processed_md, "character") + expect_equal(processed_md, "this is text interpreted as markdown") # Expect that text with the class `html` will # be returned from `process_text` as character-based # text that's been transformed to HTML - process_text(text = html_text) %>% - expect_equal(as.character(html_text)) - - expect_s3_class(html_text, "html") - expect_type(html_text, "character") - process_text(text = html_text) %>% expect_type("character") + processed_html <- process_text(text = html_text) + expect_type(processed_html, "character") + expect_equal(processed_html, html_text, ignore_attr = TRUE) }) test_that("apply_pattern_fmt_x() works correctly", { @@ -336,12 +336,12 @@ test_that("remove_html() works correctly", { # Expect that the `character` text object has had the # HTML tags removed - remove_html(html_text_1) %>% - expect_equal("this is text that's HTML") + html_text_1_removed <- remove_html(html_text_1) + expect_equal(html_text_1_removed, "this is text that's HTML") # Expect that the `character` text object retains the # `character` class after transformation - remove_html(html_text_1) %>% expect_type("character") + expect_type(html_text_1_removed, "character") # Call `remove_html()` on HTML text that's # classed as `html` and `character` @@ -349,8 +349,8 @@ test_that("remove_html() works correctly", { # Expect that the new object retains the html` and # `character` classes - html_text_2_removed %>% expect_s3_class("html") - html_text_2_removed %>% expect_type("character") + expect_s3_class(html_text_2_removed, "html") + expect_type(html_text_2_removed, "character") # Expect that the HTML tags have been removed from the # `html_text_2` string @@ -368,28 +368,27 @@ test_that("as_locations() works correctly", { ) # Expect certain structural features for a `locations` object - locations %>% expect_length(2) - locations[[1]] %>% expect_length(2) - locations[[1]] %>% expect_s3_class(c("quosure", "formula")) - locations[[2]] %>% expect_s3_class(c("quosure", "formula")) + expect_length(locations, 2) + # Each location has length 2 + expect_length(locations[[1]], 2) + expect_length(locations[[2]], 2) + expect_s3_class(locations[[1]], c("quosure", "formula")) + expect_s3_class(locations[[2]], c("quosure", "formula")) # Upgrade `locations` to a list of locations locations_list <- as_locations(locations) # Expect certain structural features for this `locations_list` object - locations_list %>% expect_length(1) - locations_list[[1]] %>% expect_length(2) - locations_list[[1]] %>% expect_s3_class(c("cells_body", "location_cells")) + expect_length(locations_list, 1) + expect_length(locations_list[[1]], 2) + expect_s3_class(locations_list[[1]], c("cells_body", "location_cells")) # Define locations as a named vector locations <- - c( - columns = "hp", - rows = c("Datsun 710", "Valiant")) + c(columns = "hp", rows = c("Datsun 710", "Valiant")) # Expect an error with `locations` object structured in this way - expect_error( - as_locations(locations)) + expect_error(as_locations(locations)) }) test_that("process_footnote_marks() works correctly", { @@ -448,7 +447,7 @@ test_that("glue_gt() works in a safe manner", { # Basically works expect_identical( - glue_gt(lst, "{a}/{b}") %>% as.character(), + as.character(glue_gt(lst, "{a}/{b}")), c("foo/bar", "foo/baz") ) expect_identical( @@ -456,7 +455,7 @@ test_that("glue_gt() works in a safe manner", { c("foo/bar", "foo/baz") ) expect_identical( - glue_gt(dplyr::as_tibble(lst), "{a}/{b}") %>% as.character(), + as.character(glue_gt(dplyr::as_tibble(lst), "{a}/{b}")), c("foo/bar", "foo/baz") ) @@ -523,16 +522,15 @@ test_that("check_spanner_id_unique() works properly", { ) }) -test_that("get_file_ext() works correctly", { +test_that("get_file_ext() returns the correct file extension", { - # Expect that filenames with various extensions are - # work with `get_file_ext()` to return the file extension - get_file_ext(file = "file.svg") %>% expect_equal("svg") - get_file_ext(file = "file.001.svg") %>% expect_equal("svg") - get_file_ext(file = "file.001..svg") %>% expect_equal("svg") - get_file_ext(file = "_file.jpg") %>% expect_equal("jpg") - get_file_ext(file = "file.png") %>% expect_equal("png") - get_file_ext(file = "file.gif") %>% expect_equal("gif") + expect_equal(get_file_ext("filess.svg"), "svg") + expect_equal(get_file_ext("filess.svg"), "svg") + expect_equal(get_file_ext("fi.001.svg"), "svg") + expect_equal(get_file_ext("fi.01..svg"), "svg") + expect_equal(get_file_ext("_files.jpg"), "jpg") + expect_equal(get_file_ext("filess.png"), "png") + expect_equal(get_file_ext("filess.gif"), "gif") }) test_that("resolve_secondary_pattern() works properly", { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 9562e7f66c..0e1e5ab201 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -14,14 +14,14 @@ test_that("Various `is_*()` utility functions work properly", { expect_true(is_gt_tbl(gt_preview(gtcars))) expect_false(is_gt_tbl(exibble)) expect_false(is_gt_tbl(gt_group(gt(exibble), gt(exibble)))) - expect_false(is_gt_tbl(gt(exibble) %>% as_raw_html())) + expect_false(is_gt_tbl(as_raw_html(gt(exibble)))) # Expect that `is_gt_group()` is TRUE with a `gt_group` and FALSE in other cases expect_true(is_gt_group(gt_group(gt(exibble), gt(exibble)))) expect_false(is_gt_group(gt(exibble))) expect_false(is_gt_group(gt_preview(gtcars))) expect_false(is_gt_group(exibble)) - expect_false(is_gt_group(gt(exibble) %>% as_raw_html())) + expect_false(is_gt_group(as_raw_html(gt(exibble)))) # Expect that `is_gt_tbl_or_group()` is TRUE with a `gt_group` or a # `gt_tbl` and FALSE in other cases @@ -29,7 +29,7 @@ test_that("Various `is_*()` utility functions work properly", { expect_true(is_gt_tbl_or_group(gt(exibble))) expect_true(is_gt_tbl_or_group(gt_preview(gtcars))) expect_false(is_gt_tbl_or_group(exibble)) - expect_false(is_gt_tbl_or_group(gt(exibble) %>% as_raw_html())) + expect_false(is_gt_tbl_or_group(as_raw_html(gt(exibble)))) # Expect that a completely empty table *and* a table with rows but no # columns in a gt object yields TRUE via `is_gt_tbl_empty()` @@ -71,6 +71,8 @@ test_that("Various `is_*()` utility functions work properly", { expect_error(stop_if_not_gt_tbl_or_group(exibble)) expect_error(stop_if_not_gt_tbl_or_group(gt(exibble) %>% as_raw_html())) + skip_if_not_installed("shiny") + # Expect that `is_html()` returns TRUE only for objects with the `html` class expect_true(is_html(html("This is HTML"))) expect_true(is_html(shiny::HTML("This is HTML"))) @@ -245,15 +247,11 @@ test_that("process_footnote_marks() works properly", { ) expect_equal( process_footnote_marks(1:4, marks = c("one", "two", "three", "four")), - c( - c("one", "two", "three", "four") - ) + c("one", "two", "three", "four") ) expect_equal( process_footnote_marks(4:1, marks = c("one", "two", "three", "four")), - c( - c("four", "three", "two", "one") - ) + c("four", "three", "two", "one") ) expect_equal( process_footnote_marks(1:4, marks = 10:13), c("10", "11", "12", "13") @@ -473,3 +471,15 @@ test_that("Escaping is working when using `markdown_to_rtf()`", { md_rtf("\\b{}", "\\'5cb\\'7b\\'7d") md_rtf("<&", "<&") }) + +test_that("str_substitute() works well", { + expect_equal( + str_substitute(c("223", "223"), c(1,2), 2), + c("22", "2") + ) + expect_snapshot(error = TRUE, { + str_substitute(c("223", "223", "224"), c(1,2), 2) + str_substitute(c("223", "223", "224"), c(1), c(2, 3)) + str_substitute(c("223", "223", "224", "225"), c(1, 2, 3, 4), c(2, 3)) + }) +}) diff --git a/tests/testthat/test-utils_render_grid.R b/tests/testthat/test-utils_render_grid.R index 2b23c22339..97c85260be 100644 --- a/tests/testthat/test-utils_render_grid.R +++ b/tests/testthat/test-utils_render_grid.R @@ -10,7 +10,7 @@ has_class <- function(layout, class) { # Layout tests ------------------------------------------------------------ -test_that("create_caption_component_g creates captions", { +test_that("create_caption_component_g() creates captions", { df <- data.frame(x = 1:2, y = 3:4) @@ -27,7 +27,7 @@ test_that("create_caption_component_g creates captions", { expect_length(test$classes[[1]], 2) }) -test_that("create_heading_component_g creates headings", { +test_that("create_heading_component_g() creates headings", { df <- data.frame(x = 1:2, y = 3:4) @@ -57,7 +57,7 @@ test_that("create_heading_component_g creates headings", { expect_match(test$label, "gt_footnote_marks") }) -test_that("create_columns_component_g creates columns and spanners", { +test_that("create_columns_component_g() creates columns and spanners", { df <- data.frame(A = 1:2, B = 3:4, C = 5:6) gt <- gt(df) @@ -114,7 +114,7 @@ test_that("create_columns_component_g creates columns and spanners", { expect_snapshot(test) }) -test_that("group_headings_g creates appropriate group headings", { +test_that("group_headings_g() creates appropriate group headings", { df <- data.frame(x = 1:3, y = 4:6) @@ -151,7 +151,7 @@ test_that("group_headings_g creates appropriate group headings", { expect_null(test) }) -test_that("body_cells_g creates appropriate cells", { +test_that("body_cells_g() creates appropriate cells", { df <- data.frame(x = 1:3, y = 4:6, row = c("A", "B", "C")) @@ -196,7 +196,7 @@ test_that("body_cells_g creates appropriate cells", { ) }) -test_that("summary_rows_g creates appropriate cells for group summaries", { +test_that("summary_rows_g() creates appropriate cells for group summaries", { df <- data.frame(x = 1:3, y = 4:6) @@ -230,7 +230,7 @@ test_that("summary_rows_g creates appropriate cells for group summaries", { ) }) -test_that("summary_rows_g creates appropriate cells for grand summaries", { +test_that("summary_rows_g() creates appropriate cells for grand summaries", { df <- data.frame(x = 1:3, y = 4:6) @@ -259,7 +259,7 @@ test_that("summary_rows_g creates appropriate cells for grand summaries", { ) }) -test_that("create_body_component_g places group summaries correctly", { +test_that("create_body_component_g() places group summaries correctly", { df <- data.frame(x = 1:3, y = 4:6) @@ -293,7 +293,7 @@ test_that("create_body_component_g places group summaries correctly", { expect_equal(test$bottom[summary], rep(c(2, 6), each = 3)) }) -test_that("create_body_component_g places grand summaries correctly", { +test_that("create_body_component_g() places grand summaries correctly", { df <- data.frame(x = 1:3, y = 4:6) @@ -316,7 +316,7 @@ test_that("create_body_component_g places grand summaries correctly", { expect_equal(test$bottom[summary], rep(4, each = 3)) }) -test_that("create_source_notes_component_g creates source notes", { +test_that("create_source_notes_component_g() creates source notes", { gt <- data.frame(x = 1:3, y = 4:6) %>% gt() %>% @@ -339,7 +339,7 @@ test_that("create_source_notes_component_g creates source notes", { expect_equal(test$label, "Multi line") }) -test_that("create_footnotes_component_g creates footnotes", { +test_that("create_footnotes_component_g() creates footnotes", { gt <- data.frame(x = 1:3, y = 4:6) %>% gt() %>% @@ -536,7 +536,7 @@ test_that("Classes and styles are parsed correctly", { # Feature tests ----------------------------------------------------------- -test_that("as_gtable renders svg entries", { +test_that("as_gtable() renders svg entries", { df <- data.frame( x = 1, diff --git a/tests/testthat/test-utils_units.R b/tests/testthat/test-utils_units.R index 2799bb5909..a1f977db22 100644 --- a/tests/testthat/test-utils_units.R +++ b/tests/testthat/test-utils_units.R @@ -1,7 +1,3 @@ -generate_html_units <- function(input) { - input %>% define_units() %>% render_units(context = "html") -} - test_that("Units are rendered properly in HTML", { expect_equal(
averagetotalstd devaveragetotalstd dev13:3513:3513:3513:3513:3513:35 space space