mirror of
https://github.com/SHOGGOTH-SECTOR/sica-fondt.git
synced 2026-07-31 16:16:26 +00:00
b6bcab794f
Mechanical structure-only pass (no document/guide content edits): - Move src/ichor, src/endocrine, and docs/ into core/; the old top-level mafiabot_core/ becomes core/. Everything now lives under a single core/ root. - Drop the "mafiabot" label from the Ada/Alire crate: core.gpr (project Core), alire.toml name = "core"; the generated *_config.* regenerate as core_config.*. - Repoint build-critical wiring only: - .claude/skills/run-sica-fondt/smoke.sh (ponyc + Ada + COBOL paths) - core/src/endocrine R source()/runner paths and the test glob - .github/workflows/ci.yml (working-directory + gpr name) Verified green: smoke ALL GREEN (Pony Ichor, Ada core crate + tests, COBOL E1 vault); R endocrine 14/0; Octave ETR 26/0/1. Deferred (reserved for a less-ephemeral doc/guide pass): docmap.yaml, the guide files and nested AGENTS.md/README prose + now-stale relative links, SOUL.md, and the deeper ring/storage restructure. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_015hmgREHNsxYCuim33yUF2c
116 lines
3.3 KiB
R
116 lines
3.3 KiB
R
# --- Minimal Test Framework ---
|
|
# Dependency-free assertion harness for the endocrine / Drive-Box R reference track.
|
|
# No external packages (no testthat) so it runs under a bare r-base-core install.
|
|
#
|
|
# Usage in a test_*.R file:
|
|
# source("src/endocrine/test_framework.R")
|
|
# source("src/endocrine/driver_<name>.R")
|
|
# test_case("does the thing", function() {
|
|
# expect_equal(f(2), 4)
|
|
# expect_true(is_alive(state))
|
|
# })
|
|
# test_summary() # prints results and quits with status 0 (all pass) or 1 (any fail)
|
|
#
|
|
# All source() paths are repo-root-relative; run from the repository root
|
|
# (run_tests.sh handles the cd).
|
|
|
|
.TEST <- new.env()
|
|
.TEST$pass <- 0L
|
|
.TEST$fail <- 0L
|
|
.TEST$failures <- character(0)
|
|
.TEST$current <- "(top level)"
|
|
|
|
.record_pass <- function() {
|
|
.TEST$pass <- .TEST$pass + 1L
|
|
}
|
|
|
|
.record_fail <- function(msg) {
|
|
.TEST$fail <- .TEST$fail + 1L
|
|
full <- sprintf("[%s] %s", .TEST$current, msg)
|
|
.TEST$failures <- c(.TEST$failures, full)
|
|
cat(sprintf(" FAIL: %s\n", full))
|
|
}
|
|
|
|
# Assert two values are equal. Numerics compared within tolerance; everything
|
|
# else with identical().
|
|
expect_equal <- function(actual, expected, tol = 1e-9, label = "") {
|
|
ok <- FALSE
|
|
if (is.numeric(actual) && is.numeric(expected) &&
|
|
length(actual) == length(expected)) {
|
|
ok <- all(abs(actual - expected) <= tol)
|
|
} else {
|
|
ok <- identical(actual, expected)
|
|
}
|
|
if (isTRUE(ok)) {
|
|
.record_pass()
|
|
} else {
|
|
.record_fail(sprintf("%sexpected %s, got %s",
|
|
if (nzchar(label)) paste0(label, ": ") else "",
|
|
format(expected), format(actual)))
|
|
}
|
|
invisible(ok)
|
|
}
|
|
|
|
expect_true <- function(cond, label = "") {
|
|
if (isTRUE(cond)) {
|
|
.record_pass()
|
|
} else {
|
|
.record_fail(sprintf("%sexpected TRUE, got %s",
|
|
if (nzchar(label)) paste0(label, ": ") else "",
|
|
format(cond)))
|
|
}
|
|
invisible(isTRUE(cond))
|
|
}
|
|
|
|
expect_false <- function(cond, label = "") {
|
|
if (identical(cond, FALSE)) {
|
|
.record_pass()
|
|
} else {
|
|
.record_fail(sprintf("%sexpected FALSE, got %s",
|
|
if (nzchar(label)) paste0(label, ": ") else "",
|
|
format(cond)))
|
|
}
|
|
invisible(identical(cond, FALSE))
|
|
}
|
|
|
|
# Assert that evaluating expr raises an R error.
|
|
expect_error <- function(expr, label = "") {
|
|
raised <- FALSE
|
|
tryCatch(
|
|
force(expr),
|
|
error = function(e) { raised <<- TRUE }
|
|
)
|
|
if (raised) {
|
|
.record_pass()
|
|
} else {
|
|
.record_fail(sprintf("%sexpected an error, none raised",
|
|
if (nzchar(label)) paste0(label, ": ") else ""))
|
|
}
|
|
invisible(raised)
|
|
}
|
|
|
|
# Group assertions under a description. Errors thrown inside body count as a
|
|
# failure rather than aborting the whole test file.
|
|
test_case <- function(desc, body) {
|
|
prev <- .TEST$current
|
|
.TEST$current <- desc
|
|
cat(sprintf("- %s\n", desc))
|
|
tryCatch(
|
|
body(),
|
|
error = function(e) .record_fail(sprintf("unexpected error: %s", conditionMessage(e)))
|
|
)
|
|
.TEST$current <- prev
|
|
invisible(NULL)
|
|
}
|
|
|
|
# Print the tally and exit with a CI-friendly status code.
|
|
test_summary <- function() {
|
|
cat(sprintf("\nRESULT: PASS %d / FAIL %d\n", .TEST$pass, .TEST$fail))
|
|
if (.TEST$fail > 0L) {
|
|
cat("Failures:\n")
|
|
for (f in .TEST$failures) cat(sprintf(" - %s\n", f))
|
|
quit(save = "no", status = 1L)
|
|
}
|
|
quit(save = "no", status = 0L)
|
|
}
|