W2-23 control: failing registered test

.github/workflows/ci.yml

@@ -40,6 +40,27 @@ jobs:
           cachix-cache: ${{ vars.CACHIX_CACHE }}
           cachix-auth-token: ${{ secrets.CACHIX_AUTH_TOKEN }}
 
+      - name: Confirm a registered test failure makes ASDF fail
+        shell: bash
+        run: |
+          log="$RUNNER_TEMP/asdf-control.log"
+          set +e
+          nix develop --command sbcl --noinform --non-interactive \
+            --eval '(require :asdf)' \
+            --eval '(asdf:test-system "cl-cc-javascript")' > "$log" 2>&1
+          status=$?
+          set -e
+          cat "$log"
+          if [ "$status" -eq 0 ]; then
+            echo "::error::ASDF unexpectedly accepted the intentional test failure."
+            exit 1
+          fi
+          if ! grep -Fq "cl-cc-javascript tests failed" "$log"; then
+            echo "::error::ASDF failed before the test system reported its expected failure."
+            exit 1
+          fi
+          echo "Observed the expected ASDF failure (exit $status)."
+
       # Runs the SBCL test suite (checks.default), the treefmt formatting gate
       # (checks.formatting), and the mkdocs --strict build (checks.docs).
       # Add `--all-systems` only when the flake declares more than one system.

flake.nix

@@ -395,6 +395,24 @@
                 touch "$out/passed"
               '';
 
+          orphan-tests =
+            pkgs.runCommand "cl-cc-javascript-orphan-tests"
+              {
+                nativeBuildInputs = [
+                  pkgs.sbcl
+                  pkgs.python3
+                ];
+              }
+              ''
+                export HOME="$TMPDIR/home"
+                mkdir -p "$HOME" "$out"
+                ${pkgs.python3}/bin/python3 ${self}/scripts/check-orphan-tests.py \
+                  --root ${self} \
+                  --sbcl ${pkgs.sbcl}/bin/sbcl \
+                  --allowlist ${self}/t/orphan-test-allowlist.tsv
+                touch "$out/passed"
+              '';
+
           # The compile gate is kept as its own check so a pure load failure is
           # distinguishable from a test failure without reading the log.
           compile = self.packages.${system}.cl-cc-javascript;

scripts/check-orphan-tests.py

