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

fix interaction of `continuation-mark-set-first' and prompts

Browse Source 
including a documentation fix
This commit is contained in:
Matthew Flatt 2011-01-15 07:49:59 -07:00
parent 90b8400d50
commit c2afc03b3b
4 changed files with 138 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/reference/cont-marks.scrbl
View File

@ -108,14 +108,16 @@ elements to indicate the lack of a value.}
@defproc[(continuation-mark-set-first
[mark-set (or/c continuation-mark-set? #f)]
[key-v any/c]
[none-v any/c #f]
[prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)])
any]{
Returns the first element of the list that would be returned by
@racket[(continuation-mark-set->list (or mark-set
(current-continuation-marks prompt-tag)) key-v prompt-tag)], or
@racket[#f] if the result would be the empty list. Typically, this
@racket[none-v] if the result would be the empty list. Typically, this
result can be computed more quickly using
@racket[continuation-mark-set-first].}
@racket[continuation-mark-set-first] than using
@racket[continuation-mark-set->list].}
@defproc[(call-with-immediate-continuation-mark
[key-v any/c]

122
collects/tests/racket/contmark.rktl
View File

@ -793,6 +793,128 @@
(test (list s #t)
list s (for/and ([i (in-range 100)]) (go)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test interaction of prompts and `continuation-mark-set-first'
(let ()
(define key 'key)
(define value 'value)
(define pt (make-continuation-prompt-tag))
(for-each
(lambda (thunk)
(test #f (lambda (f) (f)) thunk))
(list
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
#f
key)))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks)
key)))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks (default-continuation-prompt-tag))
key)))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
#f
key
#f
(default-continuation-prompt-tag))))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks)
key
#f
(default-continuation-prompt-tag))))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks)
key
#f
pt))
pt)))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks (default-continuation-prompt-tag))
key
#f
(default-continuation-prompt-tag))))))
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks pt)
key
#f
(default-continuation-prompt-tag)))
pt)))))
(test 'alt 'alt-fail
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
#f
key
'alt)))))
(test value 'no-block
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks)
key
#f
(default-continuation-prompt-tag)))
pt)))
(test value 'no-block2
(call-with-continuation-prompt
(lambda ()
(with-continuation-mark key value
(call-with-continuation-prompt
(lambda ()
(continuation-mark-set-first
(current-continuation-marks pt)
key
#f
pt)))))
pt)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

7
collects/tests/racket/prompt-tests.rktl
View File

@ -855,11 +855,16 @@
(lambda ()
(k (lambda () (continuation-mark-set-first #f 'x #f catch-tag))))
catch-tag)
(test 8
(test #f
call-with-continuation-prompt
(lambda ()
(k (lambda () (continuation-mark-set-first #f 'y #f catch-tag))))
catch-tag)
(test (if (eq? catch-tag (default-continuation-prompt-tag)) #f 8)
call-with-continuation-prompt
(lambda ()
(k (lambda () (continuation-mark-set-first #f 'y #f catch-tag))))
(default-continuation-prompt-tag))
(test (if blocked?
'(17)
'(17 18))

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

@ -8125,6 +8125,8 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
while (chain) {
if (chain->key == key)
return chain->val;
else if (SAME_OBJ(chain->key, prompt_tag))
break;
else
chain = chain->next;
}
@ -8165,6 +8167,8 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
val = seg[pos].val;
vpos = seg[pos].pos;
break;
} else if (SAME_OBJ(seg[pos].key, prompt_tag)) {
break;
} else {
cache = seg[pos].cache;
if (cache && SCHEME_HASHTP(cache))
@ -8347,7 +8351,8 @@ extract_one_cc_mark(int argc, Scheme_Object *argv[])
}
}
r = scheme_extract_one_cc_mark_to_tag(SCHEME_TRUEP(argv[0]) ? argv[0] : NULL, argv[1], prompt_tag);
r = scheme_extract_one_cc_mark_to_tag(SCHEME_TRUEP(argv[0]) ? argv[0] : NULL, argv[1],
prompt_tag ? SCHEME_PTR_VAL(prompt_tag) : NULL);
if (!r) {
if (argc > 2)
r = argv[2];