;;;; delimited-control-test.scm
;;;; Kon Lovett, Apr 6 '06

;
(import utf8)
(import test)

(import (only (chicken format) format) (test-utils gloss))

;;;

(test-begin "Delimited-Control")

(import delimited-control)
(import (chicken sort))
(import (srfi 1))
(import (srfi 18))

;;

(test-group "prompt-control"

  (test 117
    (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))

  (test '()
    (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))

  (test 2
    (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))

  (test '(a)
    (prompt (control f (cons 'a (f '())))))

  (test '(a)
    (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))

  (test 117
    (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3))))))))

  (test '()
    (prompt0 (prompt0 (let ((x (control f (cons 'a (f '()))))) (control g x)))))
)

(test-group "reset0-shift0"

  (test 117
    (+ 10 (reset0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))

  (test '()
    (reset0 (cons 'a (reset0 (shift0 f (shift0 g '()))))))

  (test '(a)
    (reset0 (cons 'a (reset0 (reset0 (shift0 f (shift0 g '())))))))
)

(include-relative "shift-reset-test-body")

;;;

(test-end "Delimited-Control")

(test-exit)