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

avoid the default handler for call-with-continuation-prompt in

Browse Source 
favor of one that behaves much like it, but never escapes

closes PR 13121
This commit is contained in:
Robby Findler 2012-09-20 09:27:14 -05:00
parent d05f9bacb3
commit a6d74c8e3b
2 changed files with 53 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/drracket/private/rep.rkt
View File

@ -1113,9 +1113,29 @@ TODO
(parameterize ([pretty-print-columns pretty-print-width])
(for ([x (in-list results)])
((current-print) x)))
(loop)])))))))
(loop)])))))
(default-continuation-prompt-tag)
(letrec ([me
(λ args
(cond
[(and (pair? args)
(null? (cdr args))
(procedure? (car args))
(procedure-arity-includes? (car args) 0))
(call-with-continuation-prompt (car args)
(default-continuation-prompt-tag)
me)]
[else
(call-with-continuation-prompt
(λ ()
(call-with-continuation-prompt
(λ ()
(apply
abort-current-continuation
(default-continuation-prompt-tag)
args)))))]))])
me)))
list))
(parameterize ([pretty-print-columns pretty-print-width])
(for ([x (in-list last-results)])
((current-print) x)))

31
collects/tests/drracket/private/repl-test.rkt
View File

@ -1015,6 +1015,37 @@ This produces an ACK message
void
void)
;; this test case used to fail, but not by printing the wrong
;; thing; instead the REPL just didn't return and Run didn't
;; light up, etc.
(mktest
"(abort-current-continuation (default-continuation-prompt-tag))) 2"
(#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch")
'interactions
#f)
(mktest
(format "~s"
'(abort-current-continuation
(default-continuation-prompt-tag)
(λ ()
(abort-current-continuation
(default-continuation-prompt-tag)))))
(#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch"
#rx"call-with-continuation-prompt: result arity mismatch")
'interactions
#f)
))
;; these tests aren't used at the moment.