1 (eval-when (:compile-toplevel :load-toplevel :execute)
2 (load "assertoid.lisp")
3 (use-package "ASSERTOID"))
5 ;;; bug 254: compiler falure
6 (defpackage :bug254 (:use :cl))
8 (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
10 (uhw2 nil :type (or package null)))
11 (macrolet ((defprojection (variant &key lexpr eexpr)
13 `(defmethod uu ((foo foo))
14 (let ((uhw2 (foo.uhw2 bar)))
17 (baz (funcall ,lexpr south east 1)))))))))
19 :lexpr (lambda (south east sched)
20 (flet ((bd (x) (bref x sched)))
21 (let ((avecname (gafp)))
22 (declare (type (vector t) avecname))
25 (setf (avec.count avecname) (length rest))
26 (setf (aref avecname 0) (bd (h south)))
27 (setf (aref avecname 1) (bd (h east)))
30 :eexpr (lambda (south east))))
31 (delete-package :bug254)
34 (defpackage :bug255 (:use :cl))
36 (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1)))
41 (defstruct yam (v nil :type (or v null)))
43 (defstruct (bod (:include un)) bo)
44 (defstruct (bad (:include bod)) ba)
45 (declaim (ftype (function ((or w bad) (or w bad)) (values)) %ufm))
46 (defun %ufm (base bound) (froj base bound *1*) (values))
47 (declaim (ftype (function ((vector t)) (or w bad)) %pu))
52 (flet ((project (x) (frob x 0)))
55 (progn (%pu avecname))
57 (delete-package :bug255)
60 (defpackage :bug148 (:use :cl))
65 (defstruct foo bar bletch)
67 (labels ((kidify1 (kid)
75 (declare (inline kid-frob))
78 (the simple-vector (foo-bar perd)))))
80 (declaim (optimize (safety 3) (speed 2) (space 1)))
83 (defun u-b-sra (x r ad0 &optional ad1 &rest ad-list)
87 (vector-push-extend c0 *bar*))))
90 (map nil #'ad.frob (the (vector t) *bar*))
93 (declare (inline c.frob ad.frob)) ; 'til DYNAMIC-EXTENT
97 (declare (special *foo* *bar*))
98 (declare (optimize (safety 3) (speed 2) (space 1)))
102 (mapc #'ad.frob *bar*)
105 (declare (inline c.frob ad.frob))
108 (defun bug148-4 (ad0)
109 (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
114 collect (c.frob b))))
115 (declare (inline c.frob ad.frob))
117 (funcall (if (listp ad0) #'ad.frob #'print) ad0)
118 (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
120 (assert (equal (eval '(bug148-4 '(1 2 3)))
121 '((1 2 3) (7 14 21) (21 14 7))))
123 (delete-package :bug148)
126 (defpackage :bug258 (:use :cl))
130 (declare (special *foo* *bar*))
131 (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
135 (mapcar #'c.frob ad)))
136 (declare (inline c.frob ad.frob))
138 (funcall (if (listp ad0) #'ad.frob #'print) ad0)
139 (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
141 (assert (equal (u-b-sra '(4 9 7))
142 '((4 9 7) (3 8 6) (6 8 3))))
144 (delete-package :bug258)
146 (in-package :cl-user)
150 (declare (optimize (speed 2) (safety 3)))
156 (funcall (eval ''list) y (+ y 2d0) (* y 3d0)))))
157 (assert (raises-error? (bug233a 4) type-error))
161 (declare (type (double-float -0d0) x))
162 (declare (optimize speed))
163 (+ x (sqrt (log (random 1d0)))))
165 ;;; compiler failures reported by Paul Dietz: inaccurate dealing with
166 ;;; BLOCK-LAST in CONSTANT-FOLD-CALL and DO-NODES
167 (defun #:foo (a b c d)
168 (declare (type (integer -1 1000655) b)
169 (optimize (speed 3) (safety 1) (debug 1)))
171 (abs (- (+ b (logandc1 -473949 (max 5165 (abs (logandc1 a 250775)))))))
172 (logcount (logeqv (max (logxor (abs c) -1) 0) -4)))
176 (declare (type (integer -8507 26755) a)
177 (type (integer -393314538 2084485) d)
178 (optimize (speed 3) (safety 1) (debug 1)))
180 (if (= 0 a) 10 (abs -1))
183 (max (logand a 31365125) d)))))
186 (sb-ext:quit :unix-status 104)