github/shiny
1
1
Fork 0
mirror of https://github.com/rstudio/shiny.git synced 2026-01-10 07:28:01 -05:00
Code Issues Packages Projects Releases Wiki Activity

Various test lints (#4171)

Browse Source 
Co-authored-by: Garrick Aden-Buie <garrick@adenbuie.com>
This commit is contained in:
olivroy
2025-01-21 15:08:00 -05:00
committed by GitHub
parent 7642fc84b7
commit 8ad779f949
11 changed files with 49 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
tests/testthat/test-bootstrap.r
View File

@@ -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'))
@@ -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)),
'<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,

2
tests/testthat/test-busy-indication.R
View File

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

34
tests/testthat/test-input-select.R
View File

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

2
tests/testthat/test-plot-png.R
View File

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

10
tests/testthat/test-reactivity.r
View File

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

4
tests/testthat/test-render-functions.R
View File

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

6
tests/testthat/test-stacks.R
View File

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

4
tests/testthat/test-tabPanel.R
View File

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

20
tests/testthat/test-update-input.R
View File

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

2
tests/testthat/test-utils.R
View File

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