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

fix expand on a module containing lifts from expression

Browse Source 
Another attempt at the bug that b95baa1d25 was intended to fix.
This commit is contained in:
Matthew Flatt 2014-07-30 10:33:52 +01:00
parent b95baa1d25
commit 9d17a35539
3 changed files with 39 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt
View File

@ -116,21 +116,4 @@
'(module m '#%kernel
(#%declare #:cross-phase-persistent))))))
;; Check that `expand` produces valies syntax
(let ()
(define e
(syntax->datum
(parameterize ([current-namespace (make-base-namespace)])
(expand '(module m '#%kernel
(#%declare #:cross-phase-persistent))))))
(let loop ([e e])
(cond
[(syntax? e) (loop (syntax-e e))]
[(pair? e) (loop (car e)) (loop (cdr e))]
[(null? e) (void)]
[(symbol? e) (void)]
[(keyword? e) (void)]
[else (error 'expand-test "unexpected value: ~e" e)])))
(displayln "All tests passed.")

31
pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl
View File

@ -1095,4 +1095,35 @@
;; ----------------------------------------
;; Check that `expand` produces valied syntax
(let ()
(define (check mod)
(define e
(syntax->datum
(parameterize ([current-namespace (make-base-namespace)])
(expand mod))))
(let loop ([e e])
(cond
[(syntax? e) (loop (syntax-e e))]
[(pair? e) (loop (car e)) (loop (cdr e))]
[(null? e) (void)]
[(symbol? e) (void)]
[(keyword? e) (void)]
[(number? e) (void)]
[(boolean? e) (void)]
[else (error 'expand-test "unexpected value: ~e" e)])))
(check '(module m '#%kernel
(#%declare #:cross-phase-persistent)))
(check '(module m '#%kernel
(define-values (x) 10)))
(check '(module m racket/base
(require (for-syntax racket/base))
(define-syntax (m stx)
(syntax-local-lift-expression #'(+ 1 2)))
(list (m))))
(check '(module m racket/base
(module+ main 10))))
;; ----------------------------------------
(report-errs)

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

@ -292,6 +292,7 @@ THREAD_LOCAL_DECL(static Scheme_Object *global_shift_cache);
#define PROVIDE_MODFORM_KIND 3
#define MODULE_MODFORM_KIND 4
#define SAVED_MODFORM_KIND 5
#define DECLARE_MODFORM_KIND 6
/* combined bitwise: */
#define NON_PHASELESS_IMPORT 0x1
@ -9157,7 +9158,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
if (!SCHEME_STX_NULLP(kws))
scheme_wrong_syntax(who, NULL, e, IMPROPER_LIST_FORM);
kind = SAVED_MODFORM_KIND;
kind = DECLARE_MODFORM_KIND;
} else if (scheme_stx_module_eq_x(scheme_module_stx, fst, phase)
|| scheme_stx_module_eq_x(scheme_modulestar_stx, fst, phase)) {
/************ module[*] *************/
@ -9312,6 +9313,11 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
SCHEME_EXPAND_OBSERVE_NEXT(observer);
if (kind == SAVED_MODFORM_KIND) {
expanded_l = scheme_make_pair(SCHEME_CDR(e), expanded_l);
SCHEME_CAR(p) = SCHEME_CAR(e);
prev_p = p;
p = SCHEME_CDR(p);
} else if (kind == DECLARE_MODFORM_KIND) {
expanded_l = scheme_make_pair(e, expanded_l);
p = SCHEME_CDR(p);
} else if ((kind == PROVIDE_MODFORM_KIND)