context("bootstrap") test_that("CSS unit validation", { # On error, return NA; on success, return result validateCssUnit_wrap <- function(x) { tryCatch(validateCssUnit(x), error = function(e) { NA_character_ }) } # Test strings and expected results strings <- c("100x", "10px", "10.4px", ".4px", "1px0", "px", "5", "%", "5%", "auto", "1auto", "") expected <- c(NA, "10px", "10.4px", ".4px", NA, NA, "5px", NA, "5%", "auto", NA, NA) results <- vapply(strings, validateCssUnit_wrap, character(1), USE.NAMES = FALSE) expect_equal(results, expected) # Numbers should return string with "px" expect_equal(validateCssUnit(100), "100px") }) test_that("Repeated names for selectInput and radioButtons choices", { # These test might be a bit too closely tied to the exact structure of the # tag object, but they get the job done for now. # Select input x <- selectInput('id','label', choices = c(a='x1', a='x2', b='x3'), selectize = FALSE) expect_true(grepl(fixed = TRUE, '', format(x) )) # Radio buttons x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3')) choices <- x$children expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], 'a') expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'x1') expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked') expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], 'a') expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'x2') expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL) expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], 'b') expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'x3') expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL) }) test_that("Choices are correctly assigned names", { # Unnamed vector expect_identical( choicesWithNames(c("a","b","3")), list(a="a", b="b", "3"="3") ) # Unnamed list expect_identical( choicesWithNames(list("a","b",3)), list(a="a", b="b", "3"="3") ) # Vector, with some named, some not expect_identical( choicesWithNames(c(A="a", "b", C="3", "4")), list(A="a", "b"="b", C="3", "4"="4") ) # List, with some named, some not expect_identical( choicesWithNames(list(A="a", "b", C=3, 4)), list(A="a", "b"="b", C="3", "4"="4") ) # List, named, with a sub-vector expect_identical( choicesWithNames(list(A="a", B="b", C=c("d", "e"))), list(A="a", B="b", C=list(d="d", e="e")) ) # List, named, with a sub-vector with numeric elements expect_identical( choicesWithNames(list(A="a", B="b", C=c(1, 2))), list(A="a", B="b", C=list(`1`="1", `2`="2")) ) # List, named, with sublist expect_identical( choicesWithNames(list(A="a", B="b", C=list("d", "e"))), list(A="a", B="b", C=list(d="d", e="e")) ) # List, named, with sublist with numeric elements expect_identical( choicesWithNames(list(A="a", B="b", C=list(1, 2))), list(A="a", B="b", C=list(`1`="1", `2`="2")) ) # List, named, with a named sub-vector of length 1 expect_identical( choicesWithNames(list(A="a", B="b", C=c(D="d"))), list(A="a", B="b", C=list(D="d")) ) # List, named, with a named sub-vector of length 1 with a numeric element expect_identical( choicesWithNames(list(A="a", B="b", C=c(D=1))), list(A="a", B="b", C=list(D="1")) ) # List, some named, with sublist expect_identical( choicesWithNames(list(A="a", "b", C=list("d", E="e"))), list(A="a", b="b", C=list(d="d", E="e")) ) # Deeper nesting expect_identical( choicesWithNames(list(A="a", "b", C=list(D=list("e", "f"), G=c(H="h", "i")))), list(A="a", b="b", C=list(D=list(e="e", f="f"), G=list(H="h", i="i"))) ) # Error when sublist is unnamed expect_error(choicesWithNames(list(A="a", "b", list(1,2)))) }) test_that("selectOptions returns correct HTML", { # None selected expect_identical( selectOptions(choicesWithNames(list("a", "b")), list()), HTML("\n") ) # One selected expect_identical( selectOptions(choicesWithNames(list("a", "b")), "a"), HTML("\n") ) # One selected, with named items expect_identical( selectOptions(choicesWithNames(list(A="a", B="b")), "a"), HTML("\n") ) # Two selected, with optgroup expect_identical( selectOptions(choicesWithNames(list("a", B=list("c", D="d"))), c("a", "d")), HTML("\n\n\n\n") ) # Escape HTML in strings expect_identical( selectOptions(choicesWithNames(list(""="a", B="b")), "a"), HTML("\n") ) }) test_that("selectInput selects items by default", { # None specified as selected (defaults to first) expect_true(grepl(fixed = TRUE, '