Various test lints

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,

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),
     '<select class="shiny-input-select form-control" id="id"><option value="x1" selected>a</option>\n<option value="x2">a</option>\n<option value="x3">b</option></select>',
-     format(x)
-  ))
+    fixed = TRUE
+  )
 
   # Radio buttons using choices
   x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3'))
@@ -242,22 +243,25 @@ test_that("selectInput selects items by default", {
   ))
 
   # Nested list (optgroup)
-  expect_true(grepl(fixed = TRUE,
+  expect_match(
+    selectInput('x', 'x', list(A=list("a", "b"), "c")),
     '<option value="a" selected>',
-    selectInput('x', 'x', list(A=list("a", "b"), "c"))
-  ))
+    fixed = TRUE
+  )
 
   # Nothing selected when choices=NULL
-  expect_true(grepl(fixed = TRUE,
+  expect_match(
+    format(selectInput('x', NULL, NULL, selectize = FALSE)),
     '<select class="shiny-input-select form-control" id="x"></select>',
-    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,
+  expect_match(
+    selectInput('x', 'x', list("a", "b"), multiple = TRUE),
     '<option value="a">',
-    selectInput('x', 'x', list("a", "b"), multiple = TRUE)
-  ))
+    fixed = TRUE
+  )
 })
 
 test_that("normalizeChoicesArgs does its job", {

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("<svg></svg>", tmpsvg)

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("<option value=\"&quot;\">", si_str, fixed = TRUE)))
-  expect_true(any(grepl("<option value=\"&#39;\">", si_str, fixed = TRUE)))
-  expect_true(any(grepl("<optgroup label=\"&quot;Separators&quot;\">", si_str, fixed = TRUE)))
+  expect_match(si_str, "<option value=\"&quot;\">", fixed = TRUE, all = FALSE)
+  expect_match(si_str, "<option value=\"&#39;\">", fixed = TRUE, all = FALSE)
+  expect_match(si_str, "<optgroup label=\"&quot;Separators&quot;\">", 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)
       }
     }
   }

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)
 })

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", {

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", {

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)
 })

tests/testthat/test-tabPanel.R

@@ -115,7 +115,5 @@ test_that("tabItem titles can contain tag objects", {
   #   "<a ....> <i>Hello</i> world"
   # As opposed to:
   #   "<a ....>&lt;i&gt;Hello&lt;/i&gt; world
-  expect_true(
-    grepl("<a [^>]+>\\s*<i>Hello</i>\\s+world", x$html)
-  )
+  expect_match(x$html, "<a [^>]+>\\s*<i>Hello</i>\\s+world")
 })

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"')
 })

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", {