disable check on a module's source name

This commit is contained in:
Matthew Flatt 2010-05-14 07:18:34 -06:00
parent b072d85107
commit 8752e65bf8
5 changed files with 43 additions and 29 deletions

View File

@ -707,6 +707,7 @@
;; check-filename-matches : path datum syntax -> void ;; check-filename-matches : path datum syntax -> void
(define (check-filename-matches filename datum unexpanded-stx) (define (check-filename-matches filename datum unexpanded-stx)
(when #f ; we don't check filename matching anymore
(let-values ([(base name dir?) (split-path filename)]) (let-values ([(base name dir?) (split-path filename)])
(let ([expected (string->symbol (let ([expected (string->symbol
(path->string (path-replace-suffix name #"")))]) (path->string (path-replace-suffix name #"")))])
@ -716,7 +717,7 @@
"module name doesn't match saved filename, got ~s and expected ~s" "module name doesn't match saved filename, got ~s and expected ~s"
datum datum
expected) expected)
unexpanded-stx))))) unexpanded-stx))))))
(define module-language-put-file-mixin (define module-language-put-file-mixin
(mixin (text:basic<%>) () (mixin (text:basic<%>) ()

View File

@ -126,10 +126,13 @@ If the second argument to the load handler is a symbol, then:
(read-accept-reader #t) (read-accept-reader #t)
]} ]}
@item{If the read result is not a @racketidfont{module} form with the @item{If the read result is not a @racketidfont{module} form, or if a
expected name, or if a second @racket[read-syntax] does not second @racket[read-syntax] does not produce an end-of-file,
produce an end-of-file, then the @exnraise[exn:fail] without then the @exnraise[exn:fail] without evaluating the form that
evaluating the form that was read from the file.} was read from the file. (In previous versions, the module
declaration was checked to match the name given as the second
argument to the load handler, but this check is no longer
performed.)}
@item{The @tech{lexical information} of the initial @item{The @tech{lexical information} of the initial
@racketidfont{module} identifier is enriched with a binding for @racketidfont{module} identifier is enriched with a binding for

View File

@ -33,7 +33,8 @@
"expected a `module' declaration for `~a' in ~s, but found end-of-file" "expected a `module' declaration for `~a' in ~s, but found end-of-file"
expected-module filename))] expected-module filename))]
[(compiled-module-expression? (syntax-e exp)) [(compiled-module-expression? (syntax-e exp))
(if (eq? (module-compiled-name (syntax-e exp)) expected-module) (if (or #t ; we don't check the name anymore
(eq? (module-compiled-name (syntax-e exp)) expected-module))
;; It's fine: ;; It's fine:
exp exp
;; Wrong name: ;; Wrong name:
@ -47,9 +48,10 @@
[_else #f])) [_else #f]))
;; It's ok; need to install a specific `module' binding: ;; It's ok; need to install a specific `module' binding:
(with-syntax ([(mod nm . _) exp]) (with-syntax ([(mod nm . _) exp])
(when #f ; we don't check the name anymore
(unless (eq? (syntax-e #'nm) expected-module) (unless (eq? (syntax-e #'nm) expected-module)
(raise-wrong-module-name filename expected-module (raise-wrong-module-name filename expected-module
(syntax-e #'nm))) (syntax-e #'nm))))
(datum->syntax-object exp (datum->syntax-object exp
(cons (namespace-module-identifier) (cons (namespace-module-identifier)
(cdr (syntax-e exp))) (cdr (syntax-e exp)))

View File

@ -17,10 +17,14 @@ values.}
(or/c syntax? false/c)]{ (or/c syntax? false/c)]{
Inspects @scheme[stx] to check whether evaluating it will declare a Inspects @scheme[stx] to check whether evaluating it will declare a
module named @scheme[expected-module-sym]---at least if @scheme[module] is bound module---at least if @scheme[module] is bound in the top-level to
in the top-level to Racket's @scheme[module]. The syntax object @scheme[stx] can Racket's @scheme[module]. The syntax object @scheme[stx] can contain a
contain a compiled expression. Also, @scheme[stx] can be an end-of-file, on compiled expression. Also, @scheme[stx] can be an end-of-file, on the
the grounds that @scheme[read-syntax] can produce an end-of-file. grounds that @scheme[read-syntax] can produce an end-of-file.
The @scheme[expected-module-sym] argument is currently ignored. In
previous versions, the module form @scheme[stx] was obliged to declare
a module who name matched @scheme[expected-module-sym].
If @scheme[stx] can declare a module in an appropriate top-level, then If @scheme[stx] can declare a module in an appropriate top-level, then
the @scheme[check-module-form] procedure returns a syntax object that the @scheme[check-module-form] procedure returns a syntax object that

View File

@ -4085,7 +4085,7 @@ static Scheme_Object *do_load_handler(void *data)
Scheme_Config *config = lhd->config; Scheme_Config *config = lhd->config;
Scheme_Object *last_val = scheme_void, *obj, **save_array = NULL; Scheme_Object *last_val = scheme_void, *obj, **save_array = NULL;
Scheme_Env *genv; Scheme_Env *genv;
int save_count = 0, got_one = 0, as_module; int save_count = 0, got_one = 0, as_module, check_module_name = 0;
while ((obj = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, 0, -1, NULL, while ((obj = scheme_internal_read(port, lhd->stxsrc, 1, 0, 0, 0, 0, -1, NULL,
NULL, NULL, lhd->delay_load_info)) NULL, NULL, lhd->delay_load_info))
@ -4108,10 +4108,12 @@ static Scheme_Object *do_load_handler(void *data)
m = scheme_extract_compiled_module(SCHEME_STX_VAL(d)); m = scheme_extract_compiled_module(SCHEME_STX_VAL(d));
if (m) { if (m) {
if (check_module_name) {
if (!SAME_OBJ(SCHEME_PTR_VAL(m->modname), lhd->expected_module)) { if (!SAME_OBJ(SCHEME_PTR_VAL(m->modname), lhd->expected_module)) {
other = m->modname; other = m->modname;
d = NULL; d = NULL;
} }
}
} else { } else {
if (!SCHEME_STX_PAIRP(d)) if (!SCHEME_STX_PAIRP(d))
d = NULL; d = NULL;
@ -4126,12 +4128,14 @@ static Scheme_Object *do_load_handler(void *data)
else { else {
a = SCHEME_STX_CAR(d); a = SCHEME_STX_CAR(d);
other = SCHEME_STX_VAL(a); other = SCHEME_STX_VAL(a);
if (check_module_name) {
if (!SAME_OBJ(other, lhd->expected_module)) if (!SAME_OBJ(other, lhd->expected_module))
d = NULL; d = NULL;
} }
} }
} }
} }
}
/* If d is NULL, shape was wrong */ /* If d is NULL, shape was wrong */
if (!d) { if (!d) {