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)))))
185 ;;; compiler failure "NIL is not of type LVAR"
187 (progn (truly-the integer x)
190 ;;; bug 291 reported by Nikodemus Siivola (modified version)
193 (defun update-window-imag (line)
200 (unless (eq current the-sentinel)
201 (let* ((cc (car current))
202 (old-line (dis-line-line cc)))
203 (if (eq old-line line)
204 (do ((chars (line-%chars line) nil))
208 #'(lambda (&optional g2740 g2741 &rest g2742)
209 (declare (ignore g2742))
211 (values (setq string g2740) (setq underhang g2741))))
213 (setf (dis-line-old-chars cc) chars)))))))
215 ;;; and similar cases found by Paul Dietz
217 (declare (optimize (speed 0) (safety 3) (debug 3)))
221 (IF (LDB-TEST (BYTE 27 14) V2)
230 (declare (optimize (speed 0) (safety 3) (debug 3)))
234 (MIN A (RETURN-FROM B8 C))))))
237 ;;; bug 292, reported by Paul Dietz
239 (DECLARE (TYPE (INTEGER -5945502333 12668542) C)
240 (OPTIMIZE (SPEED 3)))
242 (- (MAX (IF (/= 109335113 V2) -26479 V2)
245 (MIN (MAX 521326 C) -51))))))
247 ;;; zombie variables, arising from constraints
249 (DECLARE (TYPE (INTEGER -40945116 24028306) B)
250 (OPTIMIZE (SPEED 3)))
251 (LET ((V5 (MIN 31883 (LOGCOUNT A))))
252 (IF (/= B V5) (IF (EQL 122911784 V5) -43765 1487) B)))
254 ;;; let-conversion of a function into deleted one
256 (declare (type (integer -883 1566) a)
257 (type (integer -1 0) c)
258 (optimize (speed 3) (safety 1) (debug 1)))
262 (return-from %f5 (if (= -4857 a) (%f8) (%f8)))
264 (if (<= 11 c) (%f5) c))))
266 ;;; two bugs: "aggressive" deletion of optional entries and problems
267 ;;; of FIND-RESULT-TYPE in dealing with deleted code; reported by
268 ;;; Nikodemus Siivola (simplified version)
269 (defun lisp-error-error-handler (condition)
270 (invoke-debugger condition)
274 (continue "return to hemlock's debug loop.")
275 (invoke-debugger condition))
283 (labels ((bar (x &optional (y (return-from u)))
284 (list x y (apply #'bar (fee)))))
285 (list (bar 1) (bar 1 2))))
290 (declare (type (integer 0 1) b) (optimize (speed 3)))
291 (flet ((%f2 () (lognor (block b5 138) c)))
292 (if (not (or (= -67399 b) b))
293 (deposit-field (%f2) (byte 11 8) -3)
297 (sb-ext:quit :unix-status 104)