First pass from claude

Author: hadley

vignettes/challenging-tests.Rmd

@@ -0,0 +1,387 @@
+---
+title: "Challenging Testing Problems"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Challenging Testing Problems}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+```{r setup}
+library(testthat)
+```
+
+Testing is easy when your functions are pure: they take some inputs and return predictable outputs. But real-world code often involves randomness, external state, graphics, user interaction, and other challenging elements. This vignette provides practical solutions for testing these tricky scenarios.
+
+## Output Affected by RNG
+
+Random number generation can make tests non-deterministic. Use `withr::local_seed()` to ensure reproducible results within your tests.
+
+### The Problem
+
+```{r, eval = FALSE}
+# This test will randomly pass or fail
+test_that("random sample has expected properties", {
+  x <- sample(1:100, 10)
+  expect_length(x, 10)
+  expect_true(all(x %in% 1:100))
+  # This might fail randomly:
+  expect_equal(x[1], 42)
+})
+```
+
+### The Solution
+
+```{r}
+test_that("random sample has expected properties", {
+  withr::local_seed(123)
+  x <- sample(1:100, 10)
+  expect_length(x, 10)
+  expect_true(all(x %in% 1:100))
+  # This will always pass now:
+  expect_equal(x[1], 31)
+})
+```
+
+For functions that internally use random numbers:
+
+```{r}
+simulate_data <- function(n) {
+  rnorm(n, mean = 0, sd = 1)
+}
+
+test_that("simulate_data returns correct structure", {
+  withr::local_seed(456)
+  result <- simulate_data(5)
+  expect_length(result, 5)
+  expect_type(result, "double")
+  # Test specific values with fixed seed
+  expect_equal(result[1], 1.048, tolerance = 0.001)
+})
+```
+
+## Output Affected by External State
+
+Tests should be isolated from global options, environment variables, and other external state that might affect behavior.
+
+### Global Options
+
+```{r}
+# Function that depends on global options
+format_number <- function(x) {
+  format(x, digits = getOption("digits"))
+}
+
+test_that("format_number respects digits option", {
+  # Save and restore the original option
+  withr::local_options(digits = 3)
+  expect_equal(format_number(pi), "3.14")
+  
+  withr::local_options(digits = 5)
+  expect_equal(format_number(pi), "3.1416")
+})
+```
+
+### Environment Variables
+
+```{r}
+# Function that depends on environment variables
+get_api_url <- function() {
+  Sys.getenv("API_URL", default = "https://api.example.com")
+}
+
+test_that("get_api_url uses environment variable", {
+  withr::local_envvar(API_URL = "https://test-api.example.com")
+  expect_equal(get_api_url(), "https://test-api.example.com")
+})
+
+test_that("get_api_url uses default when env var not set", {
+  withr::local_envvar(API_URL = NA)
+  expect_equal(get_api_url(), "https://api.example.com")
+})
+```
+
+### Working Directory
+
+```{r}
+test_that("function works in different directories", {
+  withr::local_dir(tempdir())
+  # Test code that depends on working directory
+  writeLines("test content", "temp_file.txt")
+  expect_true(file.exists("temp_file.txt"))
+  # File will be cleaned up automatically
+})
+```
+
+## Graphical Output
+
+Testing plots and other graphical output requires specialized tools. The [vdiffr](https://vdiffr.r-lib.org/) package provides visual regression testing for ggplot2 and base R graphics.
+
+### Setting Up vdiffr
+
+```{r, eval = FALSE}
+# In your test file
+library(vdiffr)
+
+test_that("plot looks correct", {
+  p <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
+  expect_doppelganger("basic scatterplot", p)
+})
+```
+
+### Base R Graphics
+
+```{r, eval = FALSE}
+test_that("base R plot is correct", {
+  expect_doppelganger("base histogram", function() {
+    hist(rnorm(100), main = "Normal Distribution")
+  })
+})
+```
+
+The first time you run these tests, vdiffr will create reference images. Subsequent runs will compare against these references and flag any visual differences.
+
+## Errors and User-Facing Text
+
+Error messages, warnings, and other user-facing text should be tested to ensure they're helpful and consistent. Snapshots are perfect for this.
+
+### Testing Error Messages
+
+```{r}
+divide_positive <- function(x, y) {
+  if (y <= 0) {
+    stop("Divisor must be positive, got: ", y)
+  }
+  x / y
+}
+
+test_that("divide_positive gives helpful error", {
+  expect_snapshot_error(divide_positive(10, -2))
+  expect_snapshot_error(divide_positive(10, 0))
+})
+```
+
+### Testing Warnings
+
+```{r}
+maybe_warn <- function(x) {
+  if (x < 0) {
+    warning("Negative value detected: ", x)
+  }
+  abs(x)
+}
+
+test_that("maybe_warn produces expected warning", {
+  expect_snapshot(maybe_warn(-5))
+})
+```
+
+### Testing Complex Output
+
+```{r}
+summarize_data <- function(x) {
+  cat("Summary of data:\n")
+  cat("Length:", length(x), "\n")
+  cat("Mean:", mean(x), "\n")
+  cat("Range:", range(x), "\n")
+}
+
+test_that("summarize_data output is correct", {
+  expect_snapshot(summarize_data(1:10))
+})
+```
+
+## HTTP Responses
+
+Testing code that makes HTTP requests requires mocking to avoid external dependencies. Use httr2 mocking for httr2-based code, or httptest2 for httr-based code.
+
+### With httr2
+
+```{r, eval = FALSE}
+library(httr2)
+
+get_user_info <- function(user_id) {
+  req <- request("https://api.example.com") |>
+    req_url_path_append("users", user_id)
+  resp <- req_perform(req)
+  resp_body_json(resp)
+}
+
+test_that("get_user_info handles successful response", {
+  # Mock the HTTP response
+  with_mocked_responses(
+    request("https://api.example.com/users/123") |>
+      req_method("GET") |>
+      mock_response(
+        status_code = 200,
+        body = '{"id": 123, "name": "Alice"}'
+      ),
+    {
+      result <- get_user_info(123)
+      expect_equal(result$id, 123)
+      expect_equal(result$name, "Alice")
+    }
+  )
+})
+```
+
+### With httptest2
+
+```{r, eval = FALSE}
+library(httptest2)
+
+test_that("API call works", {
+  with_mock_api({
+    # httptest2 will look for mock files in tests/testthat/api.example.com/
+    result <- get_user_info(123)
+    expect_equal(result$id, 123)
+  })
+})
+```
+
+## Interactivity
+
+Interactive functions that prompt for user input need mocking to work in automated tests.
+
+### Mocking User Input
+
+```{r}
+ask_yes_no <- function(question) {
+  response <- readline(paste0(question, " (y/n): "))
+  tolower(response) %in% c("y", "yes")
+}
+
+test_that("ask_yes_no handles yes response", {
+  mockery::stub(ask_yes_no, "readline", "y")
+  expect_true(ask_yes_no("Continue?"))
+})
+
+test_that("ask_yes_no handles no response", {
+  mockery::stub(ask_yes_no, "readline", "n")
+  expect_false(ask_yes_no("Continue?"))
+})
+```
+
+### Mocking File Selection
+
+```{r}
+read_user_file <- function() {
+  file_path <- file.choose()
+  readLines(file_path)
+}
+
+test_that("read_user_file works with mocked file selection", {
+  temp_file <- tempfile()
+  writeLines(c("line 1", "line 2"), temp_file)
+  
+  mockery::stub(read_user_file, "file.choose", temp_file)
+  result <- read_user_file()
+  
+  expect_equal(result, c("line 1", "line 2"))
+  unlink(temp_file)
+})
+```
+
+## Testing Many Combinations
+
+When you need to test many parameter combinations, use helper functions and loops to avoid repetitive code.
+
+### Using Helper Functions
+
+```{r}
+# Function to test
+power_function <- function(x, n) {
+  if (n < 0) stop("Negative exponents not supported")
+  if (x == 0 && n == 0) stop("0^0 is undefined")
+  x^n
+}
+
+# Helper function for testing
+test_power <- function(x, n, expected) {
+  test_that(paste0("power_function(", x, ", ", n, ") equals ", expected), {
+    expect_equal(power_function(x, n), expected)
+  })
+}
+
+# Test many combinations
+test_power(2, 3, 8)
+test_power(5, 2, 25)
+test_power(10, 0, 1)
+test_power(-3, 2, 9)
+```
+
+### Using Loops for Systematic Testing
+
+```{r}
+test_that("power_function works for multiple bases and exponents", {
+  test_cases <- data.frame(
+    x = c(2, 3, 4, 5),
+    n = c(2, 2, 2, 2),
+    expected = c(4, 9, 16, 25)
+  )
+  
+  for (i in seq_len(nrow(test_cases))) {
+    expect_equal(
+      power_function(test_cases$x[i], test_cases$n[i]),
+      test_cases$expected[i],
+      info = paste("Failed for x =", test_cases$x[i], "n =", test_cases$n[i])
+    )
+  }
+})
+```
+
+### Property-Based Testing
+
+```{r}
+test_that("power_function satisfies mathematical properties", {
+  # Test that x^0 = 1 for any non-zero x
+  for (x in c(-10, -1, 1, 2, 10, 100)) {
+    expect_equal(power_function(x, 0), 1, 
+                info = paste("x^0 should equal 1 for x =", x))
+  }
+  
+  # Test that x^1 = x for any x
+  for (x in c(-5, 0, 1, 7, 100)) {
+    expect_equal(power_function(x, 1), x,
+                info = paste("x^1 should equal x for x =", x))
+  }
+})
+```
+
+### Testing Edge Cases Systematically
+
+```{r}
+test_that("power_function handles edge cases correctly", {
+  # Test error conditions
+  error_cases <- list(
+    list(x = 5, n = -1, pattern = "Negative exponents"),
+    list(x = 0, n = 0, pattern = "0\\^0 is undefined")
+  )
+  
+  for (case in error_cases) {
+    expect_error(
+      power_function(case$x, case$n),
+      case$pattern,
+      info = paste("Expected error for x =", case$x, "n =", case$n)
+    )
+  }
+})
+```
+
+## Best Practices
+
+1. **Isolate tests**: Use `withr` functions to ensure tests don't affect each other
+2. **Make tests deterministic**: Control randomness with seeds
+3. **Test the interface**: Focus on testing user-facing behavior, not implementation details
+4. **Use appropriate tools**: Choose the right mocking/testing approach for your specific challenge
+5. **Document complex setups**: Add comments explaining why specific mocking or setup is needed
+6. **Keep tests fast**: Mock external dependencies to avoid network calls and file I/O when possible
+
+By addressing these challenging scenarios systematically, you can build confidence that your code works correctly under all conditions your users might encounter.