Testing with testthat

# A throwaway package in a temporary directory (nothing of shelf is touched).
dir <- file.path(tempdir(), "tmpkg")
invisible(capture.output(
  suppressMessages(usethis::create_package(dir, open = FALSE))
))

# Keep the messages of use_testthat(), without the line that names the path.
msgs <- character()
withCallingHandlers(
  usethis::with_project(dir, usethis::use_testthat(3)),
  message = \(m) {
    msgs <<- c(msgs, conditionMessage(m))
    invokeRestart("muffleMessage")
  }
)
cat(grep("active project", msgs, value = TRUE, invert = TRUE), sep = "")
#> ✔ Adding testthat to 'Suggests' field in DESCRIPTION.
#> ✔ Adding "3" to 'Config/testthat/edition'.
#> ✔ Creating 'tests/testthat/'.
#> ✔ Writing 'tests/testthat.R'.
#> ☐ Call `usethis::use_test()` to initialize a basic test file and open it for
#>   editing.

list.files(dir, recursive = TRUE)
#> [1] "DESCRIPTION"      "NAMESPACE"        "tests/testthat.R"
cat(readLines(file.path(dir, "tests", "testthat.R")), sep = "\n")
#> # This file is part of the standard setup for testthat.
#> # It is recommended that you do not modify it.
#> #
#> # Where should you do additional test configuration?
#> # Learn more about the roles of various files in:
#> # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
#> # * https://testthat.r-lib.org/articles/special-files.html
#>
#> library(testthat)
#> library(tmpkg)
#>
#> test_check("tmpkg")
grep("testthat", readLines(file.path(dir, "DESCRIPTION")), value = TRUE)
#> [1] "    testthat (>= 3.0.0)"    "Config/testthat/edition: 3"

Suggests:
    knitr,
    rmarkdown,
    testthat (>= 3.0.0),
    withr
Config/testthat/edition: 3
Depends:
    R (>= 4.1.0)

* checking for unstated dependencies in ‘tests’ ... WARNING
'library' or 'require' call not declared from: ‘testthat’
* checking tests ...
  Running ‘testthat.R’
 ERROR
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > # This file is part of the standard setup for testthat.
  > # It is recommended that you do not modify it.
  > #
  > # Where should you do additional test configuration?
  > # Learn more about the roles of various files in:
  > # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
  > # * https://testthat.r-lib.org/articles/special-files.html
  >
  > library(testthat)
  Error in library(testthat) : there is no package called 'testthat'
  Execution halted

Status: 1 ERROR, 1 WARNING

# This file is part of the standard setup for testthat.
# It is recommended that you do not modify it.
#
# Where should you do additional test configuration?
# Learn more about the roles of various files in:
# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
# * https://testthat.r-lib.org/articles/special-files.html

library(testthat)
library(shelf)

test_check("shelf")

tests
tests/testthat
tests/testthat/fixtures
tests/testthat/fixtures/books-small.csv
tests/testthat/helper-shelf.R
tests/testthat.R
tests/testthat/_snaps
tests/testthat/_snaps/book.md
tests/testthat/test-book.R
tests/testthat/test-clean.R
tests/testthat/test-loans.R

usethis::with_project(
  ".",
  usethis::use_test("scratch", open = FALSE),
  quiet = TRUE
)
cat(readLines("tests/testthat/test-scratch.R"), sep = "\n")
unlink("tests/testthat/test-scratch.R")
#> test_that("multiplication works", {
#>   expect_equal(2 * 2, 4)
#> })

# Loaded before every test file: a fixed "today" and a helper that reads the
# small catalogue fixture.
shelf_fixed_today <- as.Date("2026-06-30")

read_fixture_books <- function() {
  read.csv(test_path("fixtures", "books-small.csv"))
}

# A fresh session does not know test_path(): lintr cannot see where it is from.
lintr::lint_package()

# With testthat attached the same file is clean.
library(testthat)
lintr::lint_package()

tests/testthat/helper-shelf.R:6:12: warning: [object_usage_linter] no visible global function definition for 'test_path'
  read.csv(test_path("fixtures", "books-small.csv"))
           ^~~~~~~~~
ℹ No lints found.

test_that("book() trims the text fields and normalises the ISBN", {
  b <- book("  the quiet streets ", "Mara  Quill", "978-0-00-100010-0",
            "2019", "Fiction ", 214)
  expect_s3_class(b, "book")
  expect_identical(b$title, "the quiet streets")
  expect_identical(b$author, "Mara Quill")
  expect_identical(b$isbn, "9780001000100")
  expect_identical(b$year, 2019L)
  expect_identical(b$genre, "Fiction")
  expect_type(b$pages, "integer")
})

test_that("book() accepts missing optional fields", {
  b <- book("Untitled Draft")
  expect_true(is.na(b$author))
  expect_true(is.na(b$isbn))
  expect_identical(format(b), "Untitled Draft (NA, n.d.)")
})

test_that("validate_book() rejects bad values with a clear message", {
  expect_error(book(""), "a book needs a title")
  expect_error(book("X", isbn = "9780001000101"), "invalid ISBN-13")
  expect_error(book("X", year = 2200), "implausible year")
  expect_error(
    validate_book(new_book(title = c("a", "b"))),
    "every field of a book must have length 1"
  )
})

test_that("new_book() checks types only", {
  expect_error(new_book(title = 1), "is.character(title) is not TRUE",
               fixed = TRUE)
  b <- new_book(title = "x", author = "y", isbn = "z", year = 1L,
                genre = "g", pages = 2L)
  expect_identical(class(b), "book")
  expect_identical(class(unclass(b)), "list")
})

test_that("a book prints and summarises as expected", {
  b <- book("Salt and Static", "Mara Quill", "978-0-01-400145-3", 2018,
            "Mystery", 244)
  expect_snapshot(print(b))
  expect_snapshot(summary(b))
  expect_s3_class(summary(b), "summary.book")
  expect_output(print(book("Paper Moons", "Noor Haddad")), "n.d.")
})

describe("is_valid_isbn13()", {
  it("accepts hyphenated and bare forms of a valid ISBN", {
    expect_identical(
      is_valid_isbn13(c("978-0-00-100010-0", "9780001000100")),
      c(TRUE, TRUE)
    )
  })
  it("rejects wrong check digits, short strings, empty strings and NA", {
    expect_identical(
      is_valid_isbn13(c("9780001000101", "978030640615", "", NA)),
      c(FALSE, FALSE, FALSE, FALSE)
    )
  })
  it("returns a logical of the same length, including length zero", {
    expect_identical(is_valid_isbn13(character()), logical())
  })
})

