From f2f23221404af69390f0f5454b98f492bf2144bb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 4 Mar 2008 14:56:46 +0000 Subject: [PATCH] fix another stx bug introduced in phase generalization svn: r8871 --- collects/tests/mzscheme/stx.ss | 21 +++++++++++++++++++++ src/mzscheme/src/cstartup.inc | 12 ++++++------ src/mzscheme/src/schvers.h | 4 ++-- src/mzscheme/src/stxobj.c | 3 ++- 4 files changed, 31 insertions(+), 9 deletions(-) diff --git a/collects/tests/mzscheme/stx.ss b/collects/tests/mzscheme/stx.ss index d750ef2174..a4682cde47 100644 --- a/collects/tests/mzscheme/stx.ss +++ b/collects/tests/mzscheme/stx.ss @@ -1366,6 +1366,27 @@ (when (file-exists? "tmp10") (delete-file "tmp10")) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Make sure post-ex renames aren't simplied away too soon: + +(module @simp@ scheme/base + + (require (for-syntax scheme/base)) + + (define-syntax-rule (foo) + (begin + (define-for-syntax goo #'intro) + (define intro 5) + (define-syntax (extract stx) + #`(quote #,(identifier-binding goo))) + (define @simp@tst (extract)) + (provide @simp@tst))) + + (foo)) +(require '@simp@) + +(test #t list? @simp@tst) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index ddccfe70cb..fdbfa03b00 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -28,14 +28,14 @@ 35,34,35,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,173,3, 80,158,37,34,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,9,248, 22,65,23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4, -11,11,2,18,3,1,7,101,110,118,55,50,49,49,16,4,11,11,2,19,3, -1,7,101,110,118,55,50,49,50,27,248,22,65,248,22,180,3,23,197,1,28, +11,11,2,18,3,1,7,101,110,118,55,50,49,51,16,4,11,11,2,19,3, +1,7,101,110,118,55,50,49,52,27,248,22,65,248,22,180,3,23,197,1,28, 248,22,71,23,194,2,20,15,159,35,34,35,28,248,22,71,248,22,65,23,195, 2,248,22,64,193,249,22,173,3,80,158,37,34,250,22,73,2,20,248,22,73, 249,22,73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21, 2,21,249,22,63,2,12,248,22,65,23,205,1,18,100,11,8,31,8,30,8, -29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,50,49,52, -16,4,11,11,2,19,3,1,7,101,110,118,55,50,49,53,248,22,180,3,193, +29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,50,49,54, +16,4,11,11,2,19,3,1,7,101,110,118,55,50,49,55,248,22,180,3,193, 27,248,22,180,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27, 248,22,65,248,22,180,3,23,197,1,249,22,173,3,80,158,37,34,28,248,22, 51,248,22,174,3,248,22,64,23,198,2,27,249,22,2,32,0,89,162,8,44, @@ -65,8 +65,8 @@ 65,202,251,22,73,2,17,28,249,22,140,8,248,22,174,3,248,22,64,23,201, 2,64,101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22, 65,23,201,1,249,22,63,2,4,248,22,65,23,203,1,99,8,31,8,30,8, -29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,50,51,55, -16,4,11,11,2,19,3,1,7,101,110,118,55,50,51,56,18,158,94,10,64, +29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,50,51,57, +16,4,11,11,2,19,3,1,7,101,110,118,55,50,52,48,18,158,94,10,64, 118,111,105,100,8,47,27,248,22,65,248,22,180,3,196,249,22,173,3,80,158, 37,34,28,248,22,51,248,22,174,3,248,22,64,197,250,22,73,2,26,248,22, 73,248,22,64,199,248,22,88,198,27,248,22,174,3,248,22,64,197,250,22,73, diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index 6d3dee93d5..832e3e7c4d 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "3.99.0.16" +#define MZSCHEME_VERSION "3.99.0.17" #define MZSCHEME_VERSION_X 3 #define MZSCHEME_VERSION_Y 99 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 16 +#define MZSCHEME_VERSION_W 17 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index c305ca339f..93d2f46019 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -4664,7 +4664,8 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, if (mrn) { if (mrn->kind == mzMOD_RENAME_MARKED) { /* Not useful if there's no marked names. */ - redundant = !mrn->marked_names || !mrn->marked_names->count; + redundant = (mrn->sealed + && (!mrn->marked_names || !mrn->marked_names->count)); if (!redundant) { /* Otherwise, watch out for multiple instances of the same rename: */ WRAP_POS l;