From da6e73291841d0b3e9741fd8e8cbd8a0d8d6f200 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 25 Mar 2007 21:54:29 +0000
Subject: [PATCH] fix stx tests for revised let-syntaxes expansion

svn: r5827
---
 collects/tests/mzscheme/stx.ss | 33 +++++++++++++++++++++++++++++----
 1 file changed, 29 insertions(+), 4 deletions(-)

diff --git a/collects/tests/mzscheme/stx.ss b/collects/tests/mzscheme/stx.ss
index 0f3ab74fa4..d55ad945e1 100644
--- a/collects/tests/mzscheme/stx.ss
+++ b/collects/tests/mzscheme/stx.ss
@@ -637,8 +637,8 @@
 ;; Disappearing syntax decls:
 (test #t has-stx-property? (expand #'(let () (define-syntax x 1) (define y 12) 10)) 'letrec-values 'x 'disappeared-binding)
 (test #t has-stx-property? (expand #'(let () (define-struct s (x)) 10)) 'letrec-values 's 'disappeared-binding)
-(test #t has-stx-property? (expand #'(let () (define-syntax x 1) 10)) 'begin 'x 'disappeared-binding)
-(test #f has-stx-property? (expand #'(fluid-let-syntax ([x 1]) 10)) 'begin 'x 'disappeared-binding)
+(test #t has-stx-property? (expand #'(let () (define-syntax x 1) 10)) 'let-values 'x 'disappeared-binding)
+(test #f has-stx-property? (expand #'(fluid-let-syntax ([x 1]) 10)) 'let-values 'x 'disappeared-binding)
 
 ;; Disappearing use:
 (test #t has-stx-property? (expand #'(let () (define-struct a (x)) (define-struct (b a) (z)) 10))
@@ -655,9 +655,9 @@
                 (printf "~s\n" (syntax-object->datum #'beg))
                 (let-values ([(bg e)
                               (syntax-case #'beg (#%app #%top list)
-                                [(bg (#%app (#%top . list) e))
+                                [(bg () (#%app (#%top . list) e))
                                  (values #'bg #'e)]
-                                [(bg e)
+                                [(bg () e)
                                  (values #'bg #'e)])])
                   (let ([o (syntax-property e 'origin)])
                     (test #t (lambda (db o)
@@ -1180,6 +1180,31 @@
 
 (require @-n)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Propagating inactive certificates through a transparent macro-expansion result:
+
+(module @!m mzscheme
+  (provide define-x)
+  
+  (define-syntax (define-x stx)
+    (syntax-case stx ()
+      [(_ x)
+       #'(define-syntax (x stx)
+           #'(begin
+               (define-y y 10)))]))
+  
+  (define-syntax define-y
+    (syntax-rules ()
+      [(_ id v)
+       (define id v)])))
+
+(module @!n mzscheme
+  (require @!m)
+  (define-x def-y)
+  (def-y))
+
+;; If we get here, then macro expansion didn't fail.
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)