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

fix 'module-langugage tracking

Browse Source 
svn: r11832
This commit is contained in:
Matthew Flatt 2008-09-22 13:08:40 +00:00
parent afb21c32b5
commit ce10c4a5fc
4 changed files with 47 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/tests/mzscheme/lang/reader.ss Normal file
View File

@ -0,0 +1,16 @@
#lang scheme/base
(require syntax/module-reader)
(provide (rename-out [my-read read]
[my-read-syntax read-syntax]))
(define (my-read port modpath line col pos)
(wrap-read-all 'scheme port read modpath (object-name port) line col pos))
(define (my-read-syntax src port modpath line col pos)
(syntax-property
(datum->syntax #f
(wrap-read-all 'scheme port (lambda (in) (read-syntax src in)) modpath src line col pos)
#f)
'module-language
'#(tests/mzscheme/lang/getinfo get-info closure-data)))

27
collects/tests/mzscheme/module.ss
View File

@ -407,6 +407,33 @@
(test #t module-path? '(planet "foo.ss" ("robby" "redex.plt") "sub" "deeper"))
(test #t module-path? '(planet "foo%2e.ss" ("robby%2e" "redex%2e.plt") "sub%2e" "%2edeeper"))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check 'module-language, `module-compiled-language-info', and `module->language-info'
(let ([mk (lambda (val)
(compile (syntax-property #'(module m scheme/base)
'module-language
val)))])
(test #f 'info (module-compiled-language-info (mk 10)))
(test '#(scheme x "whatever") 'info (module-compiled-language-info (mk '#(scheme x "whatever"))))
(let ([ns (make-base-namespace)])
(parameterize ([current-namespace ns])
(eval mk ns)
(eval (mk '#(scheme x "whatever")))
(test '#(scheme x "whatever") module->language-info ''m)
(let ([path (build-path (collection-path "tests" "mzscheme")
"langm.ss")])
(parameterize ([read-accept-reader #t]
[current-module-declare-name (module-path-index-resolve
(module-path-index-join path #f))])
(eval
(read-syntax path
(open-input-string "#lang tests/mzscheme (provide x) (define x 1)"
path)))
((current-module-name-resolver) (current-module-declare-name))))
(test '#(tests/mzscheme/lang/getinfo get-info closure-data)
module->language-info 'tests/mzscheme/langm))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

4
src/mzscheme/src/eval.c
View File

@ -4715,7 +4715,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
module's language take over. */
d = SCHEME_STX_CDR(form);
a = scheme_make_pair(a, d);
form = scheme_datum_to_syntax(a, form, form, 1, 0);
form = scheme_datum_to_syntax(a, form, form, 0, 1);
return form;
}
}
@ -9282,7 +9282,7 @@ static Scheme_Object *do_eval_string_all(const char *str, Scheme_Env *env, int c
scheme_sys_wraps(NULL),
0, 0),
SCHEME_CDR(m));
expr = scheme_datum_to_syntax(m, expr, expr, 0, 0);
expr = scheme_datum_to_syntax(m, expr, expr, 0, 1);
}
}
}

4
src/mzscheme/src/module.c
View File

@ -5267,8 +5267,8 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
m->ii_src = NULL;
pv = scheme_stx_property(form, scheme_intern_symbol("module-lanuage"), NULL);
if (pv) {
pv = scheme_stx_property(form, scheme_intern_symbol("module-language"), NULL);
if (pv && SCHEME_TRUEP(pv)) {
if (SCHEME_VECTORP(pv)
&& (3 == SCHEME_VEC_SIZE(pv))
&& scheme_is_module_path(SCHEME_VEC_ELS(pv)[0])