# Test quiz() ------------------------------------------------------------- create_question <- function() { question( "Here is a question", answer("Answer A"), answer("Answer B"), answer("Answer C", correct = TRUE) ) } test_that("quiz questions can be created", { q <- create_question() expect_true(length(q$answers) > 0) a <- q$answers[[1]] expect_s3_class(a, "tutorial_quiz_answer") expect_type(a$id, "character") expect_type(a$option, "character") expect_s3_class(a$label, "html") expect_type(a$correct, "logical") expect_type(a$message, "NULL") expect_s3_class(q, "learnr_radio") expect_s3_class(q, "tutorial_question") expect_type(q$type, "character") expect_type(q$label, "NULL") expect_s3_class(q$question, "html") expect_type(q$button_labels, "list") expect_s3_class(q$button_labels$submit, "html") expect_s3_class(q$button_labels$try_again, "html") expect_type(q$messages, "list") expect_s3_class(q$messages$correct, "html") expect_s3_class(q$messages$try_again, "html") expect_s3_class(q$messages$incorrect, "html") expect_type(q$messages$message, "NULL") expect_type(q$messages$psot_message, "NULL") expect_type(q$ids, "list") expect_type(q$ids$answer, "character") expect_type(q$ids$question, "character") expect_null(q$loading) expect_type(q$random_answer_order, "logical") expect_type(q$allow_retry, "logical") expect_type(q$seed, "double") expect_type(q$options, "list") }) test_that("questions can be aggregated via quiz", { test_val <- "test value" qz <- quiz( caption = test_val, create_question(), create_question(), create_question() ) expect_true(length(qz$questions) > 0) expect_equal(as.character(qz$caption), test_val) expect_s3_class(qz, "tutorial_quiz") lapply(qz$questions, expect_s3_class, "tutorial_question") expect_s3_class }) # Test question() --------------------------------------------------------- test_that("bad ellipses are found", { expect_silent( question("title", answer("5", correct = TRUE)) ) expect_error( question("title", answer("5", correct = TRUE), typ = "auto") ) }) test_that("loading placeholder is correctly generated for HTML question texts", { expect_silent( q1 <- question(htmltools::tags$p("Did this work?"), answer("yes", correct = TRUE)) ) expect_silent( q2 <- question(htmltools::HTML("
Did this work?
"), answer("yes", correct = TRUE)) ) expect_equal(q1$loading, q2$loading) expect_silent( question( 'Does this equal two?1 + 1
', answer("yes", correct = TRUE)
)
)
expect_silent(
question(
htmltools::HTML('Does this equal two?
1 + 1
'), answer("yes", correct = TRUE)
)
)
expect_silent(
question(
text = paste(
"Does this equal two?",
"",
"```",
"1 + 1",
"```",
sep = "\n"
),
answer(2, correct =TRUE)
)
)
})
test_that("question() message depends on whether type is checkbox", {
q_radio <- question(
"test",
answer("A", correct = TRUE),
answer("B", correct = FALSE),
answer("C", correct = FALSE)
)
out_radio <- question_messages(
question = q_radio,
messages = NULL,
is_correct = FALSE,
is_done = FALSE
)
expect_equal(
as.character(out_radio[[1]]$children[[1]]),
"Incorrect"
)
q_checkbox <- question(
"test",
answer("A", correct = TRUE),
answer("B", correct = TRUE),
answer("C", correct = FALSE)
)
out_checkbox <- question_messages(
question = q_checkbox,
messages = NULL,
is_correct = FALSE,
is_done = FALSE
)
expect_equal(
as.character(out_checkbox[[1]]$children[[1]]),
"Incorrect. Be sure to select every correct answer."
)
})