@@ -0,0 +1,155 @@
+import argparse
+import subprocess
+import sys
+from pathlib import Path
+
+
+def parse_args():
+    root = Path(__file__).resolve().parent.parent
+    parser = argparse.ArgumentParser()
+    parser.add_argument("--root", type=Path, default=root)
+    parser.add_argument("--sbcl", default="sbcl")
+    parser.add_argument("--asd-file", default="cl-cc-javascript.asd")
+    parser.add_argument("--test-root", default="t")
+    parser.add_argument("--allowlist", default="t/orphan-test-allowlist.tsv")
+    return parser.parse_args()
+
+
+def asdf_test_components(root, sbcl, asd_file, test_root):
+    lisp_asd_file = asd_file.replace("\\", "\\\\").replace('"', '\\"')
+    expression = f'''(progn
+(asdf:load-asd (truename "{lisp_asd_file}"))
+(let ((system (asdf:find-system "cl-cc-javascript/test")))
+  (labels ((emit-files (component)
+             (if (typep component 'asdf:parent-component)
+                 (mapc #'emit-files (asdf:component-children component))
+                 (format t "ASDF-COMPONENT ~A~%"
+                         (namestring (asdf:component-pathname component))))))
+    (emit-files system))))
+'''
+    result = subprocess.run(
+        [
+            sbcl,
+            "--noinform",
+            "--non-interactive",
+            "--eval",
+            "(require :asdf)",
+            "--eval",
+            expression,
+        ],
+        cwd=root,
+        text=True,
+        capture_output=True,
+        check=False,
+    )
+    if result.returncode:
+        sys.stderr.write(result.stdout)
+        sys.stderr.write(result.stderr)
+        raise RuntimeError(f"SBCL/ASDF component inspection failed: {result.returncode}")
+
+    prefix = "ASDF-COMPONENT "
+    paths = []
+    for line in result.stdout.splitlines():
+        if line.startswith(prefix):
+            paths.append(Path(line[len(prefix):]).resolve())
+    if not paths:
+        raise RuntimeError("ASDF component inspection returned no test files")
+
+    root = root.resolve()
+    test_root = test_root.resolve()
+    relative_paths = []
+    for path in paths:
+        try:
+            relative = path.relative_to(root).as_posix()
+        except ValueError as error:
+            raise RuntimeError(f"ASDF component is outside the repository: {path}") from error
+        if path.suffix != ".lisp" or not path.is_relative_to(test_root.resolve()):
+            raise RuntimeError(f"Unexpected test component path: {relative}")
+        relative_paths.append(relative)
+    return relative_paths
+
+
+def read_allowlist(path):
+    entries = []
+    errors = []
+    for line_number, raw_line in enumerate(path.read_text().splitlines(), start=1):
+        if not raw_line.strip() or raw_line.lstrip().startswith("#"):
+            continue
+        fields = raw_line.split("\t")
+        if len(fields) != 2:
+            errors.append(f"{path}:{line_number}: expected path<TAB>reason")
+            continue
+        relative, reason = fields
+        candidate = Path(relative)
+        if candidate.is_absolute() or ".." in candidate.parts or candidate.as_posix() != relative:
+            errors.append(f"{path}:{line_number}: invalid repository-relative path {relative!r}")
+            continue
+        if not reason.strip():
+            errors.append(f"{path}:{line_number}: missing reason for {relative}")
+            continue
+        entries.append((relative, reason))
+    return entries, errors
+
+
+def main():
+    args = parse_args()
+    root = args.root.resolve()
+    test_root = (root / args.test_root).resolve()
+    allowlist_path = root / args.allowlist
+    asd_path = root / args.asd_file
+    if not test_root.is_dir():
+        raise RuntimeError(f"test directory does not exist: {test_root}")
+    if not asd_path.is_file():
+        raise RuntimeError(f"ASDF definition does not exist: {asd_path}")
+    if not allowlist_path.is_file():
+        raise RuntimeError(f"orphan allowlist does not exist: {allowlist_path}")
+
+    discovered = {
+        path.relative_to(root).as_posix()
+        for path in test_root.rglob("*.lisp")
+        if path.is_file()
+    }
+    components = asdf_test_components(root, args.sbcl, args.asd_file, test_root)
+    registered = set(components)
+    entries, errors = read_allowlist(allowlist_path)
+    allowlisted = {path for path, _reason in entries}
+
+    duplicates = sorted(path for path in allowlisted if sum(item == path for item, _ in entries) > 1)
+    if duplicates:
+        errors.append("duplicate allowlist entries: " + ", ".join(duplicates))
+
+    missing_components = sorted(registered - discovered)
+    if missing_components:
+        errors.append("ASDF components missing from test tree: " + ", ".join(missing_components))
+
+    missing_allowlist = sorted(allowlisted - discovered)
+    if missing_allowlist:
+        errors.append("allowlist paths missing from test tree: " + ", ".join(missing_allowlist))
+
+    registered_allowlist = sorted(allowlisted & registered)
+    if registered_allowlist:
+        errors.append("allowlisted tests are already registered: " + ", ".join(registered_allowlist))
+
+    orphan = sorted(discovered - registered - allowlisted)
+    stale_allowlist = sorted(allowlisted - discovered)
+    print(
+        f"found={len(discovered)} registered={len(registered)} "
+        f"allowlisted={len(allowlisted)} orphan={len(orphan)}"
+    )
+    if orphan:
+        errors.append("unregistered test files: " + ", ".join(orphan))
+    if stale_allowlist:
+        errors.append("stale allowlist entries: " + ", ".join(stale_allowlist))
+    if errors:
+        for error in errors:
+            print(error, file=sys.stderr)
+        return 1
+    return 0
+
+
+if __name__ == "__main__":
+    try:
+        raise SystemExit(main())
+    except (OSError, RuntimeError) as error:
+        print(error, file=sys.stderr)
+        raise SystemExit(1)

t/e2e-ast-test.lisp

@@ -85,8 +85,44 @@ const doubled = nums.map(x => x * 2);
 const evens = nums.filter(x => x % 2 === 0);
 const sum = nums.reduce((acc, x) => acc + x, 0);
 ")))
