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

cs: adjust default prompt abort handler arity error message

Browse Source
This commit is contained in:
Matthew Flatt 2019-11-26 06:02:13 -07:00
parent 6389b18b01
commit afff5ca7ac
3 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
pkgs/racket-test-core/tests/racket/prompt.rktl
View File

@ -668,6 +668,22 @@
(default-continuation-prompt-tag)
list)
;;----------------------------------------
;; Check error message as "result" or not
(err/rt-test (call-with-continuation-prompt (lambda () (abort-current-continuation (default-continuation-prompt-tag))))
exn:fail:contract:arity?
#rx"result arity mismatch")
(err/rt-test (call-with-continuation-prompt (lambda () (abort-current-continuation (default-continuation-prompt-tag)))
(default-continuation-prompt-tag))
exn:fail:contract:arity?
#rx"result arity mismatch")
(err/rt-test (call-with-continuation-prompt (lambda () (abort-current-continuation (default-continuation-prompt-tag)))
(default-continuation-prompt-tag)
(lambda (x) x))
exn:fail:contract:arity?
#rx": arity mismatch")
;;----------------------------------------
(report-errs)

12
racket/src/cs/rumble/control.ss
View File

@ -244,9 +244,17 @@
(apply proc args)))]))
(define (make-default-abort-handler tag)
(lambda (abort-thunk)
(case-lambda
[(abort-thunk)
(check 'default-continuation-prompt-handler (procedure-arity-includes/c 0) abort-thunk)
(call-with-continuation-prompt abort-thunk tag #f)))
(call-with-continuation-prompt abort-thunk tag #f)]
[args
;; report arity error as result-arity error
(apply raise-result-arity-error
'call-with-continuation-prompt
1
"\n in: application of default prompt handler"
args)]))
(define (resume-metacontinuation results)
;; pop a metacontinuation frame

4
racket/src/cs/rumble/error.ss
View File

@ -419,8 +419,8 @@
(if who (string-append (symbol->string who) ": ") "")
"result arity mismatch;\n"
" expected number of values not received\n"
" received: " (number->string (length args)) "\n"
" expected: " (number->string num-expected-args)
" expected: " (number->string num-expected-args) "\n"
" received: " (number->string (length args))
(or where "")
(arguments->context-string args))
(current-continuation-marks))))