# a book prints and summarises as expected

    Code
      print(b)
    Output
      <book> Salt and Static (Mara Quill, 2018)

---

    Code
      summary(b)
    Output
      Book: Salt and Static
      ISBN known: TRUE
      Pages: 244

"title","author","isbn","year","genre","pages"
"  the quiet streets ","Mara Quill","9780001000100",2019,"Fiction ",214
"Midnight Ledger","Iris Fenwick","978-0-00-300031-3",2016,"Mystery",301
"Rivers of Glass","Tomas  Arden","",2012,"Non-fiction",352

test_that("clean_books() tidies the fixture catalogue", {
  cleaned <- clean_books(read_fixture_books())
  expect_identical(cleaned$title[[1L]], "the quiet streets")
  expect_identical(cleaned$author[[3L]], "Tomas Arden")
  expect_identical(cleaned$genre, c("fiction", "mystery", "non-fiction"))
  expect_identical(cleaned$isbn, c("9780001000100", "9780003000313", NA))
})

test_that("clean_books() keeps the shape of the packaged catalogue", {
  cleaned <- clean_books(books)
  expect_identical(dim(cleaned), dim(books))
  expect_identical(names(cleaned), names(books))
  expect_identical(sum(is.na(cleaned$isbn)), 2L)
  expect_setequal(
    unique(cleaned$genre),
    c("science fiction", "classic", "fiction", "mystery", "non-fiction",
      "poetry")
  )
})

test_that("clean_loans() parses dates and repairs impossible values", {
  raw <- data.frame(
    loan_id = c("L1", "L2", "L3"),
    isbn = rep("9780001000100", 3L),
    member = c("Ana Ruiz", "ana  ruiz ", ""),
    loan_date = c("2026-01-10", "2026-02-30", "2026-03-01"),
    return_date = c("2026-01-05", "", "2026-03-20")
  )
  cleaned <- clean_loans(raw)
  expect_s3_class(cleaned$loan_date, "Date")
  expect_identical(cleaned$member, c("Ana Ruiz", "ana ruiz", NA))
  expect_true(is.na(cleaned$loan_date[[2L]]))
  expect_true(is.na(cleaned$return_date[[1L]]))
  expect_identical(cleaned$return_date[[3L]], as.Date("2026-03-20"))
})

test_that("clean_loans() leaves Date columns alone", {
  expect_identical(clean_loans(loans)$loan_date, loans$loan_date)
})

test_that("overdue_loans() counts late returns and loans still out", {
  out <- overdue_loans(loans, today = shelf_fixed_today)
  expect_true(all(out$days_out > 21L))
  expect_identical(sum(is.na(out$return_date)), 7L)
  expect_identical(nrow(out), 32L)
  expect_false(any(is.na(out$loan_date)))
})

test_that("overdue_loans() uses the current date by default", {
  local_mocked_bindings(shelf_today = function() shelf_fixed_today)
  expect_identical(
    overdue_loans(loans),
    overdue_loans(loans, today = shelf_fixed_today)
  )
})

test_that("the loan period comes from the shelf.loan_days option", {
  withr::local_options(shelf.loan_days = 60L)
  out <- overdue_loans(loans, today = shelf_fixed_today)
  expect_true(all(out$days_out > 60L))
  expect_lt(nrow(out), 32L)
})

test_that("loan_summary() reports one row per genre", {
  cleaned <- clean_books(books)
  s <- loan_summary(loans, cleaned, today = shelf_fixed_today)
  expect_named(s, c("genre", "loans", "overdue", "overdue_rate"))
  expect_identical(s$genre, sort(unique(cleaned$genre)))
  expect_true(all(s$overdue <= s$loans))
  expect_equal(s$overdue_rate, s$overdue / s$loans)
})

test_that("loans_per_month() returns months in order", {
  m <- loans_per_month(loans)
  expect_identical(m$month, sort(m$month))
  expect_identical(sum(m$loans), sum(!is.na(loans$loan_date)))
})

test_that("a long check is skipped on CRAN", {
  skip_on_cran()
  big <- loans[rep(seq_len(nrow(loans)), 50L), ]
  expect_identical(
    nrow(overdue_loans(big, today = shelf_fixed_today)),
    32L * 50L
  )
})

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

# Outside test_that() a failed expectation is an error: catch it to read it.
failure <- \(code) tryCatch(code, error = \(e) cat(conditionMessage(e), "\n"))

# Floating point: equal within tolerance, but not identical.
x <- 0.1 + 0.2
expect_equal(x, 0.3)
failure(expect_identical(x, 0.3))
#> Expected `x` to be identical to 0.3.
#> Differences:
#>   `actual`: 0.300000000000000044
#> `expected`: 0.299999999999999989
#>

# Integer vs double: identical() is strict about the type.
expect_equal(2L, 2)
failure(expect_identical(2L, 2))
#> Expected 2L to be identical to 2.
#> Differences:
#> `actual` is an integer vector (2)
#> `expected` is a double vector (2)
#>

# The default tolerance is the one of all.equal(), and it is relative.
testthat_tolerance()
#> [1] 1.490116e-08
failure(expect_equal(100, 101))
#> Expected 100 to equal 101.
#> Differences:
#>   `actual`: 100.0
#> `expected`: 101.0
#>
expect_equal(100, 101, tolerance = 0.05)

# waldo describes where two objects differ.
b1 <- book("Salt and Static", "Mara Quill", year = 2018)
b2 <- book("Salt and Static", "Mara Quill", year = 2019)
failure(expect_equal(b1, b2))
#> Expected `b1` to equal `b2`.
#> Differences:
#>   `actual$year`: 2018
#> `expected$year`: 2019
#>

# Attributes and names matter unless you ignore them.
failure(expect_equal(c(a = 1, b = 2), c(1, 2)))
#> Expected `c(a = 1, b = 2)` to equal `c(1, 2)`.
#> Differences:
#> `names(actual)` is a character vector ('a', 'b')
#> `names(expected)` is absent
#>
expect_equal(c(a = 1, b = 2), c(1, 2), ignore_attr = TRUE)

