test/test.scm
```#lang scheme
(require (planet "78.ss" ("soegaard" "srfi.plt"))
"../control.scm")

(check-reset!)

;;;
;;; WHILE
;;;

(check (let ((n 0) (m 0))
(while (< n 5)
(set! m (+ m n))
(set! n (+ n 1)))
(list (< n 5) m))
=> (list #f 10))

; check <test> is evaluated once only
; in each round.
(check (let ((n 0) (m 0))
(while (begin
(set! m (+ m 1))
(< n 5))
(set! n (+ n 1)))
m)
=> 6)

;;;
;;; UNTIL
;;;

(check (let ((n 5))
(until (= n 0)
(set! n (- n 1)))
n)
=> 0)

(check (let ((n 5) (m 0))
(until (begin
(set! m (+ m 1))
(= n 0))
(set! n (- n 1)))
m)
=> 5)

;;;
;;; DOTIMES
;;;

; macro: (dotimes (var expr [finally]) body ...)
;   dotimes iterates over a series of integers.
;   dotimes evaluates expr and signals an error if the result
;   is not an integer. If expr is zero or negative, the
;   body is not executed. Otherwiese dotimes executed the body
;   for each integer from 0 up to but not including the value of expr.
;   During the evaluation of body, var is bound to each integer.
;   Then finally is evaluated if present, and the result is returned,
;   otherwise #void is returned. At the time finally is evaluated,
;   var is bound to the number of times body was excuted.

; check number of rounds
(check (let ((m 0))
(dotimes (n 5)
(set! m (+ m 1)))
m)
=> 5)
; check var is bound in body
(check (let ((xs '()))
(dotimes (n 5)
(set! xs (cons n xs)))
xs)
=> (list 4 3 2 1 0))
; check <expr> is evaluated once only
(check (let ((m 0) (k 0))
(dotimes (n (begin (set! k (+ k 1)) 5))
(set! m (+ m 1)))
k)
=> 1)
; check finally
(check (let ((m 0))
(dotimes (n 5 7)
(set! m (+ m 1))))
=> 7)
; check that var is bound to number of rounds in finally
(check (let ((m 0))
(dotimes (n 5 (set! m n)))
m)
=> 5)
(check (let ((m 0))
(dotimes (n 5 (set! m n))
(set! n 7))
m)
=> 5)
; check finally is evaluated once only
(check (let ((m 0) (k 0))
(dotimes (n 5 (begin (set! k (+ k 1)) 7))
(set! m (+ m 1)))
k)
=> 1)
; check the body is not executed if the result of expr is non-positive
(check (let ((m 0))
(dotimes (n 0)
(set! m (+ m 1)))
m)
=> 0)
(check (let ((m 0))
(dotimes (n -42)
(set! m (+ m 1)))
m)
=> 0)
(check (let ((m 0))
(dotimes (n -42 7)
(set! m (+ m 1))))
=> 7)
; check assignments to counter
(check (let ((m 0))
(dotimes (n 10)
(set! m (+ m 1))
(set! n 6))
m)
=> 10)

;;;
;;; TAGGED-BEGIN
;;;

; (go <tag>)
(check (let ([i 0])
(tagged-begin
loop (set! i (+ i 1))
(if (< i 41) (go loop)))
i)
=> 41)
; (return <expr>)
(check (let ([i 0])
(tagged-begin
loop (set! i (+ i 1))
(if (< i 42) (go loop))
(return i)))
=> 42)
; 2 tags, go and return
(check (let ([i 0])
(tagged-begin
loop (set! i (+ i 1))
(go b)
a    (if (< i 43) (go loop))
(return i)
b    (go a)))
=> 43)
; Example 4 ( <http://www.emacswiki.org/cgi-bin/wiki.pl?StateMachine> )
(check (let ((odd-numbers '()))
(let ((a 0))
(tagged-begin
start
(set! a 0)
part-1
(set! a (+ a 1))
(set! odd-numbers (cons a odd-numbers))
(cond
((>= a  9)  (go end))
((even? a)  (go part-1))
(else       (go part-2)))
part-2
(set! a (+ a 1))
(go part-1)
end)
odd-numbers))
=> (list 9 7 5 3 1))
; Example 5 ( Knuth: "The Art of Computer Programming", vol1, p.176)
; Inplace inversion of a permutation represented as a vector.
(check (let ()
(define permutation (vector 'dummy 6 2 1 5 4 3))      ; (Knuth counts from 1 not 0 :-) )
(define n           (- (vector-length permutation) 1))
(define (X i)       (vector-ref permutation i))
(define (X! i j)    (vector-set! permutation i j))

(let ([m 0] [i 0] [j 0])
(tagged-begin
I1   ; Initialize
(set! m n)
(set! j -1)
I2   ; Next element
(set! i (X m))
(if (< i 0) (go I5))
I3   ; Invert one
(X! m j)
(set! j (- m))
(set! m i)
(set! i (X m))
I4   ; End of cycle?
(if (> i 0) (go I3))
(set! i j)
I5   ; Store final value
(X! m (- i))
I6   ; Loop on m
(set! m (- m 1))
(if (> m 0) (go I2))))
permutation)
=> (vector 'dummy 3 2 6 5 4 1))

; Example 6 (The CommonLisp Hyper Spec examples of tagbody)
(check (let ()
(define val 'foo)
(tagged-begin
(set! val 1)
(go a)
c     (set! val (+ val 4))
(go b)
(set! val (+ val 32))
a     (set! val (+ val 2))
(go c)
(set! val (+ val 64))
b     (set! val (+ val 8)))
val)
=> 15)

; Example 7
;   Demonstrates lexical scoping of tagged-begins,
;   and that an inner tagged-begin can use an outer tag.

(check (tagged-begin
a (tagged-begin
(go b))
b (return 'hello-world))
=> 'hello-world)

; Demonstrates that tags are lexically shadowed.
(check (tagged-begin
a (tagged-begin
(go b)
(return 'wrong)
b (go c))
b (return 'wrong)
c (return 'correct))

=> 'correct)

;;;
;;; REPORT
;;;

(check-report)
```