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

fix problem with dw and implicit prompt

Browse Source 
svn: r5899
This commit is contained in:
Matthew Flatt 2007-04-09 05:22:18 +00:00
parent 2da6fa852d
commit e4d0589442
2 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/tests/mzscheme/prompt-tests.ss
View File

@ -1673,21 +1673,27 @@
;; implicit prompt in the calling thread.
(let ()
(define (foo thunk)
(call-with-continuation-prompt
(lambda ()
(let/cc ret
(let ([run? #f])
(let/cc run
(thread (lambda ()
(sync (system-idle-evt))
(set! run? #t)
(run))))
(when run? (ret (thunk))))))))
(define s (make-semaphore))
(foo (lambda () (semaphore-post s)))
(test s sync s))
(define (go wrap)
(let ()
(define (foo thunk)
(call-with-continuation-prompt
(lambda ()
(wrap
(lambda ()
(let/cc ret
(let ([run? #f])
(let/cc run
(thread (lambda ()
(sync (system-idle-evt))
(set! run? #t)
(run))))
(when run? (ret (thunk))))))))))
(define s (make-semaphore))
(foo (lambda () (semaphore-post s)))
(test s sync s)))
(go (lambda (f) (f)))
(go (lambda (f) (dynamic-wind void f void))))
;; ----------------------------------------
;; Try long chain of composable continuations

6
src/mzscheme/src/fun.c
View File

@ -4564,11 +4564,13 @@ static void restore_continuation(Scheme_Cont *cont, Scheme_Thread *p, int for_pr
p->dw = common_dw;
p->next_meta = common_next_meta;
if (p->dw) { /* can be empty if there's only the pseudo-prompt */
/* also, there may be no dw with prompt_tag if there's only the pseudo prompt */
all_dw = clone_dyn_wind(p->dw, cont->prompt_tag, -1, NULL, 1, 0);
for (dw = all_dw; !SAME_OBJ(dw->prompt_tag, cont->prompt_tag); dw = dw->prev) {
for (dw = all_dw; dw && !SAME_OBJ(dw->prompt_tag, cont->prompt_tag); dw = dw->prev) {
p->dw = p->dw->prev;
}
dw->next_meta += 1;
if (dw)
dw->next_meta += 1;
p->dw = all_dw;
}
}