# Two data frames of different length: every differing column is reported.
failure(expect_equal(head(books[, 1:3], 2), head(books[, 1:3], 3)))
#> Expected `head(books[, 1:3], 2)` to equal `head(books[, 1:3], 3)`.
#> Differences:
#>   `attr(actual, 'row.names')`: 1 2
#> `attr(expected, 'row.names')`: 1 2 3
#>
#> actual vs expected
#>                                title            author              isbn
#>   actual[1, ]   The Dispossessed     Ursula K. Le Guin 978-0-306-40615-7
#>   actual[2, ]   Pride and Prejudice  Jane Austen       978-0-14-143951-8
#> + expected[3, ]   the quiet streets  Mara Quill        9780001000100
#>
#>     actual$title          | expected$title
#> [1] "The Dispossessed"    | "The Dispossessed"     [1]
#> [2] "Pride and Prejudice" | "Pride and Prejudice"  [2]
#>                           - "  the quiet streets " [3]
#>
#> `actual$author`:   "Ursula K. Le Guin" "Jane Austen"
#> `expected$author`: "Ursula K. Le Guin" "Jane Austen" "Mara Quill"
#>
#> `actual$isbn`:   "978-0-306-40615-7" "978-0-14-143951-8"
#> `expected$isbn`: "978-0-306-40615-7" "978-0-14-143951-8" "9780001000100"
#>

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

failure <- \(code) tryCatch(code, error = \(e) cat(conditionMessage(e), "\n"))

# Logical expectations.
expect_true(is_valid_isbn13("978-0-306-40615-7"))
expect_false(is_valid_isbn13(""))
failure(expect_true(c(TRUE, FALSE)))
#> Expected `c(TRUE, FALSE)` to be TRUE.
#> Differences:
#> `actual`:   TRUE FALSE
#> `expected`: TRUE
#>
failure(expect_true(1))
#> Expected 1 to be TRUE.
#> Differences:
#> `actual` is a double vector (1)
#> `expected` is a logical vector (TRUE)
#>
expect_null(NULL)

# Types: the typeof() of the object.
b <- book("Salt and Static", "Mara Quill", year = 2018)
expect_type(b, "list")
expect_type(b$year, "integer")
failure(expect_type(b$year, "double"))
#> Expected `b$year` to have type "double".
#> Actual type: "integer"

# S3 classes: expect_s3_class() checks inherits(), exact = TRUE the whole class.
expect_s3_class(b, "book")
expect_s3_class(summary(b), "summary.book")
failure(expect_s3_class(b, "data.frame"))
#> Expected `b` to inherit from "data.frame".
#> Actual class: "book".
failure(expect_s3_class(unclass(b), "book"))
#> Expected `unclass(b)` to be an S3 object.
#> Actual OO type: none.
expect_s3_class(books, "data.frame")
expect_s3_class(books, "data.frame", exact = TRUE)
expect_s3_class(unclass(b), NA)

# S4 classes (and S7 with expect_s7_class()) have their own expectations.
setClass("Shelf", slots = c(books = "character"))
s <- new("Shelf", books = "A")
expect_s4_class(s, "Shelf")
failure(expect_s4_class(b, "Shelf"))
#> Expected `b` to be an S4 object.
#> Actual OO type: S3.

# The vector helpers check type, length and shape in one call.
expect_vector(books$year, ptype = integer(), size = nrow(books))
expect_shape(books, dim = c(16L, 6L))
failure(expect_shape(books, nrow = 20L))
#> Expected `books` to have 20 rows.
#> Actual rows: 16.

# Since testthat 3.3.0 an expectation returns its first argument: chain them.
books |> expect_s3_class("data.frame") |> expect_length(6L)

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

failure <- \(code) tryCatch(code, error = \(e) cat(conditionMessage(e), "\n"))

genres <- unique(tolower(trimws(books$genre)))

# Length and names.
expect_length(books, 6L)
failure(expect_length(genres, 5L))
#> Expected `genres` to have length 5.
#> Actual length: 6.
expect_named(books, c("title", "author", "isbn", "year", "genre", "pages"))
failure(expect_named(books, c("title", "author")))
#> Expected `books` to have names `c("title", "author")`.
#> Differences:
#> `actual`:   "title" "author" "isbn" "year" "genre" "pages"
#> `expected`: "title" "author"
#>
expect_named(books, rev(names(books)), ignore.order = TRUE)

# Sets: order and duplicates do not matter.
expect_setequal(genres, rev(genres))
failure(expect_setequal(genres, c("fiction", "poetry", "cooking")))
#> Expected `genres` to have the same values as `c("fiction", "poetry", "cooking")`.
#> Actual: "science fiction", "classic", "fiction", "mystery", "non-fiction", "poetry"
#> Expected: "fiction", "poetry", "cooking"
#> Needs: "science fiction", "classic", "mystery", "non-fiction"
#> Absent: "cooking"

# Named lists: the same names and values, in any order.
expect_mapequal(list(a = 1, b = 2), list(b = 2, a = 1))
failure(expect_mapequal(list(a = 1, b = 2), list(a = 1, b = 3)))
#> Expected `list(a = 1, b = 2)` to contain the same values as `list(a = 1, b = 3)`.
#> Differences:
#>   `actual$b`: 2.0
#> `expected$b`: 3.0
#>

# Membership: expect_contains() and expect_in() are the two directions.
expect_contains(genres, c("poetry", "classic"))
expect_in(c("poetry", "classic"), genres)
failure(expect_contains(genres, "cooking"))
#> Expected `genres` to contain all values in "cooking".
#> Actual: "science fiction", "classic", "fiction", "mystery", "non-fiction", "poetry"
#> Expected: "cooking"
#> Missing: "cooking"
failure(expect_in("cooking", genres))
#> Expected "cooking" to only contain values from `genres`.
#> Actual: "cooking"
#> Expected: "science fiction", "classic", "fiction", "mystery", "non-fiction", "poetry"
#> Invalid: "cooking"

# Numeric comparisons and text matches.
long <- books[books$pages > 400 & !is.na(books$pages), ]
expect_lt(nrow(long), 5L)
expect_gt(mean(books$year, na.rm = TRUE), 1900)
failure(expect_gt(nrow(books), 16L))
#> Expected `nrow(books)` > 16L.
#> Actual comparison: 16 <= 16
#> Difference: 0 <= 0
expect_gte(nrow(books), 16L)
expect_match(books$title[[1L]], "^The ")
failure(expect_match(books$title[[1L]], "^A "))
#> Expected `books$title[[1L]]` to match regexp "^A ".
#> Actual text:
#> ✖ │ The Dispossessed
expect_no_match(books$title[[1L]], "cooking")

