fix filter_item tests

R/selectInput_column.R

@@ -16,7 +16,7 @@
 #'
 #' @importFrom shiny selectizeInput
 #'
-columnSelectInput <- function(inputId, label, data, choices = names(data),
+columnSelectInput <- function(inputId, label, data, choices = names,
     selected = "", ..., placeholder = "", onInitialize) {
 
   datar <- if (is.reactive(data)) data else reactive(data)

R/shiny_data_filter_item.R

@@ -53,7 +53,7 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) {
 #' @export
 #'
 shiny_data_filter_item <- function(input, output, session, data,
-    column_name = NULL, choices = names(data),
+    column_name = NULL, choices = names,
     verbose = FALSE) {
 
   ns <- session$ns

tests/shinytest/shinytest_shiny_data_filter_item/app.R

@@ -10,7 +10,7 @@ srv <- function(input, output, session) {
     shinyDataFilter::shiny_data_filter_item,
     "filter",
     data = reactive(data)))
-  
+
   output$data_display <- renderPrint({
     print(filtered_data()$data())
   })

tests/testthat.R

@@ -1,4 +1,9 @@
 library(testthat)
+library(shinytest)
 library(shinyDataFilter)
 
-test_check("shinyDataFilter")
+if (!shinytest::dependenciesInstalled()) {
+  warning("tests cannot be run because shinytest dependencies are not available")
+} else {
+  test_check("shinyDataFilter")
+}

tests/testthat/test_shiny_data_filter.R

@@ -44,10 +44,10 @@ app$setInputs(`data_filter-filter_3-vector_filter-param` = c(5, 10))
 test_that("test that nrow reactive value is accurate", {
   expect_equal(
     app$getValue("data_summary"),
-    renderPrint(subset(airquality, 
+    renderPrint(subset(airquality,
       (Ozone >= 30 & Ozone <= 90) &
       (is.na(Wind) | (Wind >= 5 & Wind <= 10))
     ))())
 })
 
-app$stop()
+app$finalize()

tests/testthat/test_shiny_data_filter_item.R

@@ -7,8 +7,6 @@ data[which((data * 0.987) %% 0.2 < 0.01, arr.ind = TRUE)] <- NA
 app_path <- shinyDataFilter:::shinytest_path("shinytest_shiny_data_filter_item")
 app <- shinytest::ShinyDriver$new(app_path)
 
-
-
 test_that("test that filter item initializes with column select", {
   expect_true(!"filter-vector_filter-param" %in% app$listWidgets())
 })
@@ -44,4 +42,4 @@ test_that("test editing column removes vector filter", {
 })
 
 
-app$stop()
+app$finalize()

tests/testthat/test_shiny_vector_filter_character.R

@@ -12,18 +12,18 @@ app$waitFor("test_in-param")
 test_that("testing that character vectors get filtered properly", {
   app$setInputs(`test_in-param` = "a")
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_mask"), 
+    app$getValue("test_mask"),
     renderPrint(grepl("a", data))())
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     !any(is.na(filtered_data))
   })
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     any(is.na(filtered_data))
@@ -35,18 +35,18 @@ test_that("testing that character vectors get filtered properly", {
 test_that("testing that character vector filter code builds properly", {
   app$setInputs(`test_in-param` = "b")
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(grepl("b", tolower(.x), fixed = TRUE)))())
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(is.na(.x) | grepl("b", tolower(.x), fixed = TRUE)))())
 })
 
 
 
-app$stop()
+app$finalize()

tests/testthat/test_shiny_vector_filter_factor.R

@@ -12,18 +12,18 @@ app$waitFor("test_in-param")
 test_that("testing that factor (many) vectors get filtered properly", {
   app$setInputs(`test_in-param` = c("a", "b"))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_mask"), 
+    app$getValue("test_mask"),
     renderPrint(data %in% c("a", "b"))())
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     !any(is.na(filtered_data))
   })
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     any(is.na(filtered_data))
@@ -35,15 +35,15 @@ test_that("testing that factor (many) vectors get filtered properly", {
 test_that("testing that factor (many) vector filter code builds properly", {
   app$setInputs(`test_in-param` = c("d", "c"))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(.x %in% c("d", "c")))())
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(.x %in% c(NA, "d", "c")))())
 })
 
@@ -57,18 +57,18 @@ app$setInputs(`data_dput` = paste(capture.output(dput(data)), collapse = "\n"))
 test_that("testing that factor (few) vectors get filtered properly", {
   app$setInputs(`test_in-param` = c("a", "b"))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_mask"), 
+    app$getValue("test_mask"),
     renderPrint(data %in% c("a", "b"))())
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     !any(is.na(filtered_data))
   })
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     any(is.na(filtered_data))
@@ -80,18 +80,18 @@ test_that("testing that factor (few) vectors get filtered properly", {
 test_that("testing that factor (few) vector filter code builds properly", {
   app$setInputs(`test_in-param` = c("c", "a"))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(.x %in% c("a", "c")))())
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(.x %in% c(NA, "a", "c")))())
 })
 
 
 
-app$stop()
+app$finalize()

tests/testthat/test_shiny_vector_filter_numeric.R

@@ -11,18 +11,18 @@ app$waitFor("test_in-param")
 test_that("testing that numeric vectors get filtered properly", {
   app$setInputs(`test_in-param` = c(3, 6))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_mask"), 
+    app$getValue("test_mask"),
     renderPrint(data >= 3 & data <= 6)())
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     !any(is.na(filtered_data))
   })
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_true({
     filtered_data <- eval(parse(text = app$getValue("test_filtered_dput")))
     any(is.na(filtered_data))
@@ -34,15 +34,15 @@ test_that("testing that numeric vectors get filtered properly", {
 test_that("testing that numeric vector filter code builds properly", {
   app$setInputs(`test_in-param` = c(5, 8))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(.x >= 5 & .x <= 8))())
-  
+
   app$setInputs(`filter_na` = FALSE)
-  
+
   expect_equal(
-    app$getValue("test_code"), 
+    app$getValue("test_code"),
     renderPrint(quote(is.na(.x) | (.x >= 5 & .x <= 8)))())
 })
 
@@ -51,11 +51,11 @@ test_that("testing that numeric vector filter code builds properly", {
 test_that("testing that numeric vector filter builds a plot", {
   app$setInputs(`test_in-param` = c(5, 8))
   app$setInputs(`filter_na` = TRUE)
-  
+
   expect_true({
     all(grep("data:image/png", app$getAllValues()$output$`test_in-plot`$src))
   })
 })
 
 
-app$stop()
+app$finalize()

tests/testthat/test_shiny_vector_filter_unknown.R

@@ -8,11 +8,9 @@ app$setInputs(`data_dput` = paste(capture.output(dput(data)), paste = "\n"))
 app$waitFor("data_display")
 
 
-
 test_that("testing that unknown datatypes show error message", {
   expect_true(grepl("don't know how to ", app$getValue("data_display")))
 })
 
 
-
-app$stop()
+app$finalize()