run-tests.lisp
Rama main · réplica de lectura del repositorio original.
;;;; run-tests.lisp — the canonical Lisp-level entry point for cl-cc's tests.
;;;;
;;;; sbcl --script run-tests.lisp [--suite unit|integration|e2e|conformance] [--no-warm-stdlib]
;;;;
;;;; This file holds the test plan itself. `nix run .#test` and `checks.default`
;;;; both reach it; the only thing Nix adds is a `--core` snapshot with :cl-cc,
;;;; :cl-cc-cli and :cl-cc-testing-framework already loaded, which turns a
;;;; multi-minute ASDF compile into a load of pre-built FASLs. The plan below is
;;;; identical either way, so the fast path cannot drift from the plain one.
;;;;
;;;; Everything here is loaded one form at a time, which matters: the package
;;;; prefixes further down (cl-cc/expand:, cl-cc/pipeline::, cl-weave:) do not
;;;; exist until the `asdf:load-system` form has run, and `load` does not read
;;;; ahead.
(require :asdf)
(require :uiop)
;;; Under `--core`, ASDF already knows every cl-cc system and its FASLs, and the
;;; source registry points into the Nix store; re-registering from the working
;;; directory there would discard the pre-built FASLs. So only bootstrap the
;;; registry when the system is genuinely absent, i.e. on a plain
;;; `sbcl --script run-tests.lisp`.
(let ((here (uiop:pathname-directory-pathname
(or *load-truename* (uiop:getcwd)))))
(unless (asdf:find-system "cl-cc/test" nil)
;; cl-cc.asd registers every packages/*/ system plus "cl-cc/test" and
;; "cl-cc/test/e2e" through its own eval-when blocks.
(asdf:load-asd (merge-pathnames "cl-cc.asd" here))))
;;; *default-pathname-defaults* and uiop:*temporary-directory* are baked into
;;; the core at build-sandbox time; reset both to real runtime values.
;;; uiop:*temporary-directory* must be set via (uiop:temporary-directory) — NOT
;;; nil. Setting it to nil and then passing it as :defaults to make-pathname
;;; hangs SBCL 2.6.1 on macOS ARM64; (uiop:temporary-directory) reads TMPDIR
;;; from the runtime environment and caches the result.
(setf *default-pathname-defaults* (uiop:getcwd))
(setf uiop:*temporary-directory* (uiop:temporary-directory))
;;; The test system is deliberately NOT baked into the core image: test files
;;; have top-level forms that would otherwise capture Nix sandbox paths in
;;; globals. It is loaded fresh, after the working-directory reset above, so any
;;; top-level path computation sees the real CWD.
(format t "# loading cl-cc/test~%")
(handler-case (asdf:load-system "cl-cc/test")
(error (e)
(format *error-output* "~&FATAL: ~A~%" e)
(uiop:quit 1)))
;;; Reset *macro-eval-fn* to a mutex-wrapped #'eval so test bodies run under the
;;; host CL, not the cl-cc VM. pipeline-selfhost.lisp sets it to #'our-eval at
;;; load time; leaving it as our-eval causes sb-ext:with-timeout interrupts to be
;;; swallowed inside the VM loop, hanging test workers indefinitely.
;;;
;;; The mutex serialises concurrent SBCL compiler invocations: on macOS 26 ARM64
;;; with SBCL 2.6.1, four or more parallel workers calling eval simultaneously
;;; (via compiler-macro expansion in invoke-registered-expander) deadlock on GC
;;; safepoints while the SBCL compiler holds internal locks. The lock is captured
;;; by the closure; %with-isolated-macro-environment identity-rebinds
;;; *macro-eval-fn* so all threads share the same mutex.
(let ((lock (sb-thread:make-mutex :name "macro-eval-lock")))
(setf cl-cc/expand:*macro-eval-fn*
(lambda (form) (sb-thread:with-mutex (lock) (eval form)))))
;;; The core image is produced in a Nix build sandbox, so the baked stdlib
;;; disk-cache path may point under /nix/var/nix/builds. Rebase it to the
;;; caller's runtime HOME before the optional warm step.
(let ((home (uiop:getenv "HOME")))
(when home
(setf cl-cc/pipeline::*stdlib-cache-directory*
(merge-pathnames #P".cache/cl-cc/"
(uiop:ensure-directory-pathname (pathname home))))))
;;; Pre-warm BOTH stdlib caches in the main thread (single-threaded, safe). The
;;; core bakes *stdlib-expanded-cache-eval-fn* = #'our-eval and a
;;; *stdlib-vm-snapshot* compiled under our-eval. After the *macro-eval-fn* reset
;;; above, both caches are stale. Without pre-warming, all parallel workers
;;; simultaneously see cache misses and race to rebuild unprotected globals
;;; (*stdlib-expanded-cache*, *stdlib-vm-snapshot*, ...). On macOS ARM64 SBCL,
;;; concurrent large allocations (857-line stdlib) during GC safepoint windows
;;; can deadlock threads waiting on watchdog-lock. warm-stdlib-cache rebuilds
;;; both caches under *macro-eval-fn* = #'eval so workers see cache HITs and
;;; bypass both rebuild paths entirely.
;;;
;;; Skippable with --no-warm-stdlib or CLCC_WARM_STDLIB=0, which is how the
;;; warm path itself gets exercised as a code path rather than assumed.
(let* ((args (uiop:command-line-arguments))
(filter (loop for rest on args
when (and (string= (first rest) "--filter")
(second rest))
return (second rest)))
(suite-name
(or (loop for rest on args
when (string= (first rest) "--suite")
do (unless (second rest)
(error "--suite requires a value."))
(return (second rest)))
"unit"))
(suite
(cond
((string-equal suite-name "unit") 'cl-cc/test:cl-cc-unit-suite)
((string-equal suite-name "integration") 'cl-cc/test:cl-cc-integration-suite)
((string-equal suite-name "e2e") 'cl-cc/test:cl-cc-e2e-suite)
((string-equal suite-name "conformance") 'cl-cc/test:cl-cc-conformance-suite)
(t (error "Unknown test suite ~S. Expected unit, integration, e2e, or conformance."
suite-name))))
(warm-env (uiop:getenv "CLCC_WARM_STDLIB"))
(worker-env (uiop:getenv "CL_CC_TEST_WORKERS"))
(max-workers
(when worker-env
(let ((value (parse-integer worker-env)))
(unless (plusp value)
(error "CL_CC_TEST_WORKERS must be a positive integer, got ~S."
worker-env))
value)))
(warm-stdlib (and (not (member "--no-warm-stdlib" args :test #'string=))
(not (and warm-env
(member (string-downcase warm-env)
'("0" "false" "no" "off")
:test #'string=))))))
(handler-case
(progn
(if warm-stdlib
(progn
(format t "# warming stdlib cache~%")
(cl-cc:warm-stdlib-cache)
(format t "# stdlib cache ready~%"))
(progn
(format t "# stdlib cache warm skipped~%")
(format t "# forcing serial test execution (max-workers=1) because stdlib cache warming is disabled~%")
(setf max-workers 1)))
(format t "# starting test plan (~A)~%" suite-name)
(uiop:quit
(if (cl-cc/test:run-tests :reporter :spec
:name-filter filter
:max-workers max-workers
:suite suite)
0
1)))
(error (e)
(format t "~¬ ok - test runner failed: ~A~%" e)
(format *error-output* "~&FATAL: ~A~%" e)
(uiop:quit 1))))