+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (load "assertoid.lisp")
+ (use-package "ASSERTOID"))
+
;;; bug 254: compiler falure
(defpackage :bug254 (:use :cl))
(in-package :bug254)
(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)
+
+(in-package :cl-user)
+
+;;;
+(defun bug233a (x)
+ (declare (optimize (speed 2) (safety 3)))
+ (let ((y 0d0))
+ (values
+ (the double-float x)
+ (setq y (+ x 1d0))
+ (setq x 3d0)
+ (funcall (eval ''list) y (+ y 2d0) (* y 3d0)))))
+(assert (raises-error? (bug233a 4) type-error))
+
+;;; compiler failure
+(defun bug145b (x)
+ (declare (type (double-float -0d0) x))
+ (declare (optimize speed))
+ (+ x (sqrt (log (random 1d0)))))
+
+;;; compiler failures reported by Paul Dietz: inaccurate dealing with
+;;; BLOCK-LAST in CONSTANT-FOLD-CALL and DO-NODES
+(defun #:foo (a b c d)
+ (declare (type (integer -1 1000655) b)
+ (optimize (speed 3) (safety 1) (debug 1)))
+ (- (logior
+ (abs (- (+ b (logandc1 -473949 (max 5165 (abs (logandc1 a 250775)))))))
+ (logcount (logeqv (max (logxor (abs c) -1) 0) -4)))
+ d))
+
+(defun #:foo (a d)
+ (declare (type (integer -8507 26755) a)
+ (type (integer -393314538 2084485) d)
+ (optimize (speed 3) (safety 1) (debug 1)))
+ (gcd
+ (if (= 0 a) 10 (abs -1))
+ (logxor -1
+ (min -7580
+ (max (logand a 31365125) d)))))
+
\f
(sb-ext:quit :unix-status 104)