# Every element at once, with a better message than expect_true(all(...)).
expect_all_true(nchar(books$title) > 0L)
failure(expect_all_true(!is.na(books$pages)))
#> Expected every element of `!is.na(books$pages)` to equal TRUE.
#> Differences:
#> `actual[3:9]`:   TRUE TRUE TRUE FALSE TRUE TRUE TRUE
#> `expected[3:9]`: TRUE TRUE TRUE TRUE  TRUE TRUE TRUE
#>
#> `actual[12:16]`:   TRUE TRUE TRUE FALSE TRUE
#> `expected[12:16]`: TRUE TRUE TRUE TRUE  TRUE
#>
failure(expect_true(all(!is.na(books$pages))))
#> Expected `all(!is.na(books$pages))` to be TRUE.
#> Differences:
#> `actual`:   FALSE
#> `expected`: TRUE
#>

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

failure <- \(code) tryCatch(code, error = \(e) cat(conditionMessage(e), "\n"))

# expect_error() takes a regular expression for the message...
expect_error(book(""), "a book needs a title")
# ...fixed = TRUE when the message holds regular-expression characters...
expect_error(
  new_book(title = 1), "is.character(title) is not TRUE", fixed = TRUE
)
# ...and a class, which is much less fragile than the text.
expect_error(stop("no such shelf"), class = "simpleError")

# A message that does not match.
failure(expect_error(book(""), "a book needs an author"))
#> a book needs a title

# Code that does not fail, or fails in a different way.
failure(expect_error(book("A title")))
#> Expected `book("A title")` to throw a error.
failure(expect_error(stop("something else"), "a book needs a title"))
#> something else

# Warnings and messages.
expect_warning(as.integer("x"), "NAs introduced by coercion")
expect_message(message("loading"), "loading")
failure(expect_warning(1 + 1))
#> Expected `1 + 1` to throw a warning.

# A custom condition class is matched by class =.
shelf_condition <- structure(
  class = c("shelf_overdue", "warning", "condition"),
  list(message = "3 loans are overdue", call = NULL)
)
expect_warning(warning(shelf_condition), class = "shelf_overdue")
expect_condition(warning(shelf_condition), "overdue")

# The expectation returns the condition, so you can inspect it.
cnd <- expect_error(book(""), "title")
class(cnd)
#> [1] "simpleError" "error"       "condition"
conditionMessage(cnd)
#> [1] "a book needs a title"

# No condition at all.
expect_no_error(book("A title"))
expect_no_warning(as.integer("1"))
expect_no_message(1 + 1)
failure(expect_no_error(book("")))
#> Expected `book("")` not to throw any errors.
#> Actually got a <simpleError> with message:
#>   a book needs a title
failure(expect_no_warning(as.integer("x")))
#> Expected `as.integer("x")` not to throw any warnings.
#> Actually got a <simpleWarning> with message:
#>   NAs introduced by coercion

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

failure <- \(code) tryCatch(code, error = \(e) cat(conditionMessage(e), "\n"))

b <- book("Paper Moons", "Noor Haddad")

# Printed output: a regular expression, or NA for "no output at all".
expect_output(print(b), "n.d.")
failure(expect_output(print(b), "2018"))
#> Expected output from `print(b)` to match regexp "2018".
#> Actual output:
#> ✖ │ <book> Paper Moons (Noor Haddad, n.d.)
expect_output(invisible(b), NA)
failure(expect_output(print(b), NA))
#> Expected `print(b)` to produce no output.
#> Actual output:
#> <book> Paper Moons (Noor Haddad, n.d.)

# capture.output() gives the text that expect_output() matches against.
out <- capture.output(print(b))
out
#> [1] "<book> Paper Moons (Noor Haddad, n.d.) "
expect_identical(out, "<book> Paper Moons (Noor Haddad, n.d.) ")

# expect_silent(): no output, no messages, no warnings.
expect_silent(format(b))
failure(expect_silent(print(b)))
#> Expected `print(b)` to run silently.
#> Actual noise: output.
failure(expect_silent(as.integer("x")))
#> Expected `as.integer("x")` to run silently.
#> Actual noise: warnings.

# Visible and invisible results.
expect_invisible(invisible(1))
expect_visible(format(b))
failure(expect_invisible(format(b)))
#> Expected `format(b)` to return invisibly.
#> Actual visibility: visible.

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
set_reporter(StopReporter$new(praise = FALSE))
books <- shelf::books

# A custom expectation: capture the label, fail or pass, return the input.
expect_valid_isbn <- function(object) {
  act <- quasi_label(rlang::enquo(object))
  ok <- shelf::is_valid_isbn13(act$val)
  if (!all(ok)) {
    fail(c(
      sprintf("Expected every element of %s to be a valid ISBN-13.", act$lab),
      sprintf("Invalid: %s", toString(dQuote(act$val[!ok], FALSE)))
    ))
  } else {
    pass()
  }
  invisible(act$val)
}

# Expectations are functions: test them with expect_success()/expect_failure().
test_that("expect_valid_isbn() reports one success or one failure", {
  expect_success(expect_valid_isbn(books$isbn[1:5]))
  expect_failure(expect_valid_isbn(books$isbn))
})

# And look at the message that a user would see.
tryCatch(
  test_that("the failure message names the bad ISBNs", {
    expect_valid_isbn(books$isbn)
  }),
  error = \(e) invisible(NULL)
)
#> ── Failure: the failure message names the bad ISBNs ────────────────────────────
#> Expected every element of `books$isbn` to be a valid ISBN-13.
#> Invalid: "", "978-0-01-100112-9"

test_that("a failing check", {
  expect_equal(nrow(overdue_loans(loans, today = shelf_fixed_today)), 31L)
})

* checking tests ...
  Running ‘testthat.R’
 ERROR
