coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cl: tagbody + go — 11 new tests (151 eval, 323 total green)

Browse Source 
Sentinel-based tagbody: cl-build-tag-map indexes tags by str-normalised key
(handles integer tags); cl-eval-tagbody loops with go-jump restart;
go-tag propagates through cl-eval-body alongside block-return.
This commit is contained in:
giles
2026-05-05 11:07:43 +00:00
parent ce7243a1fb
commit a12a6a11cb
3 changed files with 81 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
lib/common-lisp/tests/eval.sx
View File

@@ -325,3 +325,39 @@
(cl-test "block: return-from through function"
(ev "(block done (flet ((f () (return-from done 42))) (f)) nil)")
42)
;; ── TAGBODY / GO ─────────────────────────────────────────────────
(cl-test "tagbody: empty returns nil"
(ev "(tagbody)")
nil)
(cl-test "tagbody: forms only, returns nil"
(ev "(let ((x 0)) (tagbody (setq x 1) (setq x 2)) x)")
2)
(cl-test "tagbody: tag only, returns nil"
(ev "(tagbody done)")
nil)
(cl-test "tagbody: go skips forms"
(ev "(let ((x 0)) (tagbody (go done) (setq x 99) done) x)")
0)
(cl-test "tagbody: go to later tag"
(ev "(let ((x 0)) (tagbody start (setq x (+ x 1)) (go done) (setq x 99) done) x)")
1)
(cl-test "tagbody: loop with counter"
(ev "(let ((n 0)) (tagbody loop (when (>= n 3) (go done)) (setq n (+ n 1)) (go loop) done) n)")
3)
(cl-test "tagbody: go inside when"
(ev "(let ((x 0)) (tagbody (setq x 1) (when t (go done)) (setq x 99) done) x)")
1)
(cl-test "tagbody: go inside progn"
(ev "(let ((x 0)) (tagbody (progn (setq x 1) (go done)) (setq x 99) done) x)")
1)
(cl-test "tagbody: go inside let"
(ev "(let ((acc 0)) (tagbody (let ((y 5)) (when (> y 3) (go done))) (setq acc 99) done) acc)")
0)
(cl-test "tagbody: integer tags"
(ev "(let ((x 0)) (tagbody (go 2) 1 (setq x 1) (go 3) 2 (setq x 2) (go 3) 3) x)")
2)
(cl-test "tagbody: block-return propagates out"
(ev "(block done (tagbody (return-from done 42)) nil)")
42)