tests/testthat/test-vignette-arl-chunks.R

In arl: Embedded Lisp Dialect

# Tests that all {arl} code chunks in generated vignettes evaluate without error.
#
# This catches stale references, broken examples, and bad asserts in all
# vignettes (both auto-generated lang-*.Rmd and hand-written ones).  The
# Makefile ensures `make test` regenerates lang docs before running tests.

# Find package root (DESCRIPTION lives there).
pkg_root <- function() {
  wd <- getwd()
  for (root in c(wd, file.path(wd, ".."), file.path(wd, "..", ".."))) {
    if (file.exists(file.path(root, "DESCRIPTION")))
      return(normalizePath(root, winslash = "/"))
  }
  wd
}

# Extract {arl} chunks from an Rmd file.  Returns a list of
# list(code, eval, error_ok, label) for each chunk.
extract_arl_chunks <- function(path) {
  lines <- readLines(path, warn = FALSE)
  chunks <- list()
  i <- 1L
  while (i <= length(lines)) {
    m <- regmatches(lines[i], regexec("^```\\{arl([^}]*)\\}", lines[i]))[[1]]
    if (length(m) == 2L) {
      opts_str <- m[2]
      eval <- !grepl("eval\\s*=\\s*FALSE", opts_str)
      error_ok <- grepl("error\\s*=\\s*TRUE", opts_str)
      label <- sub(".*label\\s*=\\s*[\"']([^\"']+)[\"'].*", "\\1",
                    opts_str, perl = TRUE)
      if (label == opts_str) label <- sprintf("chunk-%d", length(chunks) + 1L)
      code_lines <- character(0)
      i <- i + 1L
      while (i <= length(lines) && lines[i] != "```") {
        code_lines <- c(code_lines, lines[i])
        i <- i + 1L
      }
      chunks <- c(chunks, list(list(
        code = paste(code_lines, collapse = "\n"),
        eval = eval,
        error_ok = error_ok,
        label = label
      )))
    }
    i <- i + 1L
  }
  chunks
}

# Test all vignettes that may contain {arl} chunks
vignette_dir <- file.path(pkg_root(), "vignettes")
all_rmds <- list.files(vignette_dir, pattern = "\\.Rmd$", full.names = TRUE)

skip_if(length(all_rmds) == 0, "No .Rmd vignettes found")

# Use a single engine with full stdlib loaded (mirrors knitr setup)
arl:::reset_arl_engine()
engine <- arl:::get_arl_engine()

for (rmd_path in all_rmds) {
  rmd_name <- basename(rmd_path)
  chunks <- extract_arl_chunks(rmd_path)

  for (chunk in chunks) {
    if (!chunk$eval || !nzchar(trimws(chunk$code))) next
    # Chunks with error=TRUE intentionally demonstrate errors; skip them
    if (chunk$error_ok) next

    test_that(sprintf("%s: %s evaluates without error", rmd_name, chunk$label), {
      # Suppress warnings — some chunks intentionally demonstrate warn()
      expect_no_error(
        suppressWarnings(arl:::evaluate_arl_code(engine, chunk$code))
      )
    })
  }
}