From a9020a33608968074cabfcd3e2d519b85e46fe80 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 10 Oct 2006 05:21:15 +0000 Subject: [PATCH] checkpoint delim cont tests svn: r4541 --- collects/tests/mzscheme/prompt.ss | 157 ++++++++++++++++++++++++++++++ 1 file changed, 157 insertions(+) diff --git a/collects/tests/mzscheme/prompt.ss b/collects/tests/mzscheme/prompt.ss index e7df82fb97..ddfe6964ff 100644 --- a/collects/tests/mzscheme/prompt.ss +++ b/collects/tests/mzscheme/prompt.ss @@ -846,6 +846,163 @@ 'done)))) +(define (non-tail v) (values v)) + +(let ([k (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'x + 71 + ((call-with-composable-continuation + (lambda (k) + (lambda () k)))))))]) + (test #f continuation-mark-set-first #f 'x) + (test 71 k (lambda () (continuation-mark-set-first #f 'x))) + (test '(71) continuation-mark-set->list (continuation-marks k) 'x) + (test 71 'wcm (with-continuation-mark + 'x 81 + (k (lambda () (continuation-mark-set-first #f 'x))))) + (test '(71 81) 'wcm (with-continuation-mark + 'x 81 + (non-tail + (k (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x)))))) + #; + (test '(71) 'wcm (with-continuation-mark + 'x 81 + (k (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x))))) + (test '(91 71 81) 'wcm (with-continuation-mark + 'x 81 + (non-tail + (k (lambda () + (non-tail + (with-continuation-mark + 'x 91 + (continuation-mark-set->list (current-continuation-marks) 'x)))))))) + (test '(91 81) 'wcm (with-continuation-mark + 'x 81 + (non-tail + (k (lambda () + (with-continuation-mark + 'x 91 + (continuation-mark-set->list (current-continuation-marks) 'x))))))) + #; + (test '(91) 'wcm (with-continuation-mark + 'x 81 + (k (lambda () + (with-continuation-mark + 'x 91 + (continuation-mark-set->list (current-continuation-marks) 'x)))))) + (let ([k2 (with-continuation-mark + 'x 101 + (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'x 111 + (non-tail + (k (lambda () + ((call-with-composable-continuation + (lambda (k2) + (test '(71 111 101) continuation-mark-set->list (current-continuation-marks) 'x) + (lambda () k2)))))))))))]) + (test '(71 111) continuation-mark-set->list (continuation-marks k2) 'x) + (test '(71 111) k2 (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x))) + (test 71 k2 (lambda () + (continuation-mark-set-first #f 'x))) + (test '(71 111 121) 'wcm (with-continuation-mark + 'x 121 + (non-tail + (k2 (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x)))))) + ) + + #; + (let ([k2 (with-continuation-mark + 'x 101 + (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'x 111 + (k (lambda () + ((call-with-composable-continuation + (lambda (k2) + (test '(71 111 101) continuation-mark-set->list (current-continuation-marks) 'x) + (lambda () k2))))))))))]) + (test '(71) continuation-mark-set->list (continuation-marks k2) 'x) + (test '(71) k2 (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x))) + (test 71 k2 (lambda () + (continuation-mark-set-first #f 'x))) + (test '(71 121) 'wcm (with-continuation-mark + 'x 121 + (non-tail + (k2 (lambda () + (continuation-mark-set->list (current-continuation-marks) 'x)))))) + )) + +;; Check interaction of dynamic winds, continuation composition, and continuation marks + +(let ([pre-saw-xs null] + [post-saw-xs null] + [pre-saw-ys null] + [post-saw-ys null]) + (let ([k (call-with-continuation-prompt + (lambda () + (with-continuation-mark + 'x + 77 + (dynamic-wind + (lambda () + (set! pre-saw-xs (continuation-mark-set->list (current-continuation-marks) 'x)) + (set! pre-saw-ys (continuation-mark-set->list (current-continuation-marks) 'y))) + (lambda () + ((call-with-composable-continuation + (lambda (k) + (lambda () k))))) + (lambda () + (set! post-saw-xs (continuation-mark-set->list (current-continuation-marks) 'x)) + (set! post-saw-ys (continuation-mark-set->list (current-continuation-marks) 'y)))))))]) + (test '(77) values pre-saw-xs) + (test '() values pre-saw-ys) + (test '(77) values post-saw-xs) + (test '() values post-saw-ys) + (let ([jump-in + (lambda (wrap r-val y-val) + (test r-val 'wcm + (wrap + (lambda (esc) + (with-continuation-mark + 'y y-val + (k (lambda () (esc))))))) + (test '(77) values pre-saw-xs) + (test (list y-val) values pre-saw-ys) + (test '(77) values post-saw-xs) + (test (list y-val) values post-saw-ys) + (let ([k3 (call-with-continuation-prompt + (lambda () + ((call-with-composable-continuation + (lambda (k) + (lambda () k))))))]) + (test r-val 'wcm + (wrap + (lambda (esc) + (k3 + (lambda () + (with-continuation-mark + 'y y-val + (k (lambda () (k3 (lambda () (esc)))))))))))))]) + (jump-in (lambda (f) (f (lambda () 10))) 10 88) + (jump-in (lambda (f) (let/cc esc (f (lambda () (esc 20))))) 20 99) + (jump-in (lambda (f) + (let ([p1 (make-continuation-prompt-tag)]) + (call-with-continuation-prompt + (lambda () + (f (lambda () (abort-current-continuation p1 30)))) + p1))) + 30 111) + (void)))) ;; ---------------------------------------- ;; Variations of Olivier Danvy's traversal