-    (expect (>= (length asts) 1) :to-be-truthy)
-    (expect (cl-cc/ast:ast-let-p (first asts)) :to-be-truthy)))
+    (labels ((binding-named (name nodes)
+               (loop for node in nodes
+                     when (cl-cc/ast:ast-let-p node)
+                       thereis
+                         (or (find name (cl-cc/ast:ast-let-bindings node)
+                                   :key (lambda (binding) (symbol-name (car binding)))
+                                   :test #'string-equal)
+                             (binding-named name (cl-cc/ast:ast-let-body node)))))
+             (higher-order-call-p (method arity binding)
+               (let* ((call (cdr binding))
+                      (callee (and (cl-cc/ast:ast-call-p call)
+                                   (cl-cc/ast:ast-call-func call)))
+                      (property-args (and (cl-cc/ast:ast-call-p callee)
+                                          (cl-cc/ast:ast-call-args callee)))
+                      (args (and (cl-cc/ast:ast-call-p call)
+                                 (cl-cc/ast:ast-call-args call)))
+                      (callback (first args)))
+                 (and (cl-cc/ast:ast-call-p call)
+                      (cl-cc/ast:ast-call-p callee)
+                      (equal "%JS-GET-PROP" (%js-call-name callee))
+                      (= 2 (length property-args))
+                      (cl-cc/ast:ast-quote-p (second property-args))
+                      (stringp (cl-cc/ast:ast-quote-value (second property-args)))
+                      (string-equal method (cl-cc/ast:ast-quote-value (second property-args)))
+                      (= arity (length args))
+                      (cl-cc/ast:ast-lambda-p callback)
+                      (= arity (length (cl-cc/ast:ast-lambda-params callback)))))))
+      (let ((nums (binding-named "nums" asts))
+            (doubled (binding-named "doubled" asts))
+            (evens (binding-named "evens" asts))
+            (sum (binding-named "sum" asts)))
+        (expect (and nums
+                     (cl-cc/ast:ast-call-p (cdr nums))
+                     (equal "%JS-MAKE-ARRAY" (%js-call-name (cdr nums)))
+                     (= 5 (length (cl-cc/ast:ast-call-args (cdr nums))))) :to-be-truthy)
+        (expect (higher-order-call-p "map" 1 doubled) :to-be-truthy)
+        (expect (higher-order-call-p "filter" 1 evens) :to-be-truthy)
+        (expect (higher-order-call-p "reduce" 2 sum) :to-be-truthy)))))
 
 ;;; ─── 4. Class with inheritance ────────────────────────────────────────────────
 
@@ -184,7 +220,46 @@ export function add(a, b) { return a + b; }
 export function subtract(a, b) { return a - b; }
 export const PI = 3.14159;
 ")))
