giles
0dd2fa3058
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m8s
apl-throw raises a tagged ("apl-error" code msg) error.
apl-trap-matches? checks if codes list contains the error's code
(0 = catch-all, à la Dyalog).
Eval-stmt :trap clause wraps try-block with R7RS guard;
on match, runs catch-block; on mismatch, re-raises.
Bonus :throw AST node for testing.
test.sh + conformance.sh now load lib/r7rs.sx (for guard) and
include eval-ops + pipeline suites in scoreboard.
All Phase 7 unchecked items are now ticked.
Final scoreboard: 450/450 across 10 suites.
157 lines
6.9 KiB
Plaintext
157 lines
6.9 KiB
Plaintext
; Tests for apl-call-tradfn (manual structure construction).
|
||
|
||
(define mkrv (fn (arr) (get arr :ravel)))
|
||
(define mksh (fn (arr) (get arr :shape)))
|
||
(define mknum (fn (n) (list :num n)))
|
||
(define mknm (fn (s) (list :name s)))
|
||
(define mkfg (fn (g) (list :fn-glyph g)))
|
||
(define mkmon (fn (g a) (list :monad (mkfg g) a)))
|
||
(define mkdyd (fn (g l r) (list :dyad (mkfg g) l r)))
|
||
(define mkasg (fn (n e) (list :assign n e)))
|
||
(define mkbr (fn (e) (list :branch e)))
|
||
|
||
(define mkif (fn (c t e) (list :if c t e)))
|
||
|
||
(define mkwhile (fn (c b) (list :while c b)))
|
||
|
||
(define mkfor (fn (v i b) (list :for v i b)))
|
||
|
||
(define mksel (fn (v cs d) (list :select v cs d)))
|
||
|
||
(define mktrap (fn (codes t c) (list :trap codes t c)))
|
||
|
||
(define mkthr (fn (code msg) (list :throw code msg)))
|
||
|
||
(apl-test
|
||
"tradfn R←L+W simple add"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 5) (apl-scalar 7)))
|
||
(list 12))
|
||
|
||
(apl-test
|
||
"tradfn R←L×W"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "L") (mknm "W")))) :alpha "L"} (apl-scalar 6) (apl-scalar 7)))
|
||
(list 42))
|
||
|
||
(apl-test
|
||
"tradfn monadic R←-W"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkmon "-" (mknm "W")))) :alpha nil} nil (apl-scalar 9)))
|
||
(list -9))
|
||
|
||
(apl-test
|
||
"tradfn →0 exits early"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknm "W")) (mkbr (mknum 0)) (mkasg "R" (mknum 999))) :alpha nil} nil (apl-scalar 7)))
|
||
(list 7))
|
||
|
||
(apl-test
|
||
"tradfn branch to line 3 skips line 2"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 3)) (mkasg "R" (mknum 999)) (mkasg "R" (mknum 42))) :alpha nil} nil (apl-scalar 0)))
|
||
(list 42))
|
||
|
||
(apl-test
|
||
"tradfn local var t←W+1; R←t×2"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "t" (mkdyd "+" (mknm "W") (mknum 1))) (mkasg "R" (mkdyd "×" (mknm "t") (mknum 2)))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 12))
|
||
|
||
(apl-test
|
||
"tradfn vector args"
|
||
(mkrv
|
||
(apl-call-tradfn
|
||
{:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "+" (mknm "L") (mknm "W")))) :alpha "L"}
|
||
(make-array (list 3) (list 1 2 3))
|
||
(make-array (list 3) (list 10 20 30))))
|
||
(list 11 22 33))
|
||
|
||
(apl-test
|
||
"tradfn unset result returns nil"
|
||
(apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkbr (mknum 0))) :alpha nil} nil (apl-scalar 5))
|
||
nil)
|
||
|
||
(apl-test
|
||
"tradfn run-off end returns result"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mkdyd "×" (mknm "W") (mknum 3)))) :alpha nil} nil (apl-scalar 7)))
|
||
(list 21))
|
||
|
||
(apl-test
|
||
"tradfn loop sum 1+2+...+5 via branch"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1))) (mkbr (mkdyd "×" (mkdyd "≤" (mknm "i") (mknm "W")) (mknum 3)))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 15))
|
||
|
||
(apl-test
|
||
"tradfn :If true branch"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkasg "R" (mknum 1))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 1))
|
||
|
||
(apl-test
|
||
"tradfn :If false branch"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 100)) (list (mkasg "R" (mknum 1))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 0))
|
||
|
||
(apl-test
|
||
"tradfn :While sum 1..N"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "i" (mknum 1)) (mkasg "R" (mknum 0)) (mkwhile (mkdyd "≤" (mknm "i") (mknm "W")) (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "i"))) (mkasg "i" (mkdyd "+" (mknm "i") (mknum 1)))))) :alpha nil} nil (apl-scalar 10)))
|
||
(list 55))
|
||
|
||
(apl-test
|
||
"tradfn :For sum elements"
|
||
(mkrv
|
||
(apl-call-tradfn
|
||
{:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 0)) (mkfor "x" (mknm "W") (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "x")))))) :alpha nil}
|
||
nil
|
||
(make-array (list 4) (list 10 20 30 40))))
|
||
(list 100))
|
||
|
||
(apl-test
|
||
"tradfn :For with empty vector"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 99)) (mkfor "x" (mknm "W") (list (mkasg "R" (mkdyd "+" (mknm "R") (mknm "x")))))) :alpha nil} nil (make-array (list 0) (list))))
|
||
(list 99))
|
||
|
||
(apl-test
|
||
"tradfn :Select dispatch hit"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mksel (mknm "W") (list (list (mknum 1) (mkasg "R" (mknum 100))) (list (mknum 2) (mkasg "R" (mknum 200))) (list (mknum 3) (mkasg "R" (mknum 300)))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 2)))
|
||
(list 200))
|
||
|
||
(apl-test
|
||
"tradfn :Select default block"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mksel (mknm "W") (list (list (mknum 1) (mkasg "R" (mknum 100))) (list (mknum 2) (mkasg "R" (mknum 200)))) (list (mkasg "R" (mknum -1))))) :alpha nil} nil (apl-scalar 99)))
|
||
(list -1))
|
||
|
||
(apl-test
|
||
"tradfn nested :If"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkif (mkdyd ">" (mknm "W") (mknum 10)) (list (mkasg "R" (mknum 2))) (list (mkasg "R" (mknum 1))))) (list (mkasg "R" (mknum 0))))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 1))
|
||
|
||
(apl-test
|
||
"tradfn :If assigns persist outside"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 0)) (mkif (mkdyd ">" (mknm "W") (mknum 0)) (list (mkasg "R" (mknum 42))) (list)) (mkasg "R" (mkdyd "+" (mknm "R") (mknum 1)))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 43))
|
||
|
||
(apl-test
|
||
"tradfn :For factorial 1..5"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega "W" :stmts (list (mkasg "R" (mknum 1)) (mkfor "x" (mkmon "⍳" (mknm "W")) (list (mkasg "R" (mkdyd "×" (mknm "R") (mknm "x")))))) :alpha nil} nil (apl-scalar 5)))
|
||
(list 120))
|
||
|
||
(apl-test
|
||
"tradfn :Trap normal flow (no error)"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkasg "R" (mknum 99))) (list (mkasg "R" (mknum -1))))) :alpha nil} nil nil))
|
||
(list 99))
|
||
|
||
(apl-test
|
||
"tradfn :Trap catches matching code"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 5) (list (mkthr 5 "boom")) (list (mkasg "R" (mknum 42))))) :alpha nil} nil nil))
|
||
(list 42))
|
||
|
||
(apl-test
|
||
"tradfn :Trap catch-all (code 0)"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 0) (list (mkthr 99 "any")) (list (mkasg "R" (mknum 1))))) :alpha nil} nil nil))
|
||
(list 1))
|
||
|
||
(apl-test
|
||
"tradfn :Trap catches one of many codes"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 1 2 3) (list (mkthr 2 "two")) (list (mkasg "R" (mknum 22))))) :alpha nil} nil nil))
|
||
(list 22))
|
||
|
||
(apl-test
|
||
"tradfn :Trap continues to next stmt after catch"
|
||
(mkrv (apl-call-tradfn {:result "R" :omega nil :stmts (list (mktrap (list 7) (list (mkthr 7 "c")) (list (mkasg "R" (mknum 10)))) (mkasg "R" (mkdyd "+" (mknm "R") (mknum 5)))) :alpha nil} nil nil))
|
||
(list 15))
|