Running the tests in ‘tests/testthat.R’ failed.
Last 13 lines of output:
  ══ Skipped tests (2) ═══════════════════════════════════════════════════════════
  • On CRAN (2): 'test-book.R:39:1', 'test-loans.R:40:3'

  ══ Failed tests ════════════════════════════════════════════════════════════════
  ── Failure ('test-failing.R:2:3'): a failing check ─────────────────────────────
  Expected `nrow(overdue_loans(loans, today = shelf_fixed_today))` to equal 31L.
  Differences:
    `actual`: 32
  `expected`: 31


  [ FAIL 1 | WARN 0 | SKIP 2 | PASS 49 ]
  Error:
  ! Test failures.
  Execution halted
* checking for unstated dependencies in vignettes ... OK
* checking package vignettes ... OK
* checking re-building of vignette outputs ... OK
* checking for non-standard things in the check directory ... OK
* checking for detritus in the temp directory ... OK
* DONE

Status: 1 ERROR

shelf.Rcheck/tests:
startup.Rs
testthat
testthat.R
testthat.Rout.fail

shelf.Rcheck/tests/testthat/_problems:
test-failing-2.R

# Extracted from test-failing.R:2

# setup ------------------------------------------------------------------------
library(testthat)
test_env <- simulate_test_env(package = "shelf", path = "..")
attach(test_env, warn.conflicts = FALSE)

# test -------------------------------------------------------------------------
expect_equal(nrow(overdue_loans(loans, today = shelf_fixed_today)), 31L)

# Throw the stored snapshots away to see what a first run looks like.
unlink("tests/testthat/_snaps", recursive = TRUE)
devtools::test()
list.files("tests/testthat/_snaps")
devtools::test()

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✔ |   2     24 | book
────────────────────────────────────────────────────────────────────────────────
Warning ('test-book.R:42:3'): a book prints and summarises as expected
Adding new snapshot:
Code
  print(b)
Output
  <book> Salt and Static (Mara Quill, 2018)

Warning ('test-book.R:43:3'): a book prints and summarises as expected
Adding new snapshot:
Code
  summary(b)
Output
  Book: Salt and Static
  ISBN known: TRUE
  Pages: 244
────────────────────────────────────────────────────────────────────────────────

✔ |         14 | clean

✔ |         14 | loans

══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 0 | WARN 2 | SKIP 0 | PASS 52 ]
[1] "book.md"
ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✔ |         24 | book

✔ |         14 | clean

✔ |         14 | loans

══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 52 ]

# Remember the originals so that the script can put them back at the end.
book_r <- readLines("R/book.R")
snap <- readLines("tests/testthat/_snaps/book.md")

# Change what print.book() prints: "<book>" becomes "<Book>".
changed <- sub('cat("<book>"', 'cat("<Book>"', book_r, fixed = TRUE)
writeLines(changed, "R/book.R")

# The snapshot no longer matches: the test fails and a .new.md file appears.
devtools::test(filter = "book")
list.files("tests/testthat/_snaps")

# The change is deliberate: accept it, which replaces book.md by book.new.md.
testthat::snapshot_accept("book")
list.files("tests/testthat/_snaps")
setdiff(readLines("tests/testthat/_snaps/book.md"), snap)

# Clean up: restore the source and the snapshot.
writeLines(book_r, "R/book.R")
writeLines(snap, "tests/testthat/_snaps/book.md")

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✖ | 1       23 | book
────────────────────────────────────────────────────────────────────────────────
Failure ('test-book.R:42:3'): a book prints and summarises as expected
Snapshot of code has changed:
old vs new
  Code
    print(b)
  Output
-   <book> Salt and Static (Mara Quill, 2018)
+   <Book> Salt and Static (Mara Quill, 2018)
* Run `testthat::snapshot_accept("book")` to accept the change.
* Run `testthat::snapshot_review("book")` to review the change.
────────────────────────────────────────────────────────────────────────────────

══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 1 | WARN 0 | SKIP 0 | PASS 23 ]
[1] "book.md"     "book.new.md"
Updating snapshots: 'book.md'.
[1] "book.md"
[1] "      <Book> Salt and Static (Mara Quill, 2018) "

# Remember the stored snapshot, then throw it away to simulate a forgotten file.
snap <- readLines("tests/testthat/_snaps/book.md")
unlink("tests/testthat/_snaps", recursive = TRUE)

# CI services set CI=true (GitHub Actions does): a new snapshot now fails.
Sys.setenv(CI = "true")
devtools::test(filter = "book")

# Put the stored snapshot back.
dir.create("tests/testthat/_snaps", showWarnings = FALSE)
writeLines(snap, "tests/testthat/_snaps/book.md")

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✖ | 2       24 | book
────────────────────────────────────────────────────────────────────────────────
Failure ('test-book.R:42:3'): a book prints and summarises as expected
Adding new snapshot:
Code
  print(b)
Output
  <book> Salt and Static (Mara Quill, 2018)

Failure ('test-book.R:43:3'): a book prints and summarises as expected
Adding new snapshot:
Code
  summary(b)
Output
  Book: Salt and Static
  ISBN known: TRUE
  Pages: 244
────────────────────────────────────────────────────────────────────────────────

══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 2 | WARN 0 | SKIP 0 | PASS 24 ]

# A scratch test file that uses the other snapshot expectations.
writeLines(
  trimws(r"---(
test_that("an invalid book is snapshotted with its error", {
  expect_snapshot(book("X", isbn = "9780001000101"), error = TRUE)
})

test_that("messages and warnings are recorded with the code", {
  expect_snapshot({
    x <- as.integer("x")
    message("loaded ", nrow(books), " books")
    summary(book("Paper Moons", "Noor Haddad", pages = 120))
  })
})

test_that("a value is snapshotted in a readable form", {
  expect_snapshot_value(loans_per_month(loans)[1:2, ], style = "deparse")
})

test_that("a file is snapshotted as a whole", {
  path <- withr::local_tempfile(fileext = ".csv")
  write.csv(loans_per_month(loans)[1:3, ], path, row.names = FALSE)
  expect_snapshot_file(path, "months.csv")
})

test_that("variable text is cleaned with transform", {
  path <- withr::local_tempfile(fileext = ".csv")
  expect_snapshot(
    cat("saved to", path, "\n"),
    transform = \(lines) gsub(path, "<path>", lines, fixed = TRUE)
  )
})

test_that("a snapshot can depend on the R version", {
  variant <- paste0("r", getRversion()$major, ".", getRversion()$minor)
  expect_snapshot(print(loans_per_month(loans)[1:2, ]), variant = variant)
})
)---", whitespace = "\n"),
  "tests/testthat/test-snapshots.R"
)

