diff --git a/DESCRIPTION b/DESCRIPTION index 68f3e7946..122fa6770 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -99,7 +99,7 @@ Suggests: datasets, DT, Cairo (>= 1.5-5), - testthat (>= 3.0.0), + testthat (>= 3.2.1), knitr (>= 1.6), markdown, rmarkdown, diff --git a/tests/testthat/test-bootstrap.r b/tests/testthat/test-bootstrap.r index f39bb726c..c2e9b51db 100644 --- a/tests/testthat/test-bootstrap.r +++ b/tests/testthat/test-bootstrap.r @@ -21,10 +21,11 @@ test_that("Repeated names for selectInput and radioButtons choices", { # Select input x <- selectInput('id','label', choices = c(a='x1', a='x2', b='x3'), selectize = FALSE) - expect_true(grepl(fixed = TRUE, + expect_match( + format(x), '', - format(x) - )) + fixed = TRUE + ) # Radio buttons using choices x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3')) @@ -248,10 +249,11 @@ test_that("selectInput selects items by default", { )) # Nothing selected when choices=NULL - expect_true(grepl(fixed = TRUE, + expect_match( + format(selectInput('x', NULL, NULL, selectize = FALSE)), '', - format(selectInput('x', NULL, NULL, selectize = FALSE)) - )) + fixed = TRUE + ) # None specified as selected. With multiple=TRUE, none selected by default. expect_true(grepl(fixed = TRUE, diff --git a/tests/testthat/test-busy-indication.R b/tests/testthat/test-busy-indication.R index 4fdd90aee..1f36d92bf 100644 --- a/tests/testthat/test-busy-indication.R +++ b/tests/testthat/test-busy-indication.R @@ -48,7 +48,7 @@ test_that("busyIndicatorOptions()", { test_that("Can provide svg file for busyIndicatorOptions(spinner_type)", { - skip_if(.Platform$OS.type == "windows") + skip_on_os("windows") tmpsvg <- tempfile(fileext = ".svg") writeLines("", tmpsvg) diff --git a/tests/testthat/test-input-select.R b/tests/testthat/test-input-select.R index b41a2a207..d30c686f6 100644 --- a/tests/testthat/test-input-select.R +++ b/tests/testthat/test-input-select.R @@ -1,10 +1,10 @@ test_that("performance warning works", { pattern <- "consider using server-side selectize" - expect_warning(selectInput("x", "x", as.character(1:999)), NA) - expect_warning(selectInput("x", "x", as.character(1:999), selectize = TRUE), NA) - expect_warning(selectInput("x", "x", as.character(1:999), selectize = FALSE), NA) - expect_warning(selectizeInput("x", "x", as.character(1:999)), NA) + expect_no_warning(selectInput("x", "x", as.character(1:999))) + expect_no_warning(selectInput("x", "x", as.character(1:999), selectize = TRUE)) + expect_no_warning(selectInput("x", "x", as.character(1:999), selectize = FALSE)) + expect_no_warning(selectizeInput("x", "x", as.character(1:999))) expect_warning(selectInput("x", "x", as.character(1:1000)), pattern) expect_warning(selectInput("x", "x", as.character(1:1000), selectize = TRUE), pattern) @@ -17,9 +17,9 @@ test_that("performance warning works", { session <- MockShinySession$new() - expect_warning(updateSelectInput(session, "x", choices = as.character(1:999)), NA) - expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:999)), NA) - expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:999), server = FALSE), NA) + expect_no_warning(updateSelectInput(session, "x", choices = as.character(1:999))) + expect_no_warning(updateSelectizeInput(session, "x", choices = as.character(1:999))) + expect_no_warning(updateSelectizeInput(session, "x", choices = as.character(1:999), server = FALSE)) expect_warning(updateSelectInput(session, "x", choices = as.character(1:1000)), pattern) expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:1000)), pattern) @@ -28,9 +28,9 @@ test_that("performance warning works", { expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:2000)), pattern) expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:2000), server = FALSE), pattern) - expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:999), server = TRUE), NA) - expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:1000), server = TRUE), NA) - expect_warning(updateSelectizeInput(session, "x", choices = as.character(1:2000), server = TRUE), NA) + expect_no_warning(updateSelectizeInput(session, "x", choices = as.character(1:999), server = TRUE)) + expect_no_warning(updateSelectizeInput(session, "x", choices = as.character(1:1000), server = TRUE)) + expect_no_warning(updateSelectizeInput(session, "x", choices = as.character(1:2000), server = TRUE)) }) @@ -55,9 +55,9 @@ test_that("selectInput options are properly escaped", { )) si_str <- as.character(si) - expect_true(any(grepl("", si_str, fixed = TRUE))) + expect_match(si_str, "", fixed = TRUE, all = FALSE) }) @@ -75,10 +75,10 @@ test_that("selectInputUI has a select at an expected location", { ) # if this getter is changed, varSelectInput getter needs to be changed selectHtml <- selectInputVal$children[[2]]$children[[1]] - expect_true(inherits(selectHtml, "shiny.tag")) + expect_s3_class(selectHtml, "shiny.tag") expect_equal(selectHtml$name, "select") if (!is.null(selectHtml$attribs$class)) { - expect_false(grepl(selectHtml$attribs$class, "symbol")) + expect_no_match(selectHtml$attribs$class, "symbol") } varSelectInputVal <- varSelectInput( @@ -91,9 +91,9 @@ test_that("selectInputUI has a select at an expected location", { ) # if this getter is changed, varSelectInput getter needs to be changed varSelectHtml <- varSelectInputVal$children[[2]]$children[[1]] - expect_true(inherits(varSelectHtml, "shiny.tag")) + expect_s3_class(varSelectHtml, "shiny.tag") expect_equal(varSelectHtml$name, "select") - expect_true(grepl("symbol", varSelectHtml$attribs$class, fixed = TRUE)) + expect_match(varSelectHtml$attribs$class, "symbol", fixed = TRUE) } } } diff --git a/tests/testthat/test-plot-png.R b/tests/testthat/test-plot-png.R index 500746b18..54cae7fee 100644 --- a/tests/testthat/test-plot-png.R +++ b/tests/testthat/test-plot-png.R @@ -2,5 +2,5 @@ test_that("plotPNG()/startPNG() ignores NULL dimensions", { f <- plotPNG(function() plot(1), width = NULL, height = NULL) on.exit(unlink(f)) bits <- readBin(f, "raw", file.info(f)$size) - expect_true(length(bits) > 0) + expect_gt(length(bits), 0) }) diff --git a/tests/testthat/test-reactivity.r b/tests/testthat/test-reactivity.r index 04ccfe48d..d7a8372bb 100644 --- a/tests/testthat/test-reactivity.r +++ b/tests/testthat/test-reactivity.r @@ -9,7 +9,7 @@ test_that("ReactiveVal", { val <- reactiveVal() isolate({ - expect_true(is.null(val())) + expect_null(val()) # Set to a simple value val(1) @@ -99,12 +99,12 @@ test_that("ReactiveValues", { values <- reactiveValues(a=NULL, b=2) # a should exist and be NULL expect_setequal(isolate(names(values)), c("a", "b")) - expect_true(is.null(isolate(values$a))) + expect_null(isolate(values$a)) # Assigning NULL should keep object (not delete it), and set value to NULL values$b <- NULL expect_setequal(isolate(names(values)), c("a", "b")) - expect_true(is.null(isolate(values$b))) + expect_null(isolate(values$b)) # Errors ----------------------------------------------------------------- @@ -960,8 +960,8 @@ test_that("classes of reactive object", { }) test_that("{} and NULL also work in reactive()", { - expect_error(reactive({}), NA) - expect_error(reactive(NULL), NA) + expect_no_error(reactive({})) + expect_no_error(reactive(NULL)) }) test_that("shiny.suppressMissingContextError option works", { diff --git a/tests/testthat/test-render-functions.R b/tests/testthat/test-render-functions.R index fe7bbefbf..598fed3f0 100644 --- a/tests/testthat/test-render-functions.R +++ b/tests/testthat/test-render-functions.R @@ -29,8 +29,8 @@ test_that("Render functions correctly handle quosures", { r1 <- inject(renderTable({ pressure[!!a, ] }, digits = 1)) r2 <- renderTable({ eval_tidy(quo(pressure[!!a, ])) }, digits = 1) a <- 2 - expect_true(grepl("0\\.0", r1())) - expect_true(grepl("20\\.0", r2())) + expect_match(r1(), "0\\.0") + expect_match(r2(), "20\\.0") }) test_that("functionLabel returns static value when the label can not be assigned to", { diff --git a/tests/testthat/test-stacks.R b/tests/testthat/test-stacks.R index c3adc4779..b34048217 100644 --- a/tests/testthat/test-stacks.R +++ b/tests/testthat/test-stacks.R @@ -227,7 +227,7 @@ test_that("observeEvent is not overly stripped (#4162)", { }) ) st_str <- capture.output(printStackTrace(caught), type = "message") - expect_true(any(grepl("observeEvent\\(1\\)", st_str))) + expect_match(st_str, "observeEvent\\(1\\)", all = FALSE) # Now same thing, but deep stack trace version @@ -257,6 +257,6 @@ test_that("observeEvent is not overly stripped (#4162)", { ) st_str <- capture.output(printStackTrace(caught), type = "message") # cat(st_str, sep = "\n") - expect_true(any(grepl("A__", st_str))) - expect_true(any(grepl("B__", st_str))) + expect_match(st_str, "A__", all = FALSE) + expect_match(st_str, "B__", all = FALSE) }) diff --git a/tests/testthat/test-tabPanel.R b/tests/testthat/test-tabPanel.R index 0c03f6bc4..7a6c45c7f 100644 --- a/tests/testthat/test-tabPanel.R +++ b/tests/testthat/test-tabPanel.R @@ -115,7 +115,5 @@ test_that("tabItem titles can contain tag objects", { # " Hello world" # As opposed to: # "<i>Hello</i> world - expect_true( - grepl("]+>\\s*Hello\\s+world", x$html) - ) + expect_match(x$html, "]+>\\s*Hello\\s+world") }) diff --git a/tests/testthat/test-update-input.R b/tests/testthat/test-update-input.R index 369db4efc..0a4a87d27 100644 --- a/tests/testthat/test-update-input.R +++ b/tests/testthat/test-update-input.R @@ -15,22 +15,20 @@ test_that("Radio buttons and checkboxes work with modules", { updateRadioButtons(sessA, "test1", label = "Label", choices = letters[1:5]) resultA <- sessA$lastInputMessage - expect_equal("test1", resultA$id) - expect_equal("Label", resultA$message$label) - expect_equal("a", resultA$message$value) - expect_true(grepl('"modA-test1"', resultA$message$options)) - expect_false(grepl('"test1"', resultA$message$options)) - + expect_equal(resultA$id, "test1") + expect_equal(resultA$message$label, "Label") + expect_equal(resultA$message$value, "a") + expect_match(resultA$message$options, '"modA-test1"') + expect_no_match(resultA$message$options, '"test1"') sessB <- createModuleSession("modB") updateCheckboxGroupInput(sessB, "test2", label = "Label", choices = LETTERS[1:5]) resultB <- sessB$lastInputMessage - expect_equal("test2", resultB$id) - expect_equal("Label", resultB$message$label) + expect_equal(resultB$id, "test2") + expect_equal(resultB$message$label, "Label") expect_null(resultB$message$value) - expect_true(grepl('"modB-test2"', resultB$message$options)) - expect_false(grepl('"test2"', resultB$message$options)) - + expect_match(resultB$message$options, '"modB-test2"') + expect_no_match(resultB$message$options, '"test2"') }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index df462bf1d..2bcb9d7c5 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -4,7 +4,7 @@ test_that("Private randomness works at startup", { rm(".Random.seed", envir = .GlobalEnv) .globals$ownSeed <- NULL # Just make sure this doesn't blow up - expect_error(createUniqueId(4), NA) + expect_no_error(createUniqueId(4)) }) test_that("Setting process-wide seed doesn't affect private randomness", {