suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

checkpoint delim cont tests

Browse Source 
svn: r4571
This commit is contained in:
Matthew Flatt 2006-10-12 22:17:56 +00:00
parent d09e743d8c
commit 949beaa30f
1 changed files with 36 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/tests/mzscheme/prompt.ss
View File

@ -1154,7 +1154,7 @@
;; Check unwinding of runstack overflows on prompt escape
(let ([try
(lambda (thread m-top n-top do-abort)
(lambda (thread m-top n-top do-mid-stream do-abort)
(let ([result #f])
(thread-wait
(thread
@ -1163,38 +1163,49 @@
(let pre-loop ([m m-top])
(if (zero? m)
(list
(call-with-continuation-prompt
(do-mid-stream
(lambda ()
(let loop ([n n-top])
(if (zero? n)
(do-abort
(lambda ()
(abort-current-continuation
(default-continuation-prompt-tag)
5000)))
(+ (loop (sub1 n))))))))
(call-with-continuation-prompt
(lambda ()
(let loop ([n n-top])
(if (zero? n)
(do-abort
(lambda ()
(abort-current-continuation
(default-continuation-prompt-tag)
5000)))
(+ (loop (sub1 n))))))))))
(list (car (pre-loop (sub1 m))))))))))
(test '(5000) values result)))])
(try thread 5000 10000 (lambda (abort) (abort)))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt
(lambda ()
((call-with-composable-continuation
(lambda (k) (lambda () k))))))
(lambda () 5000))))
(try thread 5000 10000 (lambda (abort) ((call-with-continuation-prompt
(lambda ()
((call/cc
(lambda (k) (lambda () k))))))
(lambda () 5000))))
(try thread 5000 10000 (lambda (abort) (((call/cc
(lambda (k) (lambda () k))))
(lambda () (lambda (x) 5000)))))
(try thread 5000 10000 (lambda (mid) (mid)) (lambda (abort) (abort)))
(try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) ((call-with-continuation-prompt
(lambda ()
((call-with-composable-continuation
(lambda (k) (lambda () k))))))
(lambda () 5000))))
(try thread 5000 10000 (lambda (mid) (mid))
(lambda (abort) ((call-with-continuation-prompt
(lambda ()
((call/cc
(lambda (k) (lambda () k))))))
(lambda () 5000))))
(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 () (lambda (x) 5000)))))
(let ([p (make-continuation-prompt-tag 'p)])
(try (lambda (f)
(thread
(lambda ()
(call-with-continuation-prompt f p))))
5000 10000
(lambda (mid) (mid))
(lambda (abort)
((call/cc
(lambda (k)