-    (expect (>= (length asts) 0) :to-be-truthy)))
+    (labels ((export-info (node)
+               (let ((args (and (cl-cc/ast:ast-call-p node)
+                                (equal "%JS-EXPORT" (%js-call-name node))
+                                (cl-cc/ast:ast-call-args node))))
+                 (when (and (= 4 (length args))
+                            (cl-cc/ast:ast-quote-p (first args))
+                            (cl-cc/ast:ast-quote-p (fourth args)))
+                   (list (cl-cc/ast:ast-quote-value (first args))
+                         (cl-cc/ast:ast-quote-value (fourth args))
+                         (second args))))))
+      (let* ((infos (mapcar #'export-info asts))
+             (declarations (mapcar #'third infos)))
+        (expect (= 3 (length asts)) :to-be-truthy)
+        (expect (every #'identity infos) :to-be-truthy)
+        (expect (mapcar #'first infos) :to-equal
+                '(:declaration :declaration :declaration))
+        (expect (mapcar #'second infos) :to-equal
+                '(("add") ("subtract") ("PI")))
+        (expect (and (= 3 (length declarations))
+                     (every #'cl-cc/ast:ast-defun-p (subseq declarations 0 2)))
+                :to-be-truthy)
+        (expect (and (= 3 (length declarations))
+                     (string-equal "add"
+                                   (symbol-name (cl-cc/ast:ast-defun-name (first declarations))))
+                     (string-equal "subtract"
+                                   (symbol-name (cl-cc/ast:ast-defun-name (second declarations)))))
+                :to-be-truthy)
+        (expect (and (= 3 (length declarations))
+                     (equal (mapcar (lambda (fn)
+                                      (mapcar #'symbol-name
+                                              (cl-cc/ast:ast-defun-params fn)))
+                                    (subseq declarations 0 2))
+                            '(("a" "b") ("a" "b"))))
+                :to-be-truthy)
+        (let* ((pi-decl (third declarations))
+               (bindings (when (cl-cc/ast:ast-let-p pi-decl)
+                           (cl-cc/ast:ast-let-bindings pi-decl))))
+          (expect (and bindings
+                       (string-equal "PI" (symbol-name (caar bindings))))
+                  :to-be-truthy))))))
 
 ;;; ─── 9. Async / await simulation ─────────────────────────────────────────────
 
@@ -213,5 +288,58 @@ const city = user?.profile?.address?.city;
 const zip = user?.profile?.address?.zip ?? 'N/A';
 const upper = user?.profile?.address?.city?.toUpperCase();
 ")))
-    (expect (>= (length asts) 1) :to-be-truthy)
-    (expect (cl-cc/ast:ast-let-p (first asts)) :to-be-truthy)))
+    (labels ((binding-named (name nodes)
+               (loop for node in nodes
+                     when (cl-cc/ast:ast-let-p node)
+                       thereis
+                         (or (find name (cl-cc/ast:ast-let-bindings node)
+                                   :key (lambda (binding) (symbol-name (car binding)))
+                                   :test #'string-equal)
+                             (binding-named name (cl-cc/ast:ast-let-body node)))))
+             (optional-chain-keys (node)
+               (when (and (cl-cc/ast:ast-call-p node)
+                          (equal "%JS-OPTIONAL-CHAIN" (%js-call-name node)))
+                 (let ((args (cl-cc/ast:ast-call-args node)))
+                   (when (and (= 2 (length args))
+                              (cl-cc/ast:ast-quote-p (second args)))
+                     (append (optional-chain-keys (first args))
+                             (list (cl-cc/ast:ast-quote-value (second args))))))))
+             (call-args-named (name node)
+               (when (and (cl-cc/ast:ast-call-p node)
+                          (equal name (%js-call-name node)))
+                 (cl-cc/ast:ast-call-args node))))
+      (let* ((city (binding-named "city" asts))
+             (zip (binding-named "zip" asts))
+             (upper (binding-named "upper" asts))
+             (city-init (cdr city))
+             (zip-init (cdr zip))
+             (zip-bindings (when (cl-cc/ast:ast-let-p zip-init)
+                             (cl-cc/ast:ast-let-bindings zip-init)))
+             (zip-body (when (cl-cc/ast:ast-let-p zip-init)
+                         (cl-cc/ast:ast-let-body zip-init)))
+             (upper-call (cdr upper))
+             (upper-args (call-args-named "%JS-OPTIONAL-METHOD-CALL" upper-call)))
+        (expect city :to-be-truthy)
+        (expect zip :to-be-truthy)
+        (expect upper :to-be-truthy)
+        (expect (optional-chain-keys city-init) :to-equal
+                '("profile" "address" "city"))
+        (expect (and zip-bindings
+                     (equal (optional-chain-keys (cdar zip-bindings))
+                            '("profile" "address" "zip")))
+                :to-be-truthy)
+        (expect (and zip-body
+                     (= 1 (length zip-body))
+                     (cl-cc/ast:ast-if-p (first zip-body)))
+                :to-be-truthy)
+        (expect (and upper-args
+                     (= 2 (length upper-args))
+                     (cl-cc/ast:ast-quote-p (second upper-args))
+                     (string-equal "toUpperCase"
+                                   (cl-cc/ast:ast-quote-value (second upper-args)))
+                     (equal (optional-chain-keys (first upper-args))
+                            '("profile" "address" "city")))
+                :to-be-truthy)))))
+;;; W2-23 control: verify that one registered failure makes ASDF fail.
+
+(it-sequential "js-e2e-control-intentional-failure" (expect nil :to-be-truthy))

t/orphan-test-allowlist.tsv

@@ -0,0 +1,8 @@
+# Tab-separated fields: source path and reason the file is outside ASDF test system `cl-cc-javascript/test`.
+# Counts are cl-weave test registrations after test macro expansion.
+# These files call `cl-cc:compile-string` and `cl-cc/pipeline:seed-js-runtime-globals`, which `cl-cc-javascript/test` does not depend on.
+# Keep a row until every test from that file is registered in the `cl-cc` repository's `cl-cc/test` system (`cl-cc.asd`) and that repository's CI `nix flake check` reports them passing.
+t/e2e-core-test.lisp	45 tests use `%js-run-capture` to compile JavaScript, seed runtime globals, and execute in the VM.
+t/e2e-advanced-test.lisp	45 tests call `%js-run-capture`, defined in the core file.
+t/e2e-advanced-builtins-test.lisp	61 tests call `%js-run-capture`, defined in the core file.
+t/e2e-modern-test.lisp	105 modern cases plus one async/await execution test (106 total); the parse-only async/await test is registered from `t/e2e-ast-test.lisp` in ASDF system `cl-cc-javascript/test`.