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

fix argument checking of semi-inlined `continuation-mark-set-first'

Browse Source 
Closes PR 13256
This commit is contained in:
Matthew Flatt 2012-11-15 06:33:32 -07:00
parent a9b6f8ea46
commit ed89b32de4
2 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/tests/racket/optimize.rktl
View File

@ -2573,5 +2573,14 @@
(read (open-input-bytes (get-output-bytes o)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check error checking of JITted `continuation-mark-set-first'
(err/rt-test (let ([f #f])
(set! f (lambda ()
(continuation-mark-set-first 5 #f)))
(f)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

9
src/racket/src/jitinline.c
View File

@ -56,6 +56,15 @@ static Scheme_Object *extract_one_cc_mark_to_tag(Scheme_Object *mark_set,
{
/* wrapper on scheme_extract_one_cc_mark_to_tag() to convert NULL to false */
Scheme_Object *r;
if (mark_set && !SAME_TYPE(SCHEME_TYPE(mark_set), scheme_cont_mark_set_type)) {
Scheme_Object *a[2];
a[0] = mark_set;
a[1] = key;
scheme_wrong_contract("continuation-mark-set-first", "(or/c continuation-mark-set? #f)", 0, 2, a);
return NULL;
}
r = scheme_extract_one_cc_mark_to_tag(mark_set, key, prompt_tag);
if (!r) return scheme_false;
return r;