test_that("question text uses textAreaInput if rows or cols are provided", {
ans <- answer("", TRUE)
q_textArea_rows <- question_ui_initialize(question_text("A", ans, rows = 3), "")
expect_equal(q_textArea_rows$children[[2]]$name, "textarea")
expect_equal(q_textArea_rows$children[[2]]$attribs$rows, 3)
q_textArea_cols <- question_ui_initialize(question_text("A", ans, cols = 40), "")
expect_equal(q_textArea_cols$children[[2]]$name, "textarea")
expect_equal(q_textArea_cols$children[[2]]$attribs$cols, 40)
q_textArea <- question_ui_initialize(question_text("A", ans, rows = 4, cols = 30), "")
expect_equal(q_textArea$children[[2]]$name, "textarea")
expect_equal(q_textArea$children[[2]]$attribs$rows, 4)
expect_equal(q_textArea$children[[2]]$attribs$cols, 30)
q_text <- question_ui_initialize(question_text("A", ans), "")
expect_equal(q_text$children[[2]]$name, "input")
expect_equal(q_text$children[[2]]$attribs$type, "text")
})
test_that("question_text() answer functions work", {
q <- question_text(
text = "test",
trim = FALSE,
answer_fn(function(x) {
if (grepl("[Rr]", x)) {
incorrect("No R allowed")
} else {
correct("good")
}
})
)
expect_marked_as(
question_is_correct(q, "problem"),
correct = FALSE,
messages = "No R allowed"
)
expect_marked_as(
question_is_correct(q, "cool"),
correct = TRUE,
messages = "good"
)
})
test_that("question_text() evaluates answers in order specified", {
lifecycle::expect_deprecated(
question_text(
text = "test",
answer("apple"),
answer("banana", correct = TRUE),
random_answer_order = TRUE
)
)
q <- question_text(
text = "test",
trim = TRUE,
answer(" R ", TRUE, "the only good letter"),
answer_fn(function(x) {
if (grepl("[Rr]", x)) {
incorrect("No R allowed")
} else if (nchar(x) > 2) {
correct("good")
}
})
)
# literal answer checked first...
expect_marked_as(
question_is_correct(q, " R "),
correct = TRUE,
messages = quiz_text("the only good letter")
)
# followed by answer function answers
expect_marked_as(
question_is_correct(q, "problem"),
correct = FALSE,
messages = "No R allowed"
)
expect_marked_as(
question_is_correct(q, "cool"),
correct = TRUE,
messages = "good"
)
# fallback value if literal and answer functions don't match
expect_marked_as(
question_is_correct(q, "no"),
correct = FALSE
)
})
test_that("question_text() requires some text input", {
shiny::withReactiveDomain(NULL, {
q <- question_text(text = "test", answer("R", TRUE))
expect_error(question_is_correct(q, ""), "text")
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.