# The first run creates every snapshot (the reporter is silenced here).
invisible(devtools::test(filter = "snapshots", reporter = "silent"))
list.files("tests/testthat/_snaps", recursive = TRUE)
cat(readLines("tests/testthat/_snaps/snapshots.md"), sep = "\n")
cat(readLines("tests/testthat/_snaps/snapshots/months.csv"), sep = "\n")
cat(readLines("tests/testthat/_snaps/r4.6/snapshots.md"), sep = "\n")

# Clean up the scratch test and its snapshots.
unlink("tests/testthat/test-snapshots.R")
unlink(
  file.path("tests/testthat/_snaps", c("snapshots.md", "snapshots", "r4.6")),
  recursive = TRUE
)
list.files("tests/testthat/_snaps")

[1] "book.md"              "r4.6/snapshots.md"    "snapshots.md"
[4] "snapshots/months.csv"
# an invalid book is snapshotted with its error

    Code
      book("X", isbn = "9780001000101")
    Condition
      Error:
      ! invalid ISBN-13: 9780001000101

# messages and warnings are recorded with the code

    Code
      x <- as.integer("x")
    Condition
      Warning:
      NAs introduced by coercion
    Code
      message("loaded ", nrow(books), " books")
    Message
      loaded 16 books
    Code
      summary(book("Paper Moons", "Noor Haddad", pages = 120))
    Output
      Book: Paper Moons
      ISBN known: FALSE
      Pages: 120

# a value is snapshotted in a readable form

    structure(list(month = c("2025-01", "2025-02"), loans = c(4L,
    2L)), row.names = 1:2, class = "data.frame")

# variable text is cleaned with transform

    Code
      cat("saved to", path, "\n")
    Output
      saved to <path>

"month","loans"
"2025-01",4
"2025-02",2
"2025-03",3
# a snapshot can depend on the R version

    Code
      print(loans_per_month(loans)[1:2, ])
    Output
          month loans
      1 2025-01     4
      2 2025-02     2

[1] "book.md"

# A scratch setup file and a test file that depends on it.
writeLines(
  trimws(r"---(
withr::local_options(shelf.quiet = TRUE, .local_envir = teardown_env())
message("setup-scratch.R: the setup file ran")
withr::defer(message("setup-scratch.R: the teardown ran"), teardown_env())
)---", whitespace = "\n"),
  "tests/testthat/setup-scratch.R"
)
writeLines(
  trimws(r"---(
test_that("the setup file has run before the tests", {
  expect_true(getOption("shelf.quiet"))
  expect_identical(shelf_fixed_today, as.Date("2026-06-30"))
  expect_true(file.exists(test_path("fixtures", "books-small.csv")))
  message("test-scratch.R: inside the test")
})
)---", whitespace = "\n"),
  "tests/testthat/test-scratch.R"
)

devtools::test(filter = "scratch")

# Outside a test, load_all() sources the helpers but not the setup files.
devtools::load_all(quiet = TRUE)
shelf_fixed_today
is.null(getOption("shelf.quiet"))
testthat::test_path("fixtures", "books-small.csv")

unlink(c("tests/testthat/setup-scratch.R", "tests/testthat/test-scratch.R"))

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
setup-scratch.R: the setup file ran
✔ | F W  S  OK | Context
test-scratch.R: inside the test
✔ |          3 | scratch
══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 3 ]
setup-scratch.R: the teardown ran
shelf 0.1.0: loan period is 21 days
[1] "2026-06-30"
[1] TRUE
[1] "tests/testthat/fixtures/books-small.csv"

library(testthat)

# Ask testthat to compare these pieces of global state before and after a test.
set_state_inspector(function() {
  list(
    digits = getOption("digits"),
    shelf_env = Sys.getenv("SHELF_ENV", NA)
  )
})

writeLines(
  trimws(r"---(
test_that("a polite test restores what it changes", {
  withr::local_options(digits = 3L)
  expect_true(TRUE)
})

test_that("a test that leaks an option", {
  options(digits = 4L)
  expect_true(TRUE)
})

test_that("a test that leaks an environment variable", {
  Sys.setenv(SHELF_ENV = "leak")
  expect_true(TRUE)
})
)---", whitespace = "\n"),
  "tests/testthat/test-leaky.R"
)

devtools::test(filter = "leaky")

unlink("tests/testthat/test-leaky.R")

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✔ |   2      3 | leaky
────────────────────────────────────────────────────────────────────────────────
Warning ('test-leaky.R:6:1'): a test that leaks an option
Global state has changed:
`before$digits`: 7
 `after$digits`: 4

Warning ('test-leaky.R:11:1'): a test that leaks an environment variable
Global state has changed:
`before$shelf_env`: NA
`after$shelf_env`:  "leak"
────────────────────────────────────────────────────────────────────────────────

══ Results ═════════════════════════════════════════════════════════════════════
[ FAIL 0 | WARN 2 | SKIP 0 | PASS 3 ]

library(testthat)
set_reporter(StopReporter$new(praise = FALSE))
loans <- shelf::loans

# shelf_today() is internal: shelf:: cannot reach it, shelf::: can.
tryCatch(shelf::shelf_today(), error = \(e) conditionMessage(e))
#> [1] "'shelf_today' is not an exported object from 'namespace:shelf'"
inherits(shelf:::shelf_today(), "Date")
#> [1] TRUE

# Which environment owns the function? The package, until it is replaced.
owner <- \() environmentName(environment(shelf:::shelf_today))
owner()
#> [1] "shelf"

# Outside the package's own tests, name the package whose binding to mock.
test_that("shelf_today() can be replaced for one test", {
  local_mocked_bindings(
    shelf_today = \() as.Date("2026-06-30"),
    .package = "shelf"
  )
  expect_identical(shelf:::shelf_today(), as.Date("2026-06-30"))
  print(owner())
  expect_identical(nrow(shelf::overdue_loans(loans)), 32L)
})
#> [1] ""

# After the test the original function is back.
owner()
#> [1] "shelf"

# The same replacement for a block of code only.
with_mocked_bindings(
  nrow(shelf::overdue_loans(loans)),
  shelf_today = \() as.Date("2026-06-30"),
  .package = "shelf"
)
#> [1] 32

# Only bindings that already exist can be mocked.
tryCatch(
  local_mocked_bindings(not_a_function = \() 1, .package = "shelf"),
  error = \(e) conditionMessage(e)
)
#> [1] "Can't find binding for `not_a_function`"

