fix break checking on continuation applciation
Racket did not check for a break when escaping from a break-disabled context to a break-enabled context. RacketCS didn't check in other cases, either. Fix those various cases.
This commit is contained in:
parent
40b5fffb80
commit
27693843ea
|
@ -1235,7 +1235,8 @@
|
|||
should-post-break?
|
||||
should-done-break?)
|
||||
;; print the state for this test:
|
||||
(test #t list? (list 'go
|
||||
(test #t list? (list 'go
|
||||
mk-t* break-off?
|
||||
pre-thunk act-thunk post-thunk
|
||||
pre-semaphore-wait act-semaphore-wait post-semaphore-wait
|
||||
try-pre-break
|
||||
|
@ -1354,8 +1355,8 @@
|
|||
no-capture no-capture no-capture
|
||||
args))))])
|
||||
(list plain-mk-t
|
||||
(mk-capturing 'pre)
|
||||
(mk-capturing 'act))))))
|
||||
(procedure-rename (mk-capturing 'pre) 'pre-capturing)
|
||||
(procedure-rename (mk-capturing 'act) 'act-capturing))))))
|
||||
|
||||
;; ----------------------------------------
|
||||
;; Check wrap-evt result superceded by internally
|
||||
|
|
|
@ -197,6 +197,49 @@
|
|||
(err/rt-test (break-thread (current-thread) 'hang-up) exn:break:hang-up?)
|
||||
(err/rt-test (break-thread (current-thread) 'terminate) exn:break:terminate?)
|
||||
|
||||
(let ([bad? #f])
|
||||
(define t
|
||||
(thread
|
||||
(lambda ()
|
||||
(let/ec k
|
||||
(parameterize-break #f
|
||||
(break-thread (current-thread))
|
||||
(k #f)))
|
||||
(set! bad? #t))))
|
||||
(sync t)
|
||||
(test #f 'escape bad?))
|
||||
|
||||
(let ([bad? #f])
|
||||
(define t
|
||||
(thread
|
||||
(lambda ()
|
||||
(let/cc k
|
||||
(parameterize-break #f
|
||||
(break-thread (current-thread))
|
||||
(k #f)))
|
||||
(set! bad? #t))))
|
||||
(sync t)
|
||||
(test #f 'escape/cc bad?))
|
||||
|
||||
(let ([bad? #f])
|
||||
(define t
|
||||
(thread
|
||||
(lambda ()
|
||||
(define jump-k #f)
|
||||
(parameterize-break #f
|
||||
((let/cc k
|
||||
(set! jump-k k)
|
||||
void)
|
||||
#f))
|
||||
(let/cc k
|
||||
(parameterize-break #f
|
||||
(break-thread (current-thread))
|
||||
(jump-k k)))
|
||||
(set! bad? #t))))
|
||||
(sync t)
|
||||
(test #f 'jump-in bad?))
|
||||
|
||||
|
||||
(let ([ex? #f]
|
||||
[s (make-semaphore)])
|
||||
(define (go)
|
||||
|
|
|
@ -286,7 +286,7 @@
|
|||
[(aborting? r)
|
||||
;; Remove the prompt as we call the handler:
|
||||
(pop-metacontinuation-frame)
|
||||
(end-uninterrupted 'handle)
|
||||
(end-uninterrupted/call-hook 'handle)
|
||||
(apply handler
|
||||
(aborting-args r))]
|
||||
[else
|
||||
|
@ -888,11 +888,7 @@
|
|||
;; Called on the arguments to return to a continuation
|
||||
;; captured by `call/cc/end-uninterrupted`:
|
||||
(define (end-uninterrupted-with-values args)
|
||||
;; Arguably, we should use `end-uninterrupted/hook` here to check
|
||||
;; for breaks, in case a jump enabled breaks and one is pending.
|
||||
;; The traditional Racket implementation doesn't include that
|
||||
;; check, and the check imposes a costs, so we leave it out for now.
|
||||
(end-uninterrupted 'cc)
|
||||
(end-uninterrupted/call-hook 'cc)
|
||||
(apply values args))
|
||||
|
||||
(define (current-mark-chain)
|
||||
|
|
|
@ -4276,6 +4276,7 @@ do_call_ec (int argc, Scheme_Object *argv[], Scheme_Object *_for_cc)
|
|||
reset_cjs(&p2->cjs);
|
||||
scheme_restore_env_stack_w_thread(cont->envss, p2);
|
||||
p2->suspend_break = 0;
|
||||
scheme_check_break_now();
|
||||
if (n != 1)
|
||||
v = scheme_values(n, (Scheme_Object **)v);
|
||||
} else {
|
||||
|
|
|
@ -725,7 +725,11 @@
|
|||
;; `check-for-break` should be called.
|
||||
(define (check-for-break)
|
||||
(define t (current-thread))
|
||||
(when t ; allow `check-for-break` before threads are running
|
||||
(when (and
|
||||
;; allow `check-for-break` before threads are running:
|
||||
t
|
||||
;; quick pre-test before going atomic:
|
||||
(thread-pending-break t))
|
||||
((atomically
|
||||
(cond
|
||||
[(and (thread-pending-break t)
|
||||
|
|
Loading…
Reference in New Issue
Block a user