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

fix some exn:fail:contract:continuation

Browse Source 
Some excepts that should be `exn:fail:contract:continuation`
were `exn:fail:contract`.

Closes #1920
This commit is contained in:
Matthew Flatt 2018-01-18 13:04:06 -07:00
parent 0c35905270
commit d7421b5dc0
3 changed files with 58 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/contmark.rktl
View File

@ -458,6 +458,13 @@
(err/rt-test (call-with-parameterization 10 (lambda () 12))) (err/rt-test (call-with-parameterization 10 (lambda () 12)))
(err/rt-test (call-with-parameterization (current-parameterization) (lambda (x) 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 ;; Create a deep stack with a deep mark stack
(define (p-equal? a b) (define (p-equal? a b)
@ -1043,9 +1050,10 @@
tag))))) tag)))))
tag)) tag))
(list (test '((val) (val))
(continuation-mark-set->list (continuation-marks k) 'key) list
(continuation-mark-set->list (continuation-marks k) 'key))) (continuation-mark-set->list (continuation-marks k) 'key)
(continuation-mark-set->list (continuation-marks k) 'key)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -165,6 +165,10 @@
p1)) p1))
p2)))) p2))))
(err/rt-test (abort-current-continuation
(make-continuation-prompt-tag 'px))
exn:fail:contract:continuation?)
;; ---------------------------------------- ;; ----------------------------------------
;; Continuations ;; Continuations
@ -462,7 +466,7 @@
(err/rt-test (call-with-composable-continuation (err/rt-test (call-with-composable-continuation
(lambda (x) x) (lambda (x) x)
(make-continuation-prompt-tag 'px)) (make-continuation-prompt-tag 'px))
exn:fail:contract?) exn:fail:contract:continuation?)
(let ([k (call-with-continuation-prompt (let ([k (call-with-continuation-prompt
(lambda () (lambda ()
@ -1466,7 +1470,7 @@
(lambda () (lambda ()
(exit-k (lambda () 'hi))) (exit-k (lambda () 'hi)))
p1))))) p1)))))
exn:fail:contract?) exn:fail:contract:continuation?)
;; Arrange for a barrier to interfere with a continuation ;; Arrange for a barrier to interfere with a continuation
;; jump after dynamic-winds are already being processed: ;; jump after dynamic-winds are already being processed:

79
racket/src/racket/src/fun.c
View File

@ -6098,12 +6098,13 @@ internal_call_cc (int argc, Scheme_Object *argv[])
prompt = scheme_get_prompt(SCHEME_PTR_VAL(pt), &prompt_cont, &prompt_pos); prompt = scheme_get_prompt(SCHEME_PTR_VAL(pt), &prompt_cont, &prompt_pos);
if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, pt)) { if (!prompt && !SAME_OBJ(scheme_default_prompt_tag, pt)) {
scheme_contract_error((composable scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
? "call-with-composable-continuation" "%s: continuation includes no prompt with the given tag\n"
: "call-with-current-continuation"), " tag: %V",
"continuation includes no prompt with the given tag", (composable
"tag", 1, prompt_tag, ? "call-with-composable-continuation"
NULL); : "call-with-current-continuation"),
prompt_tag);
return NULL; return NULL;
} }
@ -7608,10 +7609,10 @@ static Scheme_Object *do_abort_continuation (int argc, Scheme_Object *argv[], in
prompt = original_default_prompt; prompt = original_default_prompt;
if (!prompt) { if (!prompt) {
scheme_contract_error("abort-current-continuation", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"continuation includes no prompt with the given tag", "abort-current-continuation: continuation includes no prompt with the given tag\n"
"tag", 1, prompt_tag, " tag: %V",
NULL); prompt_tag);
return NULL; return NULL;
} }
@ -7994,10 +7995,10 @@ static Scheme_Object *continuation_marks(Scheme_Thread *p,
} }
if (!who) if (!who)
return NULL; return NULL;
scheme_contract_error(who, scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"no corresponding prompt in the continuation", "%s: no corresponding prompt in the continuation\n"
"tag", 1, prompt_tag, " tag: %V",
NULL); who, prompt_tag);
} }
} }
@ -8078,11 +8079,12 @@ cc_marks(int argc, Scheme_Object *argv[])
} }
if (!SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) if (!SAME_OBJ(scheme_default_prompt_tag, prompt_tag))
if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) {
scheme_contract_error("current-continuation-marks", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"no corresponding prompt in the continuation", "current-continuation-marks: no corresponding prompt in the continuation\n"
"prompt tag", 1, prompt_tag, " prompt tag: %V",
NULL); prompt_tag);
}
} }
return scheme_current_continuation_marks(argc ? prompt_tag : NULL); return scheme_current_continuation_marks(argc ? prompt_tag : NULL);
@ -8116,10 +8118,9 @@ cont_marks(int argc, Scheme_Object *argv[])
return make_empty_marks(); return make_empty_marks();
} else if (SCHEME_ECONTP(argv[0])) { } else if (SCHEME_ECONTP(argv[0])) {
if (!scheme_escape_continuation_ok(argv[0])) { if (!scheme_escape_continuation_ok(argv[0])) {
scheme_contract_error("continuation-marks", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"escape continuation not in the current thread's continuation", "continuation-marks: escape continuation not in the current thread's continuation\n"
"escape continuation", 1, argv[0], " escape continuation: %V", argv[0]);
NULL);
return NULL; return NULL;
} else { } else {
Scheme_Meta_Continuation *mc; 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 (!SAME_OBJ(scheme_default_prompt_tag, prompt_tag)) {
if (SCHEME_FALSEP(argv[0])) { if (SCHEME_FALSEP(argv[0])) {
if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) if (!scheme_extract_one_cc_mark(NULL, SCHEME_PTR_VAL(prompt_tag))) {
scheme_contract_error("continuation-mark-set-first", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"no corresponding prompt in the current continuation", "continuation-mark-set-first: no corresponding prompt in the current continuation\n"
"tag", 1, prompt_tag, " tag: %V",
NULL); prompt_tag);
}
} }
} }
} }
@ -8856,10 +8858,10 @@ static Scheme_Object *continuation_prompt_available(int argc, Scheme_Object *arg
if (argc > 1) { if (argc > 1) {
if (SCHEME_ECONTP(argv[1])) { if (SCHEME_ECONTP(argv[1])) {
if (!scheme_escape_continuation_ok(argv[1])) { if (!scheme_escape_continuation_ok(argv[1])) {
scheme_contract_error("continuation-prompt-available?", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"escape continuation not in the current thread's continuation", "continuation-prompt-available?: escape continuation not in the current thread's continuation\n"
"escape continuation", 1, argv[1], " escape continuation: %V",
NULL); argv[1]);
return NULL; return NULL;
} else { } else {
Scheme_Meta_Continuation *mc; Scheme_Meta_Continuation *mc;
@ -9501,12 +9503,13 @@ Scheme_Object *scheme_dynamic_wind(void (*pre)(void *),
prompt = original_default_prompt; prompt = original_default_prompt;
} }
if (!prompt) { if (!prompt) {
scheme_contract_error("abort-current-continuation", scheme_raise_exn(MZEXN_FAIL_CONTRACT_CONTINUATION,
"abort in progress, but current continuation includes" "abort-current-continuation:"
" no prompt with the given tag" " abort in progress, but current continuation includes"
" after a `dynamic-wind' post-thunk return", " no prompt with the given tag"
"tag", 1, tag, " after a `dynamic-wind' post-thunk return\n"
NULL); " tag: %V",
tag);
return NULL; return NULL;
} }
p->cjs.jumping_to_continuation = (Scheme_Object *)prompt; p->cjs.jumping_to_continuation = (Scheme_Object *)prompt;