Fix make-array transforms.
[sbcl.git] / tests / walk.impure.lisp
index 80b4915..2fefd8f 100644 (file)
 (defun string-modulo-tabspace (s)
   (remove-if (lambda (c)
                (or (char= c #\space)
-                   (char= c #\tab)))
+                   (char= c #\tab)
+                   (char= c #\newline)))
              s))
 (defun string=-modulo-tabspace (x y)
-  (string= (string-modulo-tabspace x)
-           (string-modulo-tabspace y)))
+  (if (string= (string-modulo-tabspace x)
+               (string-modulo-tabspace y))
+      t
+      (progn
+        (print (list :want y :got x))
+        nil)))
 \f
 ;;;; tests based on stuff at the end of the original CMU CL
 ;;;; pcl/walk.lisp file
@@ -343,7 +348,7 @@ Form: (TAGBODY)   Context: EVAL
         C)   Context: EVAL
 Form: (FOO A)   Context: EVAL
 Form: 'GLOBAL-FOO   Context: EVAL
-Form: B   Context: EVAL; lexically bound
+Form: B   Context: EVAL; lexically bound; declared special
 Form: C   Context: EVAL; lexically bound
 (LET (A B C)
   (DECLARE (SPECIAL A B))
@@ -470,7 +475,7 @@ Form: B   Context: EVAL; lexically bound
 Form: (FOO A B)   Context: EVAL
 Form: 'GLOBAL-FOO   Context: EVAL
 Form: (LIST A B)   Context: EVAL
-Form: A   Context: EVAL; lexically bound
+Form: A   Context: EVAL; lexically bound; declared special
 Form: B   Context: EVAL; lexically bound
 (MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B))"))
 
@@ -579,30 +584,34 @@ Form: A   Context: EVAL
 Form: B   Context: EVAL
 Form: (LIST A B C)   Context: EVAL
 Form: A   Context: EVAL; lexically bound; declared special
-Form: B   Context: EVAL; lexically bound
+Form: B   Context: EVAL; lexically bound; declared special
 Form: C   Context: EVAL; lexically bound
 (LET ((A A) (B A) (C B))
   (DECLARE (SPECIAL A B))
   (LIST A B C))"))
 
-(assert (string=-modulo-tabspace
+;;;; Bug in LET* walking!
+(test-util:with-test (:name (:walk-let* :hairy-specials)
+                      :fails-on :sbcl)
+  (assert
+   (string=-modulo-tabspace
          (with-output-to-string (*standard-output*)
            (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b))
                                           (declare (special a b))
                                           (list a b c))))
          "Form: (LET* ((A A) (B A) (C B))
-        (DECLARE (SPECIAL A B))
-        (LIST A B C))   Context: EVAL
-Form: A   Context: EVAL
-Form: A   Context: EVAL; lexically bound
-Form: B   Context: EVAL; lexically bound
-Form: (LIST A B C)   Context: EVAL
-Form: A   Context: EVAL; lexically bound; declared special
-Form: B   Context: EVAL; lexically bound
-Form: C   Context: EVAL; lexically bound
-(LET* ((A A) (B A) (C B))
-  (DECLARE (SPECIAL A B))
-  (LIST A B C))"))
+                  (DECLARE (SPECIAL A B))
+                  (LIST A B C))   Context: EVAL
+          Form: A   Context: EVAL
+          Form: A   Context: EVAL; lexically bound; declared special
+          Form: B   Context: EVAL; lexically bound; declared special
+          Form: (LIST A B C)   Context: EVAL
+          Form: A   Context: EVAL; lexically bound; declared special
+          Form: B   Context: EVAL; lexically bound; declared special
+          Form: C   Context: EVAL; lexically bound
+          (LET* ((A A) (B A) (C B))
+            (DECLARE (SPECIAL A B))
+            (LIST A B C))")))
 
 (assert (string=-modulo-tabspace
          (with-output-to-string (*standard-output*)
@@ -933,14 +942,13 @@ Form: A   Context: EVAL
 Form: (PROGN B)   Context: EVAL
 Form: B   Context: EVAL
 Form: (COND ((FOO BAR) A (FOO A)))   Context: EVAL
-Form: (IF (FOO BAR) (PROGN A (FOO A)) (COND))   Context: EVAL
+Form: (IF (FOO BAR) (PROGN A (FOO A)) NIL)   Context: EVAL
 Form: (FOO BAR)   Context: EVAL
 Form: 'GLOBAL-FOO   Context: EVAL
 Form: (PROGN A (FOO A))   Context: EVAL
 Form: A   Context: EVAL
 Form: (FOO A)   Context: EVAL
 Form: 'GLOBAL-FOO   Context: EVAL
-Form: (COND)   Context: EVAL
 Form: NIL   Context: EVAL; bound: NIL
 (COND (A B) ((FOO BAR) A (FOO A)))"))
 
@@ -968,5 +976,4 @@ Form: NIL   Context: EVAL; bound: NIL
 ;;; Old PCL hung up on this.
 (defmethod #:foo ()
   (defun #:bar ()))
-\f
-(quit :unix-status 104)
+\f
\ No newline at end of file