# Base functions such as Sys.Date are not bindings of the package namespace.
tryCatch(
  local_mocked_bindings(
    Sys.Date = \() as.Date("2026-06-30"),
    .package = "shelf"
  ),
  error = \(e) conditionMessage(e)
)
#> [1] "Can't find binding for `Sys.Date`"

# A mock that returns different values in turn, such as answers to a prompt.
test_that("mock_output_sequence() returns its values one at a time", {
  answer <- mock_output_sequence("3", "n")
  expect_identical(answer(), "3")
  expect_identical(answer(), "n")
  expect_error(answer(), "Can't find value for 3th iteration")
})

# A scratch test file that skips for several reasons.
writeLines(
  trimws(r"---(
test_that("a test that needs a service", {
  skip("the catalogue server is down")
  expect_true(FALSE)
})

test_that("a test that needs a suggested package", {
  skip_if_not_installed("nosuchpackage")
  expect_true(FALSE)
})

test_that("a test for newer versions of R only", {
  skip_unless_r(">= 99.0.0")
  expect_true(FALSE)
})

test_that("a test that runs everywhere", {
  skip_on_os("windows")
  expect_true(TRUE)
})

test_that("a test that has not been written yet", {
  x <- 1
})
)---", whitespace = "\n"),
  "tests/testthat/test-skips.R"
)

devtools::test(filter = "skips")

unlink("tests/testthat/test-skips.R")

ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✔ |      4   1 | skips

══ Results ═════════════════════════════════════════════════════════════════════
── Skipped tests (4) ───────────────────────────────────────────────────────────
• {nosuchpackage} is not installed (1): 'test-skips.R:7:3'
• Current R version (4.6.1) does not satisfy requirement (>= 99.0.0) (1):
  'test-skips.R:12:3'
• empty test (1): 'test-skips.R:21:1'
• the catalogue server is down (1): 'test-skips.R:2:3'

[ FAIL 0 | WARN 0 | SKIP 4 | PASS 1 ]

skip_if_no_token <- function() {
  skip_if_not(file.exists("secure-token.json"), "no token")
}

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
source("scenario.R")

# In the 3rd edition the old helpers still run, but each one warns.
deprecation <- \(code) {
  tryCatch({
    code
    "no warning"
  }, warning = \(w) conditionMessage(w))
}

b <- book("Salt and Static", "Mara Quill", year = 2018)
deprecation(expect_is(b, "book"))
#> [1] "`expect_is()` was deprecated in the 3rd edition.\nℹ Use `expect_type()`, `expect_s3_class()`, or `expect_s4_class()` instead"
deprecation(expect_equivalent(c(a = 1), 1))
#> [1] "`expect_equivalent()` was deprecated in the 3rd edition.\nℹ Use expect_equal(ignore_attr = TRUE)"
deprecation(context("book"))
#> [1] "`context()` was deprecated in the 3rd edition."
deprecation(setup(NULL))
#> [1] "`setup()` was deprecated in the 3rd edition.\nℹ Please use test fixtures instead see vignette('test-fixtures') for details"
deprecation(teardown(NULL))
#> [1] "`teardown()` was deprecated in the 3rd edition.\nℹ Please use test fixtures instead see vignette('test-fixtures') for details"
deprecation(expect_that(1, equals(1)))
#> [1] "`expect_that()` was deprecated in the 3rd edition."
deprecation(expect_known_value(1, tempfile()))
#> [1] "`expect_known_value()` was deprecated in the 3rd edition.\nℹ Please use `expect_snapshot_value()` instead"

# with_mock() and local_mock() were removed in testthat 3.3.0.
tryCatch(with_mock(sqrt = \(x) 0, sqrt(4)), error = \(e) conditionMessage(e))
#> [1] "`with_mock()` was deprecated in testthat 3.2.0 and is now defunct.\nℹ Please use `with_mocked_bindings()` instead."

library(testthat)
Sys.setenv(TESTTHAT_EDITION = "3")
set_reporter(StopReporter$new(praise = FALSE))

# Outside a test.
c(Sys.getenv("TESTTHAT", "<unset>"), getOption("width"), is_testing())
#> [1] "<unset>" "80"      "FALSE"

# Inside test_that() testthat makes the output reproducible.
test_that("tests run in a controlled context", {
  cat("TESTTHAT:", Sys.getenv("TESTTHAT"), "\n")
  cat("width:", getOption("width"), "\n")
  cat("unicode:", getOption("cli.unicode"), "\n")
  cat("collation:", Sys.getlocale("LC_COLLATE"), "\n")
  expect_true(is_testing())
  expect_false(is_checking())
  expect_false(is_snapshot())
})
#> TESTTHAT: true
#> width: 80
#> unicode: FALSE
#> collation: C

# local_reproducible_output() lets one test ask for something else.
test_that("a test can change the console width", {
  local_reproducible_output(width = 40L)
  cat("width:", getOption("width"), "\n")
  expect_identical(getOption("width"), 40L)
})
#> width: 40

library(testthat)

# One file: load the package from source first (test_file() does not).
test_file(
  "tests/testthat/test-clean.R",
  package = "shelf", load_package = "source", reporter = "check"
)

# One test of a file (testthat 3.2.0 and later), found by its description.
test_file(
  "tests/testthat/test-book.R",
  desc = "validate_book() rejects bad values with a clear message",
  package = "shelf", load_package = "source", reporter = "check"
)

# A directory, filtered by the part of the file name after "test-".
# test_dir() does not set NOT_CRAN, so the skip_on_cran() test is skipped.
test_dir(
  "tests/testthat", filter = "loans|clean",
  package = "shelf", load_package = "source", reporter = "check"
)

# test_local() is devtools::test() without devtools: it assumes not on CRAN.
test_local(".", filter = "loans|clean", reporter = "check")

# The value is a testthat_results list that converts to a data frame.
res <- test_local(".", filter = "book", reporter = "silent")
class(res)
head(as.data.frame(res)[, c("file", "nb", "failed", "skipped")], 3L)

shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 14 ]
shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 4 ]
shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 1 | PASS 27 ]

══ Skipped tests (1) ═══════════════════════════════════════════════════════════
• On CRAN (1): 'test-loans.R:40:3'

