From cfd6bd559f2c195898517a6c6e4beb61241440a8 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:26:49 -0400 Subject: [PATCH 01/19] Remove str_catalog() in favour of cli equivalent! --- R/data_color.R | 2 +- R/modify_rows.R | 2 +- R/utils_general_str_formatting.R | 42 -------------------------------- R/utils_render_rtf.R | 3 +-- 4 files changed, 3 insertions(+), 46 deletions(-) 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/utils_general_str_formatting.R b/R/utils_general_str_formatting.R index ffee017176..e9c32fc666 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) { diff --git a/R/utils_render_rtf.R b/R/utils_render_rtf.R index ab4392ce1a..b5eccbc690 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\")" )) From 052c6ef0b8d23dcb388d8cd1ca653e4b5dfdefd9 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:33:51 -0400 Subject: [PATCH 02/19] Add initial test for str_substitute() --- tests/testthat/_snaps/utils.md | 13 +++++++++++++ tests/testthat/test-utils.R | 13 +++++++++++++ 2 files changed, 26 insertions(+) create mode 100644 tests/testthat/_snaps/utils.md diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md new file mode 100644 index 0000000000..cc27c618cd --- /dev/null +++ b/tests/testthat/_snaps/utils.md @@ -0,0 +1,13 @@ +# str_substitute() works well + + Code + str_substitute(c("223", "223", "224"), c(1, 2), 2) + Condition + Error: + ! Can't recycle `start` to length 3 + Code + str_substitute(c("223", "223", "224"), c(1), c(2, 3)) + Condition + Error: + ! Can't recycle `end` to length 3 + diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 9562e7f66c..ef6d323e9c 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -473,3 +473,16 @@ 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)) + + }) +}) From 8bcb2d473c6982a8af2295be155d53401689739e Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:39:42 -0400 Subject: [PATCH 03/19] Use `vctrs::vec_recycle_common()` instead of homegrown `recycler()` --- R/utils_general_str_formatting.R | 21 ++++----------------- tests/testthat/_snaps/utils.md | 13 +++++++++---- tests/testthat/test-utils.R | 1 - 3 files changed, 13 insertions(+), 22 deletions(-) diff --git a/R/utils_general_str_formatting.R b/R/utils_general_str_formatting.R index e9c32fc666..5852e781e9 100644 --- a/R/utils_general_str_formatting.R +++ b/R/utils_general_str_formatting.R @@ -351,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) @@ -362,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) diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md index cc27c618cd..a3310b6e19 100644 --- a/tests/testthat/_snaps/utils.md +++ b/tests/testthat/_snaps/utils.md @@ -3,11 +3,16 @@ Code str_substitute(c("223", "223", "224"), c(1, 2), 2) Condition - Error: - ! Can't recycle `start` to length 3 + 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: - ! Can't recycle `end` to length 3 + 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/test-utils.R b/tests/testthat/test-utils.R index ef6d323e9c..c7e6abc9ac 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -483,6 +483,5 @@ test_that("str_substitute() works well", { 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)) - }) }) From f7f24dd457036b1f40fc4bfd25d465c9c52f5184 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:44:24 -0400 Subject: [PATCH 04/19] Inline only usage of `str_complete_replace()` + remove `str_single_replace()` (unused.) --- R/text_transform.R | 2 +- R/utils_general_str_formatting.R | 8 -------- 2 files changed, 1 insertion(+), 9 deletions(-) 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 5852e781e9..5cd039b75b 100644 --- a/R/utils_general_str_formatting.R +++ b/R/utils_general_str_formatting.R @@ -372,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) From 8528032e6829f0e227b3cde743c9d4f2d644dda1 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:56:29 -0400 Subject: [PATCH 05/19] Get rid of pipes in footnote rendering. --- R/z_utils_render_footnotes.R | 48 ++++++++++++++++++++++++++---------- 1 file changed, 35 insertions(+), 13 deletions(-) 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( From fe33c3d23174052f54c94aded06b9a04c8390287 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 10:56:54 -0400 Subject: [PATCH 06/19] Reduce pipe usage in tests --- tests/testthat/test-util_functions.R | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-util_functions.R b/tests/testthat/test-util_functions.R index 84d74f7639..5d431ecb43 100644 --- a/tests/testthat/test-util_functions.R +++ b/tests/testthat/test-util_functions.R @@ -448,7 +448,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 +456,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 +523,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", { From d61e08e4c11c92e1a8689136cc535f9b92bf78c8 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 11:07:48 -0400 Subject: [PATCH 07/19] Remove pipes --- R/utils_render_grid.R | 12 +++++++----- R/utils_render_rtf.R | 3 +-- 2 files changed, 8 insertions(+), 7 deletions(-) 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 b5eccbc690..57df8edb21 100644 --- a/R/utils_render_rtf.R +++ b/R/utils_render_rtf.R @@ -1018,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() From cb6ba99a6f4e427eee77da21e7c93b5f81dafac2 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 11:08:03 -0400 Subject: [PATCH 08/19] Move function to helper.R --- tests/testthat/helper.R | 7 +++++++ tests/testthat/test-utils_units.R | 4 ---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index ad89d46a3a..1dcd619743 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -97,6 +97,13 @@ get_row_group_text <- function(tbl_html) { ) } +generate_html_units <- function(input) { + render_units( + define_units(input), + context = "html" + ) +} + # Create a shortened version of `mtcars` mtcars_short <- datasets::mtcars[1:5, ] 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( From 44da6d59a99ed65df0446a64ae84a98f60c68530 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 11:36:35 -0400 Subject: [PATCH 09/19] Restyle tests to avoid pipe --- tests/testthat/test-tab_style.R | 68 ++++++++++++++++----------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/tests/testthat/test-tab_style.R b/tests/testthat/test-tab_style.R index b9d08d177c..adf8fdc989 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -488,50 +488,50 @@ test_that("Using fonts in `cell_text()` works", { # 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) - ) + 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("font-size: 14px;", cell_text(font = c("Helvetica", "serif"))), - 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_text(font = c("Helvetica", "serif")), cell_borders()), - 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(), cell_text(font = c("Helvetica", "serif"))), - 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 = 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(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) + ) ) 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 = cell_text(font = c("Times New Roman", "serif")), + locations = cells_body(columns = hp) + ) ) }) From 40c61c58a7d171e91d2ed1a5ae6b7d5a6c8dbb74 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 13:30:25 -0400 Subject: [PATCH 10/19] Add more helper functions to allow for simplifications in tests. --- tests/testthat/helper.R | 63 +++++++++++++++++++++++---- tests/testthat/test-cols_merge.R | 16 ++++--- tests/testthat/test-substitution.R | 34 +++++---------- tests/testthat/test-tab_stub_indent.R | 16 +++---- tests/testthat/test-tab_style.R | 41 ++++++----------- tests/testthat/test-table_parts.R | 9 ++-- tests/testthat/test-text_transform.R | 6 +-- 7 files changed, 101 insertions(+), 84 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 1dcd619743..7dce51b7bb 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, @@ -104,6 +126,29 @@ generate_html_units <- function(input) { ) } +#' 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, + ... + ) +} + # Create a shortened version of `mtcars` mtcars_short <- datasets::mtcars[1:5, ] diff --git a/tests/testthat/test-cols_merge.R b/tests/testthat/test-cols_merge.R index 50454bcb1e..b761a20f02 100644 --- a/tests/testthat/test-cols_merge.R +++ b/tests/testthat/test-cols_merge.R @@ -666,9 +666,11 @@ 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 @@ -684,9 +686,11 @@ 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 ) }) diff --git a/tests/testthat/test-substitution.R b/tests/testthat/test-substitution.R index 02f1719b46..fcef056900 100644 --- a/tests/testthat/test-substitution.R +++ b/tests/testthat/test-substitution.R @@ -730,39 +730,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-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 adf8fdc989..5357230278 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -449,6 +449,9 @@ test_that("Using fonts in `cell_text()` works", { expect_match( "13:35" ) +}) + +test_that("tab_style() works with different locations.", { gtcars_tbl <- gtcars %>% @@ -457,33 +460,17 @@ 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 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..8643b81239 100644 --- a/tests/testthat/test-text_transform.R +++ b/tests/testthat/test-text_transform.R @@ -463,9 +463,9 @@ 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 ) }) From 984c08e2b887b6ce7e875b8b9f752d6771a8c3ee Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 13:32:17 -0400 Subject: [PATCH 11/19] Refactor tests to reduce pipe usage + code style --- tests/testthat/test-cols_width.R | 9 +++-- tests/testthat/test-summary_rows.R | 5 +-- tests/testthat/test-tab_options.R | 14 +++++--- tests/testthat/test-tab_style.R | 2 +- tests/testthat/test-text_transform.R | 18 +++++----- tests/testthat/test-util_functions.R | 53 ++++++++++++++-------------- tests/testthat/test-utils.R | 14 +++----- 7 files changed, 56 insertions(+), 59 deletions(-) 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-summary_rows.R b/tests/testthat/test-summary_rows.R index b1db716a37..8c60414618 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -56,7 +56,7 @@ test_that("summary_rows() can make group-wise summaries", { 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_equal(summary[[1]]$columns, c("open", "high", "low", "close")) expect_type(summary[[1]]$fns, "list") # Expect that the components of `summary[[1]]$fns` are lists @@ -66,7 +66,8 @@ test_that("summary_rows() can make group-wise summaries", { # Expect that expect_equal(summary[[1]]$missing_text, "---") - expect_equal(summary[[1]]$formatter, NULL) + expect_null(summary[[1]]$formatter) + # expect a zero-length list expect_type(summary[[1]]$formatter_options, "list") expect_length(summary[[1]]$formatter_options, 0) 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_style.R b/tests/testthat/test-tab_style.R index 5357230278..39108d0876 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -414,7 +414,7 @@ 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 diff --git a/tests/testthat/test-text_transform.R b/tests/testthat/test-text_transform.R index 8643b81239..87368ca9fa 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)) diff --git a/tests/testthat/test-util_functions.R b/tests/testthat/test-util_functions.R index 5d431ecb43..d0084bf8f5 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_2) + 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", { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c7e6abc9ac..7ea7150532 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(as_raw_html(is_gt_group(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()` @@ -245,15 +245,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") From 0e1d109b96276c370b4fa74fba7e35a9693fb1a5 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 13:34:51 -0400 Subject: [PATCH 12/19] More usage of custom testing functions --- tests/testthat/test-gt_group.R | 29 +++++------ tests/testthat/test-summary_rows.R | 78 +++++++++++------------------- tests/testthat/test-tab_style.R | 59 +++++++++------------- 3 files changed, 63 insertions(+), 103 deletions(-) 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-summary_rows.R b/tests/testthat/test-summary_rows.R index 8c60414618..a65bae23f3 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -618,10 +618,8 @@ 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, @@ -631,9 +629,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 ) }) @@ -681,9 +679,9 @@ 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 ) }) @@ -927,9 +925,9 @@ 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` @@ -1090,23 +1088,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", { @@ -1274,14 +1259,14 @@ 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( + gt_tbl_1, + gt_tbl_2 ) - expect_equal( - gt_tbl_2 %>% render_as_html(), - gt_tbl_3 %>% render_as_html() + expect_equal_gt( + gt_tbl_2, + gt_tbl_3 ) }) @@ -1513,9 +1498,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", { @@ -1676,10 +1661,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 <- @@ -1722,14 +1704,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", { diff --git a/tests/testthat/test-tab_style.R b/tests/testthat/test-tab_style.R index 39108d0876..d5f9bfe7d2 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -418,37 +418,34 @@ test_that("Using fonts in `cell_text()` works", { # 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.", { @@ -513,34 +510,26 @@ test_that("tab_style() works with different locations.", { locations = cells_body(columns = hp) ) ) - expect_no_error( - tab_style( - gtcars_tbl, - style = cell_text(font = c("Times New Roman", "serif")), - 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", { From 8a050b6597f71d5a227daf8df169d18b7ae286a2 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 13:35:16 -0400 Subject: [PATCH 13/19] Lint summary rows tests --- tests/testthat/test-summary_rows.R | 352 +++++++++++------------------ 1 file changed, 137 insertions(+), 215 deletions(-) diff --git a/tests/testthat/test-summary_rows.R b/tests/testthat/test-summary_rows.R index a65bae23f3..78a890bdf5 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -91,31 +91,31 @@ test_that("summary_rows() can make group-wise summaries", { summary <- dt_summary_get(data = gt_tbl) # 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_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total , "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") # 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]]$formatter_options, "list") # Expect that `summary[[1]]$formatter_options` is # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_length(summary[[1]]$formatter_options, 0) # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, @@ -136,30 +136,30 @@ test_that("summary_rows() can make group-wise summaries", { summary <- dt_summary_get(data = gt_tbl) # 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_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_type(summary[[1]]$fns$average , "list") + expect_type(summary[[1]]$fns$total , "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") # 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]]$formatter_options , "list") # Expect that `summary[[1]]$formatter_options` is of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_length(summary[[1]]$formatter_options, 0) # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, @@ -181,31 +181,31 @@ test_that("summary_rows() can make group-wise summaries", { # 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_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_type(summary[[1]]$fns$average , "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev` , "list") # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") # 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]]$formatter_options, "list") # Expect that `summary[[1]]$formatter_options` is # of length 0 - summary[[1]]$formatter_options %>% expect_length(0) + expect_length(summary[[1]]$formatter_options, 0) # Create a table with two sets of summary rows for all groups # and all columns @@ -234,66 +234,47 @@ 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()` - summary %>% expect_length(2) + 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_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) + expect_named(summary[[2]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) # 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_equal(summary[[1]]$columns, c("open", "high", "low", "close")) + expect_equal(summary[[2]]$columns, 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_type(summary[[1]]$fns, "list") + expect_type(summary[[2]]$fns , "list") # 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_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") # Expect that `summary[[1|2]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - - summary[[2]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text , "---") + expect_equal(summary[[2]]$missing_text, "---") # 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_type(summary[[1]]$formatter_options, "list") + expect_type(summary[[2]]$formatter_options, "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 two sets of summary rows for all groups # and all columns @@ -324,62 +305,47 @@ 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) + 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_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) + expect_named(summary[[2]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) # 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_equal(summary[[1]]$columns, c("open", "high")) + expect_equal(summary[[2]]$columns, 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_type(summary[[1]]$fns, "list") + expect_type(summary[[2]]$fns, "list") # 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_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]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") + expect_equal(summary[[2]]$missing_text, "---") # 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` is a list of length 0 + expect_type(summary[[1]]$formatter_options, "list") + expect_type(summary[[2]]$formatter_options, "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) }) test_that("Grand summaries can be generated with `grand_summary_rows()`", { @@ -402,41 +368,35 @@ 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) + 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_named(summary[[1]], 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_equal(summary[[1]]$groups, ":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_equal(summary[[1]]$columns, c("open", "high", "low", "close")) # 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_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") # 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]]$formatter_options, "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 @@ -471,57 +431,45 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { # 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_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) + expect_named(summary[[2]], 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_equal(summary[[1]]$groups, ":GRAND_SUMMARY:") + expect_equal(summary[[2]]$groups, ":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_equal(summary[[1]]$columns, c("open", "high")) + expect_equal(summary[[2]]$columns, 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_type(summary[[1]]$fns, "list") + expect_type(summary[[2]]$fns, "list") # 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_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]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") + expect_equal(summary[[2]]$missing_text, "---") # Expect that `summary[[1|2]]$formatter_options` are both lists - summary[[1]]$formatter_options %>% expect_type("list") - summary[[2]]$formatter_options %>% expect_type("list") + # of length 0 + expect_type(summary[[1]]$formatter_options, "list") + expect_type(summary[[2]]$formatter_options, "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 @@ -552,66 +500,54 @@ 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) + 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" - ) - ) + expect_named(summary[[1]], 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_named(summary[[2]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) # Expect that `summary[[1]]$groups` is a character vector - summary[[1]]$groups %>% expect_equal(c("W02", "W03")) + expect_equal(summary[[1]]$groups, c("W02", "W03")) # Expect that `summary[[2]]$groups` is a character vector - summary[[2]]$groups %>% expect_equal(":GRAND_SUMMARY:") + expect_equal(summary[[2]]$groups, ":GRAND_SUMMARY:") # 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_equal(summary[[1]]$columns, c("open", "high", "low", "close")) + expect_equal(summary[[2]]$columns, 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_type(summary[[1]]$fns, "list") + expect_type(summary[[2]]$fns, "list") # 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_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]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") - summary[[2]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") + expect_equal(summary[[2]]$missing_text, "---") # 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") + # of length 0 + expect_type(summary[[1]]$formatter_options, "list") + expect_type(summary[[2]]$formatter_options, "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) }) test_that("Using `groups = FALSE` in `summary_rows()` returns data unchanged", { @@ -1904,60 +1840,46 @@ test_that("Creating summary rows works for hidden columns", { # 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_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) # 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_equal(summary[[1]]$columns, c("open", "high", "low", "close")) # 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_type(summary[[1]]$fns$average, "list") + expect_type(summary[[1]]$fns$total, "list") + expect_type(summary[[1]]$fns$`std dev`, "list") # Expect that `summary[[1]]$missing_text` has a specific value - summary[[1]]$missing_text %>% expect_equal("---") + expect_equal(summary[[1]]$missing_text, "---") # 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]]$formatter_options, "list") + expect_length(summary[[1]]$formatter_options, 0) # 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 From 08860f179cafa1444acb7fab395af8e98c70ecf5 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 13:41:47 -0400 Subject: [PATCH 14/19] Fix typo + add condition to test shiny conditionally. --- tests/testthat/test-util_functions.R | 2 +- tests/testthat/test-utils.R | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-util_functions.R b/tests/testthat/test-util_functions.R index d0084bf8f5..9794587bc4 100644 --- a/tests/testthat/test-util_functions.R +++ b/tests/testthat/test-util_functions.R @@ -336,7 +336,7 @@ test_that("remove_html() works correctly", { # Expect that the `character` text object has had the # HTML tags removed - html_text_1_removed <- remove_html(html_text_2) + 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 diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 7ea7150532..0e1e5ab201 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -21,7 +21,7 @@ test_that("Various `is_*()` utility functions work properly", { expect_false(is_gt_group(gt(exibble))) expect_false(is_gt_group(gt_preview(gtcars))) expect_false(is_gt_group(exibble)) - expect_false(as_raw_html(is_gt_group(gt(exibble)))) + 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 @@ -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"))) From 1e0ff0dcb02ac8a72904439db8b2c208320ef459 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 14:22:11 -0400 Subject: [PATCH 15/19] Refactor summary test in helper function --- tests/testthat/helper.R | 50 +++++- tests/testthat/test-summary_rows.R | 240 +++-------------------------- 2 files changed, 73 insertions(+), 217 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 7dce51b7bb..0342d211c2 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -128,7 +128,6 @@ generate_html_units <- function(input) { #' 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 @@ -149,6 +148,55 @@ expect_equal_gt <- function(gt_tbl1, gt_tbl2, f = render_as_html, ignore_id = FA ) } +#' 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-summary_rows.R b/tests/testthat/test-summary_rows.R index 78a890bdf5..c3f9955ef4 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -38,40 +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 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_null(summary[[1]]$formatter) - - # 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 @@ -90,6 +70,9 @@ 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` expect_equal(summary[[1]]$groups, "W02") @@ -104,19 +87,6 @@ test_that("summary_rows() can make group-wise summaries", { expect_type(summary[[1]]$fns$total , "list") expect_type(summary[[1]]$fns$`std dev`, "list") - # Expect that `summary[[1]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - expect_type(summary[[1]]$formatter_options, "list") - - # Expect that `summary[[1]]$formatter_options` is - # of length 0 - expect_length(summary[[1]]$formatter_options, 0) - # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, # sum, and standard deviation of only the `open` column @@ -135,32 +105,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` expect_equal(summary[[1]]$groups, c("W02", "W03")) # Expect the `columns` provided in `summary[[1]]$columns` expect_equal(summary[[1]]$columns, "open") - # Expect that `summary[[1]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - # 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 `summary[[1]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - expect_type(summary[[1]]$formatter_options , "list") - - # Expect that `summary[[1]]$formatter_options` is of length 0 - expect_length(summary[[1]]$formatter_options, 0) - # Create a table with summary rows for the `W02` and `W03` # groups; the 3 summary rows for these groups represent the mean, # sum, and standard deviation of only the `open` column @@ -178,6 +136,8 @@ 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 @@ -186,27 +146,11 @@ test_that("summary_rows() can make group-wise summaries", { # Expect the `columns` provided in `summary[[1]]$columns` expect_equal(summary[[1]]$columns, "open") - # Expect that `summary[[1]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - # 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 `summary[[1]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - expect_type(summary[[1]]$formatter_options, "list") - - # Expect that `summary[[1]]$formatter_options` is - # of length 0 - expect_length(summary[[1]]$formatter_options, 0) - # Create a table with two sets of summary rows for all groups # and all columns gt_tbl <- @@ -231,15 +175,11 @@ 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()` - expect_length(summary, 2) - - # For the two list components in `summary`, expect specific - # names within them - expect_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) - expect_named(summary[[2]], 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 expect_equal(summary[[1]]$groups, c("W02", "W03")) @@ -249,33 +189,12 @@ test_that("summary_rows() can make group-wise summaries", { expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) expect_equal(summary[[2]]$columns, c("open", "high", "low", "close")) - # Expect that `summary[[1|2]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - expect_type(summary[[2]]$fns , "list") - # Expect that the components of `summary[[1|2]]$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_type(summary[[2]]$fns$max, "list") - # Expect that `summary[[1|2]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text , "---") - expect_equal(summary[[2]]$missing_text, "---") - - # 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 - expect_type(summary[[1]]$formatter_options, "list") - expect_type(summary[[2]]$formatter_options, "list") - - # Expect that `summary[[1|2]]$formatter_options` are both - # of length 0 - expect_length(summary[[1]]$formatter_options, 0) - expect_length(summary[[2]]$formatter_options, 0) - # Create a table with two sets of summary rows for all groups # and all columns gt_tbl <- @@ -305,12 +224,7 @@ 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()` - expect_length(summary, 2) - - # For the two list components in `summary`, expect specific - # names within them - expect_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) - expect_named(summary[[2]], 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 expect_equal(summary[[1]]$groups, c("W02", "W03")) @@ -320,10 +234,6 @@ test_that("summary_rows() can make group-wise summaries", { expect_equal(summary[[1]]$columns, c("open", "high")) expect_equal(summary[[2]]$columns, c("low", "close")) - # Expect that `summary[[1|2]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - expect_type(summary[[2]]$fns, "list") - # Expect that the components of `summary[[1|2]]$fns` are lists expect_type(summary[[1]]$fns$average, "list") expect_type(summary[[1]]$fns$total, "list") @@ -331,21 +241,6 @@ test_that("summary_rows() can make group-wise summaries", { 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]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - expect_equal(summary[[2]]$missing_text, "---") - - # 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 of length 0 - expect_type(summary[[1]]$formatter_options, "list") - expect_type(summary[[2]]$formatter_options, "list") - - expect_length(summary[[1]]$formatter_options, 0) - expect_length(summary[[2]]$formatter_options, 0) }) test_that("Grand summaries can be generated with `grand_summary_rows()`", { @@ -368,36 +263,17 @@ 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()` - 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 the `groups` provided in `summary[[1]]$groups` is a specific string - expect_equal(summary[[1]]$groups, ":GRAND_SUMMARY:") + expect_summary(summary, length = 1, type = "grand_summary") # Expect the `columns` provided in `summary[[1]]$columns` # provide names for all columns expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) - # Expect that `summary[[1]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - # 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 `summary[[1]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - - # Expect that `summary[[1]]$formatter` is NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - expect_type(summary[[1]]$formatter_options, "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 # into 2 calls that allow for different formatting options @@ -427,25 +303,12 @@ 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 - expect_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) - expect_named(summary[[2]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) - - # Expect that `summary[[1|2]]$groups` have a specific string - expect_equal(summary[[1]]$groups, ":GRAND_SUMMARY:") - expect_equal(summary[[2]]$groups, ":GRAND_SUMMARY:") + expect_summary(summary, length = 2, type = c("grand_summary", "grand_summary")) # Expect that `summary[[1|2]]$columns` has specific values expect_equal(summary[[1]]$columns, c("open", "high")) expect_equal(summary[[2]]$columns, c("low", "close")) - # Expect that `summary[[1|2]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - expect_type(summary[[2]]$fns, "list") - # Expect that the functions used in each call # are the same expect_identical(summary[[1]]$fns, summary[[1]]$fns) @@ -458,15 +321,6 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { expect_type(summary[[2]]$fns$total, "list") expect_type(summary[[2]]$fns$`std dev`, "list") - # Expect that `summary[[1|2]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - expect_equal(summary[[2]]$missing_text, "---") - - # Expect that `summary[[1|2]]$formatter_options` are both lists - # of length 0 - expect_type(summary[[1]]$formatter_options, "list") - expect_type(summary[[2]]$formatter_options, "list") - # Expect that `summary[[1|2]]$formatter_options` are both of length 0 expect_length(summary[[1]]$formatter_options, 0) expect_length(summary[[2]]$formatter_options, 0) @@ -500,28 +354,15 @@ 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 - expect_named(summary[[1]], c("groups", "columns", "fns", "fmt", "side", "missing_text", "formatter", "formatter_options")) - - expect_named(summary[[2]], 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 expect_equal(summary[[1]]$groups, c("W02", "W03")) - # Expect that `summary[[2]]$groups` is a character vector - expect_equal(summary[[2]]$groups, ":GRAND_SUMMARY:") - # Expect that `summary[[1|2]]$columns` has specific values expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) expect_equal(summary[[2]]$columns, c("open", "high", "low", "close")) - # Expect that `summary[[1|2]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - expect_type(summary[[2]]$fns, "list") - # Expect that the functions used in each call are the same expect_identical(summary[[1]]$fns, summary[[1]]$fns) @@ -531,23 +372,8 @@ test_that("Grand summaries can be generated with `grand_summary_rows()`", { 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]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - expect_equal(summary[[2]]$missing_text, "---") - - # 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 - # of length 0 - expect_type(summary[[1]]$formatter_options, "list") - expect_type(summary[[2]]$formatter_options, "list") + expect_type(summary[[2]]$fns$`std dev`, "list") - expect_length(summary[[1]]$formatter_options, 0) - expect_length(summary[[2]]$formatter_options, 0) }) test_that("Using `groups = FALSE` in `summary_rows()` returns data unchanged", { @@ -1373,12 +1199,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 @@ -1836,11 +1662,7 @@ 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 - expect_named(summary[[1]], 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` expect_equal(summary[[1]]$groups, "W02") @@ -1848,25 +1670,11 @@ test_that("Creating summary rows works for hidden columns", { # Expect the `columns` provided in `summary[[1]]$columns` expect_equal(summary[[1]]$columns, c("open", "high", "low", "close")) - # Expect that `summary[[1]]$fns` is a `list` object - expect_type(summary[[1]]$fns, "list") - # 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 `summary[[1]]$missing_text` has a specific value - expect_equal(summary[[1]]$missing_text, "---") - - # Expect that `summary[[1]]$formatter` is a NULL - expect_null(summary[[1]]$formatter) - - # Expect that `summary[[1]]$formatter_options` is a list - # of length 0 - expect_type(summary[[1]]$formatter_options, "list") - expect_length(summary[[1]]$formatter_options, 0) - # Extract the summary from `gt_tbl` and obtain the # tibble containing the summary for the `W02` group summary_extract <- extract_summary(gt_tbl) From d75996ea8686eaaf035347fcf502d423639e6dfe Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 14:22:28 -0400 Subject: [PATCH 16/19] other usage of helpers --- tests/testthat/test-summary_rows.R | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-summary_rows.R b/tests/testthat/test-summary_rows.R index c3f9955ef4..7882f008eb 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -643,10 +643,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() %>% @@ -687,10 +684,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_equal_gt( - gt_tbl_1_gs, - gt_tbl_1b_gs - ) + 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() %>% @@ -1021,15 +1015,8 @@ test_that("Multiple ways of expressing formatting work equivalently", { fmt = ~ fmt_number(., decimals = 3) ) - expect_equal_gt( - gt_tbl_1, - gt_tbl_2 - ) - - expect_equal_gt( - gt_tbl_2, - gt_tbl_3 - ) + 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()`", { From c90e15b8c568b835856d3fc521aecc8cbe4a9b0d Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 14:35:24 -0400 Subject: [PATCH 17/19] Final pass at using the new helpers for testing equality --- tests/testthat/test-substitution.R | 32 ++++------- tests/testthat/test-tab_footnote.R | 13 +---- tests/testthat/test-tab_remove.R | 20 +++---- tests/testthat/test-tab_spanner_delim.R | 75 +++++-------------------- 4 files changed, 39 insertions(+), 101 deletions(-) diff --git a/tests/testthat/test-substitution.R b/tests/testthat/test-substitution.R index fcef056900..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 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_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)", { From 6491bce1c4363730436db70e5f808ab2f2ae4c06 Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 14:49:45 -0400 Subject: [PATCH 18/19] More test refactoring + add snapshot test to .Rbuildignore --- .Rbuildignore | 2 ++ tests/testthat/test-as_raw_html.R | 10 ++++------ tests/testthat/test-cols_merge.R | 14 ++------------ tests/testthat/test-summary_rows.R | 5 +---- tests/testthat/test-tab_style.R | 7 +------ tests/testthat/test-text_transform.R | 20 ++++---------------- 6 files changed, 14 insertions(+), 44 deletions(-) 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/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_merge.R b/tests/testthat/test-cols_merge.R index b761a20f02..6b7b337269 100644 --- a/tests/testthat/test-cols_merge.R +++ b/tests/testthat/test-cols_merge.R @@ -666,12 +666,7 @@ test_that("cols_merge_range() works well", { ) # Expect that the HTML produced from the two tables is the same - expect_equal_gt( - tbl_html_1, - tbl_html_2, - f = as_raw_html, - ignore_id = TRUE - ) + 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 @@ -686,12 +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_equal_gt( - tbl_html_2, - tbl_html_3, - f = as_raw_html, - ignore_id = TRUE - ) + 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-summary_rows.R b/tests/testthat/test-summary_rows.R index 7882f008eb..c4e36ea9db 100644 --- a/tests/testthat/test-summary_rows.R +++ b/tests/testthat/test-summary_rows.R @@ -441,10 +441,7 @@ test_that("Using `groups = NULL` in `summary_rows()` is a deprecated option", { ) ) - expect_equal_gt( - summary_tbl_1, - summary_tbl_2 - ) + expect_equal_gt(summary_tbl_1, summary_tbl_2) }) test_that("Summary rows can be added to the top of any group", { diff --git a/tests/testthat/test-tab_style.R b/tests/testthat/test-tab_style.R index d5f9bfe7d2..23e1d1b56c 100644 --- a/tests/testthat/test-tab_style.R +++ b/tests/testthat/test-tab_style.R @@ -463,12 +463,7 @@ test_that("tab_style() works with different locations.", { 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 - ) + 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( diff --git a/tests/testthat/test-text_transform.R b/tests/testthat/test-text_transform.R index 87368ca9fa..e314364381 100644 --- a/tests/testthat/test-text_transform.R +++ b/tests/testthat/test-text_transform.R @@ -332,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", { @@ -461,10 +455,7 @@ test_that("text_case_when() + text_case_match() work", { text_case_match(NA ~ "---") ) # they are not changing numeric NA - expect_equal_gt( - cw, - cm - ) + expect_equal_gt(cw, cm) }) test_that("text_replace() works", { @@ -473,8 +464,5 @@ test_that("text_replace() works", { gt() %>% text_replace("NA", "---") ) - expect_match_html( - tr, - "---" - ) + expect_match_html(tr, "---") }) From 02e8fe7938788937e99642f49d02c470fd09e3df Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 14 Aug 2024 15:57:39 -0400 Subject: [PATCH 19/19] add minor changes --- tests/testthat/test-cols_align.R | 14 +++++++------- tests/testthat/test-l_cols_align.R | 11 +++++------ tests/testthat/test-utils_render_grid.R | 24 ++++++++++++------------ 3 files changed, 24 insertions(+), 25 deletions(-) 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-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-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,
averagetotalstd devaveragetotalstd dev13:3513:3513:3513:3513:3513:35 space space