diff --git a/pkgs/racket-test-core/tests/racket/contmark.rktl b/pkgs/racket-test-core/tests/racket/contmark.rktl index 24bf000fe8..7497d9ff42 100644 --- a/pkgs/racket-test-core/tests/racket/contmark.rktl +++ b/pkgs/racket-test-core/tests/racket/contmark.rktl @@ -458,6 +458,13 @@ (err/rt-test (call-with-parameterization 10 (lambda () 12))) (err/rt-test (call-with-parameterization (current-parameterization) (lambda (x) 12))) +(err/rt-test (current-continuation-marks (make-continuation-prompt-tag 'px)) + exn:fail:contract:continuation?) +(err/rt-test (continuation-marks (let/cc k k) (make-continuation-prompt-tag 'px)) + exn:fail:contract:continuation?) +(err/rt-test (continuation-mark-set-first #f 'key #f (make-continuation-prompt-tag 'px)) + exn:fail:contract:continuation?) + ;; Create a deep stack with a deep mark stack (define (p-equal? a b) @@ -1043,9 +1050,10 @@ tag))))) tag)) - (list - (continuation-mark-set->list (continuation-marks k) 'key) - (continuation-mark-set->list (continuation-marks k) 'key))) + (test '((val) (val)) + list + (continuation-mark-set->list (continuation-marks k) 'key) + (continuation-mark-set->list (continuation-marks k) 'key))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl index 3b840f6209..5f7411d455 100644 --- a/pkgs/racket-test-core/tests/racket/prompt-tests.rktl +++ b/pkgs/racket-test-core/tests/racket/prompt-tests.rktl @@ -165,6 +165,10 @@ p1)) p2)))) +(err/rt-test (abort-current-continuation + (make-continuation-prompt-tag 'px)) + exn:fail:contract:continuation?) + ;; ---------------------------------------- ;; Continuations @@ -462,7 +466,7 @@ (err/rt-test (call-with-composable-continuation (lambda (x) x) (make-continuation-prompt-tag 'px)) - exn:fail:contract?) + exn:fail:contract:continuation?) (let ([k (call-with-continuation-prompt (lambda () @@ -1466,7 +1470,7 @@ (lambda () (exit-k (lambda () 'hi))) p1))))) - exn:fail:contract?) + exn:fail:contract:continuation?) ;; Arrange for a barrier to interfere with a continuation ;; jump after dynamic-winds are already being processed: diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 8fb1b0ac60..bbc018c3a2 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -6098,12 +6098,13 @@ internal_call_cc (int argc, Scheme_Object *argv[]) prompt = scheme_get_prompt(SCHEME_PTR_VAL(pt), &prompt_cont, &prompt_pos); if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, pt)) { - scheme_contract_error((composable - ? "call-with-composable-continuation" - : "call-with-current-continuation"), - "continuation includes no prompt with the given tag", - "tag", 1, prompt_tag, - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "%s: continuation includes no prompt with the given tag\n" + " tag: %V", + (composable + ? "call-with-composable-continuation" + : "call-with-current-continuation"), + prompt_tag); return NULL; } @@ -7608,10 +7609,10 @@ static Scheme_Object *do_abort_continuation (int argc, Scheme_Object *argv[], in prompt = original_default_prompt; if (!prompt) { - scheme_contract_error("abort-current-continuation", - "continuation includes no prompt with the given tag", - "tag", 1, prompt_tag, - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "abort-current-continuation: continuation includes no prompt with the given tag\n" + " tag: %V", + prompt_tag); return NULL; } @@ -7994,10 +7995,10 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p, } if (!who) return NULL; - scheme_contract_error(who, - "no corresponding prompt in the continuation", - "tag", 1, prompt_tag, - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "%s: no corresponding prompt in the continuation\n" + " tag: %V", + who, prompt_tag); } } @@ -8078,11 +8079,12 @@ cc_marks(int argc, Scheme_Object *argv[]) } if (!SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) - if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) - scheme_contract_error("current-continuation-marks", - "no corresponding prompt in the continuation", - "prompt tag", 1, prompt_tag, - NULL); + if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) { + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "current-continuation-marks: no corresponding prompt in the continuation\n" + " prompt tag: %V", + prompt_tag); + } } return scheme_current_continuation_marks(argc ? prompt_tag : NULL); @@ -8116,10 +8118,9 @@ cont_marks(int argc, Scheme_Object *argv[]) return make_empty_marks(); } else if (SCHEME_ECONTP(argv[0])) { if (!scheme_escape_continuation_ok(argv[0])) { - scheme_contract_error("continuation-marks", - "escape continuation not in the current thread's continuation", - "escape continuation", 1, argv[0], - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "continuation-marks: escape continuation not in the current thread's continuation\n" + " escape continuation: %V", argv[0]); return NULL; } else { Scheme_Meta_Continuation *mc; @@ -8805,11 +8806,12 @@ extract_one_cc_mark(int argc, Scheme_Object *argv[]) if (!SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) { if (SCHEME_FALSEP(argv[0])) { - if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) - scheme_contract_error("continuation-mark-set-first", - "no corresponding prompt in the current continuation", - "tag", 1, prompt_tag, - NULL); + if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) { + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "continuation-mark-set-first: no corresponding prompt in the current continuation\n" + " tag: %V", + prompt_tag); + } } } } @@ -8856,10 +8858,10 @@ static Scheme_Object *continuation_prompt_available(int argc, Scheme_Object *arg if (argc > 1) { if (SCHEME_ECONTP(argv[1])) { if (!scheme_escape_continuation_ok(argv[1])) { - scheme_contract_error("continuation-prompt-available?", - "escape continuation not in the current thread's continuation", - "escape continuation", 1, argv[1], - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "continuation-prompt-available?: escape continuation not in the current thread's continuation\n" + " escape continuation: %V", + argv[1]); return NULL; } else { Scheme_Meta_Continuation *mc; @@ -9501,12 +9503,13 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *), prompt = original_default_prompt; } if (!prompt) { - scheme_contract_error("abort-current-continuation", - "abort in progress, but current continuation includes" - " no prompt with the given tag" - " after a `dynamic-wind' post-thunk return", - "tag", 1, tag, - NULL); + scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION, + "abort-current-continuation:" + " abort in progress, but current continuation includes" + " no prompt with the given tag" + " after a `dynamic-wind' post-thunk return\n" + " tag: %V", + tag); return NULL; } p->cjs.jumping_to_continuation = (Scheme_Object *)prompt;