## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----eval = FALSE------------------------------------------------------------- # test_that("block constructor", { # expect_s3_class(new_test_block(), "test_block") # }) ## ----eval = FALSE------------------------------------------------------------- # test_that("test block server input widgets update reactive values", { # testServer( # app = new_test_block()$expr_server, # Capture the expression server # expr = { # session$setInputs(color = "green") # Set a color # expect_equal(color(), "green") # # session$setInputs(color = "red") # Change color # expect_equal(color(), "red") # } # ) # }) ## ----eval = FALSE------------------------------------------------------------- # test_that("state is correctly returned", { # testServer( # app = new_test_block()$expr_server, # expr = { # # First check default values # expect_equal(session$returned$state$number(), numeric()) # expect_equal(session$returned$state$color(), character()) # # # Then toggle the inputs and recheck state is updated correctly # session$setInputs(number = 1) # expect_equal(session$returned$state$number(), 1) # session$setInputs(color = "pink") # expect_equal(session$returned$state$color(), "pink") # } # ) # }) ## ----eval = FALSE------------------------------------------------------------- # test_that("expr evaluates correctly", { # testServer( # app = new_test_block()$expr_server, # expr = { # session$setInputs(number = 1) # session$setInputs(color = "cyan") # # # Call `base::eval()` on our expression # evaluated_expr <- eval(session$returned$expr()) # expect_s3_class(evaluated_expr, "colored_number") # } # ) # }) ## ----eval = FALSE------------------------------------------------------------- # test_that("incorrect colours throw an error", { # testServer( # app = new_test_block()$expr_server, # expr = { # session$setInputs(number = 2) # # # Set invalid colour # session$setInputs(color = "Ooops") # # # Check that an error is thrown # expect_error(eval(session$returned$expr())) # } # ) # }) ## ----eval = FALSE------------------------------------------------------------- # test_that("test block server input widgets update reactive values", { # testServer( # app = new_test_block()$expr_server, # # Set block arguments with the "args" argument # args = list(df = reactive(gt::gt(mtcars))), # expr = { # session$setInputs(color = "green") # expect_equal(color(), "green") # } # ) # })