diff --git a/collects/tests/racket/prompt-tests.rktl b/collects/tests/racket/prompt-tests.rktl index db9212a505..c7dddec707 100644 --- a/collects/tests/racket/prompt-tests.rktl +++ b/collects/tests/racket/prompt-tests.rktl @@ -2212,4 +2212,46 @@ 'expected-result))))))))) (λ (x) x)))) +;; ---------------------------------------- +;; There's a "is the target prompt still in place?" +;; check that should not happen when a composable +;; continuation is applied. (Random testing discovered +;; an incorrect check.) +(test + 12345 + 'no-prompt-check-on-compose + (let () + (define pt1 (make-continuation-prompt-tag)) + + (define-syntax-rule (% pt body handler) + (call-with-continuation-prompt + (lambda () body) + pt + handler)) + + ;; (lambda (v) v) + ;; as a composable continuation: + (define comp-id + (% + pt1 + (call-with-composable-continuation + (λ (k) (abort-current-continuation pt1 k)) + pt1) + (lambda (k) k))) + + ((% pt1 + (dynamic-wind + (λ () (comp-id 2)) + (λ () + ;; As we jump back to this continuation, + ;; it's ok that no `pt1' prompt is + ;; in place anymore + (call-with-composable-continuation + (λ (k) (abort-current-continuation + pt1 + k)) + pt1)) + (λ () #f)) + (λ (x) x)) + 12345))) diff --git a/src/racket/src/fun.c b/src/racket/src/fun.c index 2124d304de..3513ee42f0 100644 --- a/src/racket/src/fun.c +++ b/src/racket/src/fun.c @@ -5584,9 +5584,11 @@ static MZ_MARK_STACK_TYPE exec_dyn_wind_pres(Scheme_Dynamic_Wind_List *dwl, if (!skip_dws) pre(dwl->dw->data); - if (scheme_continuation_application_count != old_cac) { - old_cac = scheme_continuation_application_count; - scheme_recheck_prompt_and_barrier(cont); + if (!cont->composable) { + if (scheme_continuation_application_count != old_cac) { + old_cac = scheme_continuation_application_count; + scheme_recheck_prompt_and_barrier(cont); + } } } p = scheme_current_thread;