rose-ash/lib/forth/tests/test-phase3.sx

;; Phase 3 — control flow (IF/ELSE/THEN, BEGIN/UNTIL/WHILE/REPEAT/AGAIN,
;; DO/LOOP, return stack). Grows as each control construct lands.

(define forth-p3-passed 0)
(define forth-p3-failed 0)
(define forth-p3-failures (list))

(define
  forth-p3-assert
  (fn
    (label expected actual)
    (if
      (= expected actual)
      (set! forth-p3-passed (+ forth-p3-passed 1))
      (begin
        (set! forth-p3-failed (+ forth-p3-failed 1))
        (set!
          forth-p3-failures
          (concat
            forth-p3-failures
            (list
              (str label ": expected " (str expected) " got " (str actual)))))))))

(define
  forth-p3-check-stack
  (fn
    (label src expected)
    (let ((r (forth-run src))) (forth-p3-assert label expected (nth r 2)))))

(define
  forth-p3-if-tests
  (fn
    ()
    (forth-p3-check-stack
      "IF taken (-1)"
      ": Q -1 IF 10 THEN ; Q"
      (list 10))
    (forth-p3-check-stack
      "IF not taken (0)"
      ": Q 0 IF 10 THEN ; Q"
      (list))
    (forth-p3-check-stack
      "IF with non-zero truthy"
      ": Q 42 IF 10 THEN ; Q"
      (list 10))
    (forth-p3-check-stack
      "IF ELSE — true branch"
      ": Q -1 IF 10 ELSE 20 THEN ; Q"
      (list 10))
    (forth-p3-check-stack
      "IF ELSE — false branch"
      ": Q 0 IF 10 ELSE 20 THEN ; Q"
      (list 20))
    (forth-p3-check-stack
      "IF consumes flag"
      ": Q IF 1 ELSE 2 THEN ; 0 Q"
      (list 2))
    (forth-p3-check-stack
      "absolute value via IF"
      ": ABS2 DUP 0 < IF NEGATE THEN ; -7 ABS2"
      (list 7))
    (forth-p3-check-stack
      "abs leaves positive alone"
      ": ABS2 DUP 0 < IF NEGATE THEN ; 7 ABS2"
      (list 7))
    (forth-p3-check-stack
      "sign: negative"
      ": SIGN DUP 0 < IF DROP -1 ELSE DROP 1 THEN ; -3 SIGN"
      (list -1))
    (forth-p3-check-stack
      "sign: positive"
      ": SIGN DUP 0 < IF DROP -1 ELSE DROP 1 THEN ; 3 SIGN"
      (list 1))
    (forth-p3-check-stack
      "nested IF (both true)"
      ": Q 1 IF 1 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
      (list 10))
    (forth-p3-check-stack
      "nested IF (inner false)"
      ": Q 1 IF 0 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
      (list 20))
    (forth-p3-check-stack
      "nested IF (outer false)"
      ": Q 0 IF 0 IF 10 ELSE 20 THEN ELSE 30 THEN ; Q"
      (list 30))
    (forth-p3-check-stack
      "IF before other ops"
      ": Q 1 IF 5 ELSE 6 THEN 2 * ; Q"
      (list 10))
    (forth-p3-check-stack
      "IF in chained def"
      ": POS? 0 > ;
       : DOUBLE-IF-POS DUP POS? IF 2 * THEN ;
       3 DOUBLE-IF-POS"
      (list 6))
    (forth-p3-check-stack
      "empty then branch"
      ": Q 1 IF THEN 99 ; Q"
      (list 99))
    (forth-p3-check-stack
      "empty else branch"
      ": Q 0 IF 99 ELSE THEN ; Q"
      (list))
    (forth-p3-check-stack
      "sequential IF blocks"
      ": Q -1 IF 1 THEN -1 IF 2 THEN ; Q"
      (list 1 2))))

(define
  forth-p3-loop-tests
  (fn
    ()
    (forth-p3-check-stack
      "BEGIN UNTIL (countdown to zero)"
      ": CD BEGIN 1- DUP 0 = UNTIL ; 3 CD"
      (list 0))
    (forth-p3-check-stack
      "BEGIN UNTIL — single pass (UNTIL true immediately)"
      ": Q BEGIN -1 UNTIL 42 ; Q"
      (list 42))
    (forth-p3-check-stack
      "BEGIN UNTIL — accumulate sum 1+2+3"
      ": SUM3 0 3 BEGIN TUCK + SWAP 1- DUP 0 = UNTIL DROP ; SUM3"
      (list 6))
    (forth-p3-check-stack
      "BEGIN WHILE REPEAT — triangular sum 5"
      ": TRI 0 5 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
      (list 15))
    (forth-p3-check-stack
      "BEGIN WHILE REPEAT — zero iterations"
      ": TRI 0 0 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
      (list 0))
    (forth-p3-check-stack
      "BEGIN WHILE REPEAT — one iteration"
      ": TRI 0 1 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ; TRI"
      (list 1))
    (forth-p3-check-stack
      "nested BEGIN UNTIL"
      ": INNER BEGIN 1- DUP 0 = UNTIL DROP ;
       : OUTER BEGIN 3 INNER 1- DUP 0 = UNTIL ;
       2 OUTER"
      (list 0))
    (forth-p3-check-stack
      "BEGIN UNTIL after colon prefix"
      ": TEN 10 ;
       : CD TEN BEGIN 1- DUP 0 = UNTIL ;
       CD"
      (list 0))
    (forth-p3-check-stack
      "WHILE inside IF branch"
      ": Q 1 IF 0 3 BEGIN DUP 0 > WHILE TUCK + SWAP 1- REPEAT DROP ELSE 99 THEN ; Q"
      (list 6))))

(define
  forth-p3-run-all
  (fn
    ()
    (set! forth-p3-passed 0)
    (set! forth-p3-failed 0)
    (set! forth-p3-failures (list))
    (forth-p3-if-tests)
    (forth-p3-loop-tests)
    (dict
      "passed"
      forth-p3-passed
      "failed"
      forth-p3-failed
      "failures"
      forth-p3-failures)))