From 3c215723c3a0d765415f20d3b67c3026086b372e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 28 Oct 2006 23:55:54 +0000
Subject: [PATCH] more tests for 'disappeared-binding info for letrecs
 generated by internal definitions

svn: r4694
---
 collects/tests/mzscheme/stx.ss | 36 ++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 13 deletions(-)

diff --git a/collects/tests/mzscheme/stx.ss b/collects/tests/mzscheme/stx.ss
index 30e952d7a4..196ee4e5ae 100644
--- a/collects/tests/mzscheme/stx.ss
+++ b/collects/tests/mzscheme/stx.ss
@@ -652,23 +652,33 @@
 	   (syntax-case e ()
 	     [(lv (bind ...) beg)
 	      (let ([db (syntax-property #'beg 'disappeared-binding)])
-		(syntax-case #'beg ()
-		  [(bg e)
-		   (let ([o (syntax-property #'e 'origin)])
-		     (test #t (lambda (db o)
-				(and (list? db)
-				     (list? o)
-				     (= 1 (length db))
-				     (= 1 (length o))
-				     (identifier? (car db))
-				     (identifier? (car o))
-				     (bound-identifier=? (car db) (car o))))
-			   db o))]))])))])
+                (printf "~s\n" (syntax-object->datum #'beg))
+                (let-values ([(bg e)
+                              (syntax-case #'beg (#%app #%top list)
+                                [(bg (#%app (#%top . list) e))
+                                 (values #'bg #'e)]
+                                [(bg e)
+                                 (values #'bg #'e)])])
+                  (let ([o (syntax-property e 'origin)])
+                    (test #t (lambda (db o)
+                               (and (list? db)
+                                    (list? o)
+                                    (<= 1 (length db) 2)
+                                    (= 1 (length o))
+                                    (andmap identifier? db)
+                                    (identifier? (car o))
+                                    (ormap (lambda (db) (bound-identifier=? db (car o))) db)))
+                          db o))))])))])
   (check-expr #'(let () (letrec-syntaxes+values ([(x) (lambda (stx) #'(quote y))]) () x)))
+  (check-expr #'(let () (letrec-syntaxes+values ([(x) (lambda (stx) #'(quote y))]) () (list x))))
   (check-expr #'(let-values () (define-syntax (x stx) #'(quote y)) x))
+  (check-expr #'(let-values () (define-syntax (x stx) #'(quote y)) (list x)))
   (check-expr #'(let-values ([(y) 2]) (define-syntax (x stx) #'(quote y)) x))
+  (check-expr #'(let-values ([(y) 2]) (define-syntax (x stx) #'(quote y)) (list x)))
   (check-expr #'(let () (define-syntax (x stx) #'(quote y)) x))
-  (check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) x)))
+  (check-expr #'(let () (define-syntax (x stx) #'(quote y)) (list x)))
+  (check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) x))
+  (check-expr #'(let ([z 45]) (define-syntax (x stx) #'(quote y)) (list x))))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; protected identifiers