inst/doc/challenging-tests.R

In testthat: Unit Testing for R

## -----------------------------------------------------------------------------
library(testthat)
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")

# Pretend we're snapshotting
snapper <- local_snapshotter(fail_on_new = FALSE)
snapper$start_file("snapshotting.Rmd", "test")

# Pretend we're testing testthat so we can use mocking
Sys.setenv(TESTTHAT_PKG = "testthat")

## -----------------------------------------------------------------------------
dice <- function() {
  sample(6, 1)
}

test_that("dice returns different numbers", {
  withr::local_seed(1234)

  expect_equal(dice(), 4)
  expect_equal(dice(), 2)
  expect_equal(dice(), 6)
})

## -----------------------------------------------------------------------------
roll_three <- function() {
  sum(dice(), dice(), dice())
}

test_that("three dice adds values of individual calls", {
  local_mocked_bindings(dice = mock_output_sequence(1, 2, 3))
  expect_equal(roll_three(), 6)
})

## -----------------------------------------------------------------------------
continue <- function(prompt) {
  cat(prompt, "\n", sep = "")

  repeat {
    val <- readline("Do you want to continue? (y/n) ")
    if (val %in% c("y", "n")) {
      return(val == "y")
    }
    cat("! You must enter y or n\n")
  }  
}

readline <- NULL

## -----------------------------------------------------------------------------
test_that("user must respond y or n", {
  mock_readline <- local({
    i <- 0
    function(prompt) {
      i <<- i + 1
      cat(prompt)
      val <- if (i == 1) "x" else "y"
      cat(val, "\n", sep = "")
      val
    }
  })

  local_mocked_bindings(readline = mock_readline)
  expect_snapshot(val <- continue("This is dangerous"))
  expect_true(val)
})

## -----------------------------------------------------------------------------
f <- mock_output_sequence(1, 12, 123)
f()
f()
f()

## -----------------------------------------------------------------------------
test_that("user must respond y or n", {
  local_mocked_bindings(readline = mock_output_sequence("x", "y"))
  expect_true(continue("This is dangerous"))
})

## -----------------------------------------------------------------------------
save_file <- function(path, data) {
  if (file.exists(path)) {
    if (!continue("`path` already exists")) {
      stop("Failed to continue")
    }
  }
  writeLines(data, path)
}

test_that("save_file() requires confirmation to overwrite file", {
  path <- withr::local_tempfile(lines = letters)

  local_mocked_bindings(continue = function(...) TRUE)
  save_file(path, "a")
  expect_equal(readLines(path), "a")

  local_mocked_bindings(continue = function(...) FALSE)
  expect_snapshot(save_file(path, "a"), error = TRUE)
})