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

Fix continuation mark chaperones

Browse Source 
Failed to redirect correctly on `continuation-mark-set-first`
when the mark set argument was #f.
This commit is contained in:
Asumu Takikawa 2012-11-02 11:05:20 -04:00
parent 4ead534227
commit 948e898406
2 changed files with 22 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/racket/contract-test.rktl
View File

@ -4350,6 +4350,25 @@
(with-continuation-mark mark (lambda (x) (+ x 1))
(do-mark mark))))
(test/pos-blame
'continuation-mark-key/c-ho-10
'(let* ([mark (make-continuation-mark-key)]
[ctc-mark (contract (continuation-mark-key/c number?)
mark
'pos
'neg)])
(with-continuation-mark mark "not a number"
(+ 1 (continuation-mark-set-first #f ctc-mark)))))
(test/spec-passed
'continuation-mark-key/c-ho-11
'(let* ([mark (make-continuation-mark-key)]
[ctc-mark (contract (continuation-mark-key/c number?)
mark
'pos
'neg)])
(continuation-mark-set-first #f ctc-mark)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; make-contract

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

@ -7889,6 +7889,9 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
}
}
if (key_arg != key && val != NULL)
val = scheme_chaperone_do_continuation_mark("continuation-mark-set-first", 1, key_arg, val);
pos = startpos - findpos;
if (pos > 16) {
pos >>= 1;
@ -7931,8 +7934,6 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
} else
cht = NULL;
if (key_arg != key)
val = scheme_chaperone_do_continuation_mark("continuation-mark-set-first", 1, key_arg, val);
if (!cache || !SCHEME_VECTORP(cache)) {
/* No cache so far, so map one key */
cache = scheme_make_vector(4, NULL);