tests/testthat/test-question_text.R

In learnr: Interactive Tutorials for R

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