0.8.2.7:

[sbcl.git] / tests / compiler.impure-cload.lisp

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 2e8011f..d5e660e 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -52,5 +52,92 @@
                 (frob)))))))
 (delete-package :bug255)
 
+;;; bug 148
+(defpackage :bug148 (:use :cl))
+(in-package :bug148)
+
+(defvar *thing*)
+(defvar *zoom*)
+(defstruct foo bar bletch)
+(defun %zeep ()
+  (labels ((kidify1 (kid)
+             )
+           (kid-frob (kid)
+             (if *thing*
+                 (setf sweptm
+                       (m+ (frobnicate kid)
+                           sweptm))
+                 (kidify1 kid))))
+    (declare (inline kid-frob))
+    (map nil
+         #'kid-frob
+         (the simple-vector (foo-bar perd)))))
+
+(declaim (optimize (safety 3) (speed 2) (space 1)))
+(defvar *foo*)
+(defvar *bar*)
+(defun u-b-sra (x r ad0 &optional ad1 &rest ad-list)
+  (labels ((c.frob (c0)
+             (let ()
+               (when *foo*
+                 (vector-push-extend c0 *bar*))))
+           (ad.frob (ad)
+             (if *foo*
+                 (map nil #'ad.frob (the (vector t) *bar*))
+                 (dolist (b *bar*)
+                   (c.frob b)))))
+    (declare (inline c.frob ad.frob))   ; 'til DYNAMIC-EXTENT
+    (ad.frob ad0)))
+
+(defun bug148-3 (ad0)
+  (declare (special *foo* *bar*))
+  (declare (optimize (safety 3) (speed 2) (space 1)))
+  (labels ((c.frob ())
+           (ad.frob (ad)
+             (if *foo*
+                 (mapc #'ad.frob *bar*)
+                 (dolist (b *bar*)
+                   (c.frob)))))
+    (declare (inline c.frob ad.frob))
+    (ad.frob ad0)))
+
+(defun bug148-4 (ad0)
+  (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
+  (labels ((c.frob (x)
+             (* 7 x))
+           (ad.frob (ad)
+             (loop for b in ad
+                   collect (c.frob b))))
+    (declare (inline c.frob ad.frob))
+    (list (the list ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
+
+(assert (equal (eval '(bug148-4 '(1 2 3)))
+               '((1 2 3) (7 14 21) (21 14 7))))
+
+(delete-package :bug148)
+
+;;; bug 258
+(defpackage :bug258 (:use :cl))
+(in-package :bug258)
+
+(defun u-b-sra (ad0)
+  (declare (special *foo* *bar*))
+  (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
+  (labels ((c.frob (x)
+             (1- x))
+           (ad.frob (ad)
+             (mapcar #'c.frob ad)))
+    (declare (inline c.frob ad.frob))
+    (list (the list ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
+
+(assert (equal (u-b-sra '(4 9 7))
+               '((4 9 7) (3 8 6) (6 8 3))))
+
+(delete-package :bug258)
+
 \f
 (sb-ext:quit :unix-status 104)