checkpoint delim cont tests

svn: r4571
This commit is contained in:
Matthew Flatt 2006-10-12 22:17:56 +00:00
parent d09e743d8c
commit 949beaa30f

View File

@ -1154,7 +1154,7 @@
;; Check unwinding of runstack overflows on prompt escape ;; Check unwinding of runstack overflows on prompt escape
(let ([try (let ([try
(lambda (thread m-top n-top do-abort) (lambda (thread m-top n-top do-mid-stream do-abort)
(let ([result #f]) (let ([result #f])
(thread-wait (thread-wait
(thread (thread
@ -1163,6 +1163,8 @@
(let pre-loop ([m m-top]) (let pre-loop ([m m-top])
(if (zero? m) (if (zero? m)
(list (list
(do-mid-stream
(lambda ()
(call-with-continuation-prompt (call-with-continuation-prompt
(lambda () (lambda ()
(let loop ([n n-top]) (let loop ([n n-top])
@ -1172,21 +1174,29 @@
(abort-current-continuation (abort-current-continuation
(default-continuation-prompt-tag) (default-continuation-prompt-tag)
5000))) 5000)))
(+ (loop (sub1 n)))))))) (+ (loop (sub1 n))))))))))
(list (car (pre-loop (sub1 m)))))))))) (list (car (pre-loop (sub1 m))))))))))
(test '(5000) values result)))]) (test '(5000) values result)))])
(try thread 5000 10000 (lambda (abort) (abort))) (try thread 5000 10000 (lambda (mid) (mid)) (lambda (abort) (abort)))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt (try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) ((call-with-continuation-prompt
(lambda () (lambda ()
((call-with-composable-continuation ((call-with-composable-continuation
(lambda (k) (lambda () k)))))) (lambda (k) (lambda () k))))))
(lambda () 5000)))) (lambda () 5000))))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt (try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) ((call-with-continuation-prompt
(lambda () (lambda ()
((call/cc ((call/cc
(lambda (k) (lambda () k)))))) (lambda (k) (lambda () k))))))
(lambda () 5000)))) (lambda () 5000))))
(try thread 5000 10000 (lambda (abort) (((call/cc (try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) (((call/cc
(lambda (k) (lambda () k))))
(lambda () (lambda (x) 5000)))))
(try thread 5000 10000
(lambda (mid) (call-with-continuation-barrier mid))
(lambda (abort) (((call/cc
(lambda (k) (lambda () k)))) (lambda (k) (lambda () k))))
(lambda () (lambda (x) 5000))))) (lambda () (lambda (x) 5000)))))
(let ([p (make-continuation-prompt-tag 'p)]) (let ([p (make-continuation-prompt-tag 'p)])
@ -1195,6 +1205,7 @@
(lambda () (lambda ()
(call-with-continuation-prompt f p)))) (call-with-continuation-prompt f p))))
5000 10000 5000 10000
(lambda (mid) (mid))
(lambda (abort) (lambda (abort)
((call/cc ((call/cc
(lambda (k) (lambda (k)