make binding on #%module-begin form more consistent when the module body contains a single expression (patch from samth)

svn: r5889
This commit is contained in:
Matthew Flatt 2007-04-08 11:48:28 +00:00
parent 9c8c0a22cd
commit 392bd607d4
2 changed files with 50 additions and 3 deletions

View File

@ -223,6 +223,52 @@
(require p3_cr)
(test 18 values w_cr)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test proper bindings for `#%module-begin'
(test (void) eval
'(begin
(module mod_beg2 mzscheme
(provide (all-from-except mzscheme #%module-begin))
(provide (rename mb #%module-begin))
(define-syntax (mb stx)
(syntax-case stx ()
[(_ . forms)
#`(#%plain-module-begin
#,(datum->syntax-object stx '(require-for-syntax mzscheme))
. forms)])))
(module m mod_beg2
3)))
(test (void) eval
'(begin
(module mod_beg2 mzscheme
(provide (all-from-except mzscheme #%module-begin))
(provide (rename mb #%module-begin))
(define-syntax (mb stx)
(syntax-case stx ()
[(_ . forms)
#`(#%plain-module-begin
#,(datum->syntax-object stx '(require-for-syntax mzscheme))
. forms)])))
(module m mod_beg2
3 4)))
(test (void) eval
'(begin
(module mod_beg2 mzscheme
(provide (all-from-except mzscheme #%module-begin))
(provide (rename mb #%module-begin))
(define-syntax (mb stx)
(syntax-case stx ()
[(mb . forms)
#`(#%plain-module-begin
#,(datum->syntax-object #'mb '(require-for-syntax mzscheme))
. forms)])))
(module m mod_beg2
3)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -3600,12 +3600,13 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
if (!SAME_OBJ(mbval, modbeg_syntax)) {
Scheme_Object *mb;
mb = scheme_datum_to_syntax(module_begin_symbol, form, scheme_false, 0, 0);
mb = scheme_add_rename(mb, rn);
mb = scheme_add_rename(mb, et_rn);
mb = scheme_add_rename(mb, tt_rn);
fm = scheme_make_pair(mb, scheme_make_pair(fm, scheme_null));
fm = scheme_datum_to_syntax(fm, form, form, 0, 2);
fm = scheme_stx_property(fm, module_name_symbol, m->modname);
/* Since fm is a newly-created syntax object, we need to re-add renamings: */
fm = scheme_add_rename(fm, rn);
fm = scheme_add_rename(fm, et_rn);
fm = scheme_add_rename(fm, tt_rn);
check_mb = 1;
}
}