From c4fc0e32a90f91af0cee4385aec4a499144d8f0e Mon Sep 17 00:00:00 2001 From: osenan Date: Tue, 4 Nov 2025 23:59:20 -0300 Subject: [PATCH 01/24] tests: load library testthat to simplify tests and reuse units. --- R/plot_with_settings.R | 4 ++-- tests/testthat.R | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/plot_with_settings.R b/R/plot_with_settings.R index b978aed80..39adb43e5 100644 --- a/R/plot_with_settings.R +++ b/R/plot_with_settings.R @@ -1,6 +1,6 @@ #' @keywords internal #' @noRd -plot_with_settings_deps <- function() { +plot_with_settings_deps <- function() { # nocov start htmltools::htmlDependency( name = "teal-widgets-plot-with-settings", version = utils::packageVersion("teal.widgets"), @@ -9,7 +9,7 @@ plot_with_settings_deps <- function() { stylesheet = "plot-with-settings.css", script = "plot-with-settings.js" ) -} +} # nocov end #' @name plot_with_settings #' @rdname plot_with_settings diff --git a/tests/testthat.R b/tests/testthat.R index f3eda6fbd..d5c1250f2 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,3 +1,4 @@ pkg_name <- "teal.widgets" library(pkg_name, character.only = TRUE) testthat::test_check(pkg_name) +library(testthat) \ No newline at end of file From c063bc90b8e70637f10054972a29b1c072689072 Mon Sep 17 00:00:00 2001 From: osenan Date: Tue, 4 Nov 2025 23:59:53 -0300 Subject: [PATCH 02/24] tests: add snapshot test for standard_layout to increase coverage --- R/standard_layout.R | 4 ++-- tests/testthat/_snaps/standard_layout.md | 5 +++++ tests/testthat/test-standard_layout.R | 24 ++++++++++++++++++++++++ 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/standard_layout.md diff --git a/R/standard_layout.R b/R/standard_layout.R index 2742738a5..f01787ab8 100644 --- a/R/standard_layout.R +++ b/R/standard_layout.R @@ -1,6 +1,6 @@ #' @keywords internal #' @noRd -standard_layout_deps <- function() { +standard_layout_deps <- function() { # nocov start htmltools::htmlDependency( name = "teal-widgets-standard-layout", version = utils::packageVersion("teal.widgets"), @@ -8,7 +8,7 @@ standard_layout_deps <- function() { src = "standard-layout", stylesheet = "standard-layout.css" ) -} +} # nocov end #' Standard UI layout #' diff --git a/tests/testthat/_snaps/standard_layout.md b/tests/testthat/_snaps/standard_layout.md new file mode 100644 index 000000000..c32a3aad7 --- /dev/null +++ b/tests/testthat/_snaps/standard_layout.md @@ -0,0 +1,5 @@ +# checks snapshot with encoding and null forms + + Code + mock_layout + diff --git a/tests/testthat/test-standard_layout.R b/tests/testthat/test-standard_layout.R index 49be0861a..ac68dd988 100644 --- a/tests/testthat/test-standard_layout.R +++ b/tests/testthat/test-standard_layout.R @@ -27,3 +27,27 @@ testthat::test_that("Input validation", { post_output = 1 ), regexp = "Assertion on 'post_output' failed") }) + +describe("Tests for standard_layout options", { + mock_output <- shiny::plotOutput("test") + mock_form <- shiny::actionButton("test", "") + + it("checks that the class is correct", { + # Given + expected_class <- "bslib_page" + mock_layout <- standard_layout(output = mock_output, encoding = NULL, forms = mock_form) + + # Then + expect_true(any(expected_class %in% class(mock_layout))) + }) + + it("checks snapshot with encoding and null forms", { + # Given + expected_class <- "bslib_page" + mock_layout <- standard_layout(output = mock_output, encoding = mock_form, forms = NULL) + + # Then + testthat::local_edition(3) + expect_snapshot(as.character(mock_layout)) + }) +}) From bc968248507cd52a8744baf04a300d97989cc95e Mon Sep 17 00:00:00 2001 From: osenan Date: Thu, 6 Nov 2025 11:30:20 -0300 Subject: [PATCH 03/24] tests: add more scenarios for draggable_buckets to increase coverage --- R/draggable_buckets.R | 4 ++-- tests/testthat/_snaps/draggable_buckets.md | 7 +++++++ tests/testthat/test-draggable_buckets.R | 17 +++++++++++++++++ 3 files changed, 26 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/_snaps/draggable_buckets.md diff --git a/R/draggable_buckets.R b/R/draggable_buckets.R index 66a02e997..912b3e2a5 100644 --- a/R/draggable_buckets.R +++ b/R/draggable_buckets.R @@ -1,6 +1,6 @@ #' @keywords internal #' @noRd -draggable_buckets_deps <- function() { +draggable_buckets_deps <- function() { # nocov start htmltools::htmlDependency( name = "teal-widgets-draggable-buckets", version = utils::packageVersion("teal.widgets"), @@ -9,7 +9,7 @@ draggable_buckets_deps <- function() { script = "draggable-buckets.js", stylesheet = "draggable-buckets.css" ) -} +} # nocovend #' @title Draggable Buckets #' @description diff --git a/tests/testthat/_snaps/draggable_buckets.md b/tests/testthat/_snaps/draggable_buckets.md new file mode 100644 index 000000000..47dcba84e --- /dev/null +++ b/tests/testthat/_snaps/draggable_buckets.md @@ -0,0 +1,7 @@ +# Snapshot test for ui component dragable buckets + + Code + as.character(draggable_buckets("my_input_id", "test_label", "element_1", "buckets_1")) + Output + [1] "
\n test_label\n
\n
element_1
\n
\n
\n
buckets_1:
\n
\n
" + diff --git a/tests/testthat/test-draggable_buckets.R b/tests/testthat/test-draggable_buckets.R index 41ccbeb41..f6129b77b 100644 --- a/tests/testthat/test-draggable_buckets.R +++ b/tests/testthat/test-draggable_buckets.R @@ -102,3 +102,20 @@ testthat::test_that( app_driver$stop() } ) + +testthat::test_that("fails when inputId is not from the expected type", { + expect_error(draggable_buckets(numeric(1), "test_label", "element_1", "bucket_1")) +}) + +testthat::test_that("fails when label is not from the expected type", { + expect_error(draggable_buckets("my_input_id", numeric(), "element_1", "bucket_1")) +}) + +testthat::test_that("fails when buckets is not from the expected type", { + expect_error(draggable_buckets("my_input_id", "test_label", "element_1", numeric())) +}) + +testthat::test_that("Snapshot test for ui component dragable buckets", { + testthat::local_edition(3) + expect_snapshot(as.character(draggable_buckets("my_input_id", "test_label", "element_1", "buckets_1"))) +}) From 9b00ed484bafb3fbf9b2b8092440a67712264afa Mon Sep 17 00:00:00 2001 From: osenan Date: Thu, 6 Nov 2025 11:32:00 -0300 Subject: [PATCH 04/24] tests: add more scenarios and snapshot tests for optionalInput functions --- R/optionalInput.R | 20 +++---- tests/testthat/test-optionalInput.R | 57 +++++++++++++++++++ tests/testthat/test-optionalSelectInput_ui.R | 5 ++ .../test-optionalSliderInputValMinMax_ui.R | 5 ++ 4 files changed, 77 insertions(+), 10 deletions(-) diff --git a/R/optionalInput.R b/R/optionalInput.R index f324ed5b7..2eb9d7b29 100644 --- a/R/optionalInput.R +++ b/R/optionalInput.R @@ -311,7 +311,7 @@ updateOptionalSelectInput <- function(session, # nolint #' vector of HTML icons corresponding to data type in each column. #' @keywords internal #' -variable_type_icons <- function(var_type) { +variable_type_icons <- function(var_type) { # nocov start checkmate::assert_character(var_type, any.missing = FALSE) class_to_icon <- list( @@ -343,7 +343,7 @@ variable_type_icons <- function(var_type) { )) res -} +} # nocov end #' Optional content for `optionalSelectInput` #' @@ -359,7 +359,7 @@ variable_type_icons <- function(var_type) { #' @return (`character`) HTML contents with all elements combined #' @keywords internal #' -picker_options_content <- function(var_name, var_label, var_type) { +picker_options_content <- function(var_name, var_label, var_type) { # nocov start if (length(var_name) == 0) { res <- character(0) } else if (length(var_type) == 0 && length(var_label) == 0) { @@ -387,7 +387,7 @@ picker_options_content <- function(var_name, var_label, var_type) { } res -} +} # nocov end #' Create `choicesOpt` for `pickerInput` #' @@ -397,7 +397,7 @@ picker_options_content <- function(var_name, var_label, var_type) { #' @return (`list`)\cr #' to be passed as `choicesOpt` argument. #' @keywords internal -picker_options <- function(choices) { +picker_options <- function(choices) { # nocov start if (inherits(choices, "choices_labeled")) { raw_choices <- extract_raw_choices(choices, sep = attr(choices, "sep")) res <- list( @@ -418,7 +418,7 @@ picker_options <- function(choices) { res <- NULL } res -} +} # nocov end #' Extract raw values from choices #' @@ -429,7 +429,7 @@ picker_options <- function(choices) { #' the different columns. #' @return choices simplified #' @keywords internal -extract_raw_choices <- function(choices, sep) { +extract_raw_choices <- function(choices, sep) { # nocov start if (!is.null(sep)) { vapply(choices, paste, collapse = sep, character(1)) } else if (inherits(choices, "choices_labeled")) { @@ -437,7 +437,7 @@ extract_raw_choices <- function(choices, sep) { } else { choices } -} +} # nocov end #' Optional Slider Input Widget #' @@ -579,7 +579,7 @@ optionalSliderInputValMinMax <- function(inputId, label, value_min_max, label_he #' #' @return (`character`) vector with labels #' @keywords internal -extract_choices_labels <- function(choices, values = NULL) { +extract_choices_labels <- function(choices, values = NULL) { # nocov start res <- if (inherits(choices, "choices_labeled")) { attr(choices, "raw_labels") } else if (!is.null(names(choices)) && !setequal(names(choices), unlist(unname(choices)))) { @@ -594,4 +594,4 @@ extract_choices_labels <- function(choices, values = NULL) { } res -} +} # nocov end diff --git a/tests/testthat/test-optionalInput.R b/tests/testthat/test-optionalInput.R index 77141ac1c..f8623e417 100644 --- a/tests/testthat/test-optionalInput.R +++ b/tests/testthat/test-optionalInput.R @@ -25,3 +25,60 @@ testthat::test_that("optionalSliderInput min/max NA", { testthat::expect_no_error(optionalSliderInput("a", "b", NA, NA, 0.2)) testthat::expect_no_error(optionalSliderInput("a", "b", 0, 1, 0.2)) }) + +testthat::test_that("if inputId is not a string returns an error", { + testthat::expect_error(optionalSelectInput(TRUE, "my label", c("choice_1", "choice_2"))) +}) + +testthat::test_that("if inputId is not a string returns an error", { + testthat::expect_error(optionalSelectInput(TRUE, "my label", c("choice_1", "choice_2"))) +}) + +testthat::test_that("if label is not a string returns an error", { + testthat::expect_error(optionalSelectInput("my_input_id", TRUE, c("choice_1", "choice_2"))) +}) + +testthat::test_that("optionalSelectInput is a Shiny ui component", { + testthat::expect_s3_class( + optionalSelectInput( + "my_input_id", + "my label", + c("choice_1", "choice_2"), + label_help = shiny::helpText("This is a sample help text") + ), + "shiny.tag" + ) +}) + +testthat::test_that("if inputId is not a string optionalSliderInputValMinMax returns error", { + testthat::expect_error(optionalSliderInputValMinMax( + list, + "label", + c(5, 1, 10), + label_help = shiny::helpText("Help") + ) + ) +}) + +testthat::test_that("value_min_max with invalid length throws error", { + testthat::expect_error(optionalSliderInputValMinMax("id", "label", c(1, 2))) +}) + +testthat::test_that("value out of range in value_min_max throws error", { + testthat::expect_error( + optionalSliderInputValMinMax("id", "label", c(10, 1, 5)), + "value_min_max" + ) +}) + +testthat::test_that("optionalSliderInputValMinMax is a Shiny ui component", { + testthat::expect_s3_class( + optionalSliderInputValMinMax( + "id", + "label", + c(5, 1, 10), + label_help = shiny::helpText("Help") + ), + "shiny.tag" + ) +}) diff --git a/tests/testthat/test-optionalSelectInput_ui.R b/tests/testthat/test-optionalSelectInput_ui.R index 8b7c91d97..7297b181b 100644 --- a/tests/testthat/test-optionalSelectInput_ui.R +++ b/tests/testthat/test-optionalSelectInput_ui.R @@ -128,3 +128,8 @@ testthat::test_that( app_driver$stop() } ) + +testthat::test_that("Snapshot test for optionalSelectInput", { + testthat::local_edition(3) + testthat::expect_snapshot(as.character(optionalSelectInput("my_select_input", "my label", c("choice_1", "choice_2"), sep = " "))) +}) diff --git a/tests/testthat/test-optionalSliderInputValMinMax_ui.R b/tests/testthat/test-optionalSliderInputValMinMax_ui.R index c0887df91..b55cbfbfe 100644 --- a/tests/testthat/test-optionalSliderInputValMinMax_ui.R +++ b/tests/testthat/test-optionalSliderInputValMinMax_ui.R @@ -25,3 +25,8 @@ testthat::test_that( app_driver$stop() } ) + +testthat::test_that("snapshot test for optionalSliderInputValMinMax", { + testthat::local_edition(3) + testthat::expect_snapshot(as.character(optionalSliderInput("my slider", "my label", 0, 10, 2))) +}) From d78e6a170bfd181ab292bd988b1dca7db108b12d Mon Sep 17 00:00:00 2001 From: osenan Date: Thu, 6 Nov 2025 11:50:31 -0300 Subject: [PATCH 05/24] tests: add more tests for verbatim_popup_ui and get_dt_rows in order to improve the coverage --- tests/testthat/_snaps/verbatim_popup_ui.md | 7 + tests/testthat/test-get_dt_rows_ui.R | 4 + tests/testthat/test-verbatim_popup.R | 171 +++++++++++++++++++++ tests/testthat/test-verbatim_popup_ui.R | 5 + 4 files changed, 187 insertions(+) create mode 100644 tests/testthat/_snaps/verbatim_popup_ui.md diff --git a/tests/testthat/_snaps/verbatim_popup_ui.md b/tests/testthat/_snaps/verbatim_popup_ui.md new file mode 100644 index 000000000..e05cb0e80 --- /dev/null +++ b/tests/testthat/_snaps/verbatim_popup_ui.md @@ -0,0 +1,7 @@ +# snapshot test for verbatim_popup_ui + + Code + verbatim_popup_ui("STH", "STH2") + Output + + diff --git a/tests/testthat/test-get_dt_rows_ui.R b/tests/testthat/test-get_dt_rows_ui.R index 3b56c8442..492d0a841 100644 --- a/tests/testthat/test-get_dt_rows_ui.R +++ b/tests/testthat/test-get_dt_rows_ui.R @@ -71,3 +71,7 @@ testthat::test_that( app_driver$stop() } ) + +testthat::test_that("Check class of get_dt_rows", { + testthat::expect_s3_class(get_dt_rows("my table", "0"), "shiny.tag") +}) diff --git a/tests/testthat/test-verbatim_popup.R b/tests/testthat/test-verbatim_popup.R index 8516db5bc..0ae2c499e 100644 --- a/tests/testthat/test-verbatim_popup.R +++ b/tests/testthat/test-verbatim_popup.R @@ -109,3 +109,174 @@ testthat::test_that("verbatim_popup_ui with type 'link' produces a button with a ui_char <- as.character(verbatim_popup_ui(id = "test_id", button_label = "Test button label", type = "link")) testthat::expect_true(grepl("^