[ FAIL 0 | WARN 0 | SKIP 1 | PASS 27 ]
shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 28 ]
shelf 0.1.0: loan period is 21 days
[1] "testthat_results"
         file nb failed skipped
1 test-book.R  7      0   FALSE
2 test-book.R  3      0   FALSE
3 test-book.R  4      0   FALSE

library(testthat)

run <- \(reporter) {
  test_local(".", filter = "clean", reporter = reporter)
}

# The one-line-per-expectation dot reporter.
invisible(run("minimal"))

# Where each expectation is, handy to find a hanging test.
out <- capture.output(invisible(run("location")))
head(out[nzchar(out)], 6L)

# What R CMD check shows: the counts, plus details only for problems.
invisible(run("check"))

# Machine-readable output: TAP, and JUnit XML for CI servers.
out <- capture.output(invisible(run("tap")))
head(out, 4L)
xml <- tempfile(fileext = ".xml")
invisible(run(JunitReporter$new(file = xml)))
sum(grepl("<testcase ", readLines(xml), fixed = TRUE))

shelf 0.1.0: loan period is 21 days
..............
shelf 0.1.0: loan period is 21 days
[1] "Start test: clean_books() tidies the fixture catalogue"
[2] "  'test-clean.R:3:3' [success]"
[3] "  'test-clean.R:4:3' [success]"
[4] "  'test-clean.R:5:3' [success]"
[5] "  'test-clean.R:6:3' [success]"
[6] "End test: clean_books() tidies the fixture catalogue"
shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 14 ]
shelf 0.1.0: loan period is 21 days
[1] "1..14"
[2] "ok 1 clean_books() tidies the fixture catalogue"
[3] "ok 2 clean_books() tidies the fixture catalogue"
[4] "ok 3 clean_books() tidies the fixture catalogue"
shelf 0.1.0: loan period is 21 days
[1] 14

# A scratch file that sorts before the others and fails twice.
writeLines(
  trimws(r"---(
test_that("first failure", expect_identical(1L, 2L))
test_that("second failure", expect_identical("a", "b"))
)---", whitespace = "\n"),
  "tests/testthat/test-aaa-failing.R"
)

# Stop after the first failing file instead of running everything.
testthat::set_max_fails(1L)
Sys.getenv("TESTTHAT_MAX_FAILS")
devtools::test()

# Inf lifts the limit again.
testthat::set_max_fails(Inf)
unlink("tests/testthat/test-aaa-failing.R")

[1] "1"
ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
✔ | F W  S  OK | Context

✖ | 2        0 | aaa-failing
────────────────────────────────────────────────────────────────────────────────
Failure ('test-aaa-failing.R:1:1'): first failure
Expected 1L to be identical to 2L.
Differences:
  `actual`: 1
`expected`: 2


Failure ('test-aaa-failing.R:2:1'): second failure
Expected "a" to be identical to "b".
Differences:
`actual`:   "a"
`expected`: "b"

────────────────────────────────────────────────────────────────────────────────

Maximum number of failures exceeded; quitting.
ℹ Increase this number with (e.g.) `testthat::set_max_fails(Inf)`

# Switch parallel testing on in DESCRIPTION (and put it back at the end).
description <- readLines("DESCRIPTION")
writeLines(c(description, "Config/testthat/parallel: true"), "DESCRIPTION")
tail(readLines("DESCRIPTION"), 2L)

# Two worker processes; the "check" reporter prints only the totals.
Sys.setenv(TESTTHAT_CPUS = "2")
devtools::test(reporter = "check")

# TESTTHAT_PARALLEL=false runs the files in this process again.
Sys.setenv(TESTTHAT_PARALLEL = "false")
devtools::test(reporter = "check")

writeLines(description, "DESCRIPTION")

[1] "LazyData: true"                 "Config/testthat/parallel: true"
ℹ Testing shelf
Starting 2 test processes.
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 52 ]
ℹ Testing shelf
shelf 0.1.0: loan period is 21 days
[ FAIL 0 | WARN 0 | SKIP 0 | PASS 52 ]

source("scenario.R")

# stopifnot(): silent when everything is TRUE, an error otherwise.
stopifnot(is_valid_isbn13("978-0-306-40615-7"), nrow(books) == 16L)
caught <- \(code) tryCatch(code, error = \(e) conditionMessage(e))
caught(stopifnot(nrow(books) == 20L))
#> [1] "nrow(books) == 20L is not TRUE"
caught(stopifnot("every ISBN must be valid" = all(is_valid_isbn13(books$isbn))))
#> [1] "every ISBN must be valid"
caught(stopifnot(all.equal(1, 1.1)))
#> [1] "1 and 1.1 are not equal:\n  Mean relative difference: 0.1"

# all.equal() describes the difference; identical() only says yes or no.
all.equal(0.1 + 0.2, 0.3)
#> [1] TRUE
all.equal(1, 1.1)
#> [1] "Mean relative difference: 0.1"
all.equal(c(a = 1), c(b = 1))
#> [1] "Names: 1 string mismatch"
identical(0.1 + 0.2, 0.3)
#> [1] FALSE
isTRUE(all.equal(100, 100.0000001))
#> [1] TRUE

# The tools package has assertions for conditions.
tools::assertError(book(""))
tools::assertWarning(as.integer("x"))
caught(tools::assertError(book("A title")))
#> [1] "Failed to get error in evaluating book(\"A title\")"
caught(tools::assertWarning(book("A title")))
#> [1] "Failed to get warning in evaluating book(\"A title\")"

name: R-CMD-check
on:
  push:
    branches: [main]
  pull_request:

jobs:
  check:
    runs-on: ubuntu-latest
    steps:
      - uses: actions/checkout@v4
      - uses: r-lib/actions/setup-r@v2
        with:
          use-public-rspm: true
      - uses: r-lib/actions/setup-r-dependencies@v2
        with:
          extra-packages: any::rcmdcheck
          needs: check
      - uses: r-lib/actions/check-r-package@v2

  coverage:
    runs-on: ubuntu-latest
    env:
      CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
    steps:
      - uses: actions/checkout@v4
      - uses: r-lib/actions/setup-r@v2
        with:
          use-public-rspm: true
      - uses: r-lib/actions/setup-r-dependencies@v2
        with:
          extra-packages: any::covr
          needs: coverage
      - name: Test coverage
        run: covr::codecov(quiet = FALSE)
        shell: Rscript {0}