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

fix validation of module .zo exp-time content, and fix zo-marshal

Browse Source
This commit is contained in:
Matthew Flatt 2010-07-08 16:51:47 -06:00
parent 8505bd8bca
commit c7c8f56e11
2 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/compiler/zo-marshal.rkt
View File

@ -479,7 +479,18 @@
[l (cons (lookup-req 1) l)] ; et-requires [l (cons (lookup-req 1) l)] ; et-requires
[l (cons (lookup-req 0) l)] ; requires [l (cons (lookup-req 0) l)] ; requires
[l (cons (list->vector body) l)] [l (cons (list->vector body) l)]
[l (cons (list->vector syntax-body) l)] [l (cons (list->vector
(for/list ([i (in-list syntax-body)])
(define (maybe-one l) ;; a single symbol is ok
(if (and (pair? l) (null? (cdr l)))
(car l)
l))
(match i
[(struct def-syntaxes (ids rhs prefix max-let-depth))
(vector (maybe-one ids) rhs max-let-depth prefix #f)]
[(struct def-for-syntax (ids rhs prefix max-let-depth))
(vector (maybe-one ids) rhs max-let-depth prefix #t)])))
l)]
[l (append (apply [l (append (apply
append append
(map (lambda (l) (map (lambda (l)

16
src/racket/src/module.c
View File

@ -10416,6 +10416,22 @@ static Scheme_Object *read_module(Scheme_Object *obj)
e = SCHEME_CAR(obj); e = SCHEME_CAR(obj);
if (!SCHEME_VECTORP(e)) return_NULL(); if (!SCHEME_VECTORP(e)) return_NULL();
m->et_body = e; m->et_body = e;
for (i = SCHEME_VEC_SIZE(e); i--; ) {
e = SCHEME_VEC_ELS(m->et_body)[i];
if (!SCHEME_VECTORP(e)) return_NULL();
/* SCHEME_VEC_ELS(e)[1] should be code */
if (!SCHEME_INTP(SCHEME_VEC_ELS(e)[2])) return_NULL();
if (!SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(e)[3]), scheme_resolve_prefix_type))
return_NULL();
e = SCHEME_VEC_ELS(e)[0];
if (!SCHEME_SYMBOLP(e)) {
while (SCHEME_PAIRP(e)) {
if (!SCHEME_SYMBOLP(SCHEME_CAR(e))) return_NULL();
e = SCHEME_CDR(e);
}
if (!SCHEME_NULLP(e)) return_NULL();
}
}
obj = SCHEME_CDR(obj); obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return_NULL(); if (!SCHEME_PAIRP(obj)) return_NULL();