inst/doc/testing-blocks.R

In blockr.core: Graphical Web-Framework for Data Manipulation and Visualization

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