1 ;;;; various compiler tests without side effects
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (cl:in-package
:cl-user
)
16 ;;; Exercise a compiler bug (by crashing the compiler).
18 ;;; This test code is from Douglas Crosher's simplified TICKLE-BUG
19 ;;; (2000-09-06 on cmucl-imp).
21 ;;; The bug was fixed by Douglas Crosher's patch, massaged for SBCL by
22 ;;; Martin Atzmueller (2000-09-13 on sbcl-devel).
42 ;;; Exercise a compiler bug (by crashing the compiler).
44 ;;; Tim Moore gave a patch for this bug in CMU CL 2000-05-24 on
45 ;;; cmucl-imp, and Martin Atzmueller applied it to SBCL.
49 (block used-by-some-y?
53 (return-from used-by-some-y? t
)))))
54 (declare (inline frob
))
60 ;;; bug 112, reported by Martin Atzmueller 2001-06-25 (originally
61 ;;; from Bruno Haible in CMU CL bugs collection), fixed by
62 ;;; Alexey Dejneka 2002-01-27
63 (assert (= 1 ; (used to give 0 under bug 112)
68 (declare (special x
)) y
)))))
69 (assert (= 1 ; (used to give 1 even under bug 112, still works after fix)
74 (declare (special x
)) y
)))))
76 ;;; another LET-related bug fixed by Alexey Dejneka at the same
78 (multiple-value-bind (fun warnings-p failure-p
)
79 ;; should complain about duplicate variable names in LET binding
85 (declare (ignore warnings-p
))
86 (assert (functionp fun
))
89 ;;; bug 169 (reported by Alexey Dejneka 2002-05-12, fixed by David
90 ;;; Lichteblau 2002-05-21)
92 (multiple-value-bind (fun warnings-p failure-p
)
94 ;; Compiling this code should cause a STYLE-WARNING
95 ;; about *X* looking like a special variable but not
99 (funcall (symbol-function 'x-getter
))
101 (assert (functionp fun
))
103 (assert (not failure-p
)))
104 (multiple-value-bind (fun warnings-p failure-p
)
106 ;; Compiling this code should not cause a warning
107 ;; (because the DECLARE turns *X* into a special
108 ;; variable as its name suggests it should be).
111 (declare (special *x
*))
112 (funcall (symbol-function 'x-getter
))
114 (assert (functionp fun
))
115 (assert (not warnings-p
))
116 (assert (not failure-p
))))
118 ;;; a bug in 0.7.4.11
119 (dolist (i '(a b
1 2 "x" "y"))
120 ;; In sbcl-0.7.4.11, the compiler tried to source-transform the
121 ;; TYPEP here but got confused and died, doing
122 ;; (ASSOC '(AND INTEGERP (SATISFIES PLUSP)))
123 ;; *BACKEND-TYPE-PREDICATES*
125 ;; and blowing up because TYPE= tried to call PLUSP on the
126 ;; characters of the MEMBER-TYPE representing STANDARD-CHAR.
127 (when (typep i
'(and integer
(satisfies oddp
)))
130 (when (typep i
'(and integer
(satisfies oddp
)))
133 ;;; bug 156 (reported by APD sbcl-devel 2002-04-12, fixed by CSR patch
134 ;;; sbcl-devel 2002-07-02): FUNCTION-LAMBDA-EXPRESSION of
135 ;;; interactively-compiled functions was broken by sleaziness and
136 ;;; confusion in the assault on 0.7.0, so this expression used to
137 ;;; signal TYPE-ERROR when it found NIL instead of a DEBUG-SOURCE.
138 (eval '(function-lambda-expression #'(lambda (x) x
)))
140 ;;; bug caught and fixed by Raymond Toy cmucl-imp 2002-07-10: &REST
141 ;;; variable is not optional.
142 (assert (null (ignore-errors (eval '(funcall (lambda (&rest
) 12))))))
144 ;;; on the PPC, we got the magic numbers in undefined_tramp wrong for
145 ;;; a while; fixed by CSR 2002-07-18
146 (multiple-value-bind (value error
)
147 (ignore-errors (some-undefined-function))
148 (assert (null value
))
149 (assert (eq (cell-error-name error
) 'some-undefined-function
)))
151 ;;; Non-symbols shouldn't be allowed as VARs in lambda lists. (Where VAR
152 ;;; is a variable name, as in section 3.4.1 of the ANSI spec.)
153 (assert (null (ignore-errors (eval '(lambda ("foo") 12)))))
154 (assert (ignore-errors (eval '(lambda (foo) 12))))
155 (assert (null (ignore-errors (eval '(lambda (&optional
12) "foo")))))
156 (assert (ignore-errors (eval '(lambda (&optional twelve
) "foo"))))
157 (assert (null (ignore-errors (eval '(lambda (&optional
(12 12)) "foo")))))
158 (assert (ignore-errors (eval '(lambda (&optional
(twelve 12)) "foo"))))
159 (assert (null (ignore-errors (eval '(lambda (&key
#\c
) "foo")))))
160 (assert (ignore-errors (eval '(lambda (&key c
) "foo"))))
161 (assert (null (ignore-errors (eval '(lambda (&key
(#\c
#\c
)) "foo")))))
162 (assert (ignore-errors (eval '(lambda (&key
(c #\c
)) "foo"))))
163 (assert (null (ignore-errors (eval '(lambda (&key
((#\c
#\c
) #\c
)) "foo")))))
164 (assert (ignore-errors (eval '(lambda (&key
((:c cbyanyothername
) #\c
)) "foo"))))
166 ;;; As reported and fixed by Antonio Martinez-Shotton sbcl-devel
167 ;;; 2002-09-12, this failed in sbcl-0.7.7.23. (with failed AVER
168 ;;; "(LEAF-HAS-SOURCE-NAME-P LEAF)")
169 (assert (= (funcall (eval `(lambda (x) (funcall ,(lambda (y) (+ y
3)) x
))) 14)
172 ;;; bug 181: bad type specifier dropped compiler into debugger
173 (assert (list (compile nil
'(lambda (x)
174 (declare (type (0) x
))
177 (let ((f (compile nil
'(lambda (x)
178 (make-array 1 :element-type
'(0))))))
179 (assert (null (ignore-errors (funcall f
)))))
181 ;;; the following functions must not be flushable
182 (dolist (form '((make-sequence 'fixnum
10)
183 (concatenate 'fixnum nil
)
184 (map 'fixnum
#'identity nil
)
185 (merge 'fixnum nil nil
#'<)))
186 (assert (not (eval `(locally (declare (optimize (safety 0)))
187 (ignore-errors (progn ,form t
)))))))
189 (dolist (form '((values-list (car (list '(1 .
2))))
191 (atan #c
(1 1) (car (list #c
(2 2))))
192 (nthcdr (car (list (floor (cos 3)))) '(1 2 3 4 5))
193 (nthcdr (car (list 5)) '(1 2 .
3))))
194 (assert (not (eval `(locally (declare (optimize (safety 3)))
195 (ignore-errors (progn ,form t
)))))))
197 ;;; a bug in the MAP deftransform caused non-VECTOR array specifiers
198 ;;; to cause errors in the compiler. Fixed by CSR in 0.7.8.10
199 (assert (list (compile nil
'(lambda (x) (map 'simple-array
'identity x
)))))
201 ;;; bug 129: insufficient syntax checking in MACROLET
202 (multiple-value-bind (result error
)
203 (ignore-errors (eval '(macrolet ((foo x
`',x
)) (foo 1 2 3))))
204 (assert (null result
))
205 (assert (typep error
'error
)))
207 ;;; bug 124: environment of MACROLET-introduced macro expanders
209 (macrolet ((mext (x) `(cons :mext
,x
)))
210 (macrolet ((mint (y) `'(:mint
,(mext y
))))
213 '((:MEXT
1 2) (:MINT
(:MEXT
1 2)))))
215 ;;; bug 48c: SYMBOL-MACROLET should signal PROGRAM-ERROR if introduced
216 ;;; symbol is declared to be SPECIAL
217 (multiple-value-bind (result error
)
218 (ignore-errors (funcall (lambda ()
219 (symbol-macrolet ((s '(1 2)))
220 (declare (special s
))
222 (assert (null result
))
223 (assert (typep error
'program-error
)))
225 ;;; ECASE should treat a bare T as a literal key
226 (multiple-value-bind (result error
)
227 (ignore-errors (ecase 1 (t 0)))
228 (assert (null result
))
229 (assert (typep error
'type-error
)))
231 (multiple-value-bind (result error
)
232 (ignore-errors (ecase 1 (t 0) (1 2)))
233 (assert (eql result
2))
234 (assert (null error
)))
236 ;;; FTYPE should accept any functional type specifier
237 (compile nil
'(lambda (x) (declare (ftype function f
)) (f x
)))
239 ;;; FUNCALL of special operators and macros should signal an
240 ;;; UNDEFINED-FUNCTION error
241 (multiple-value-bind (result error
)
242 (ignore-errors (funcall 'quote
1))
243 (assert (null result
))
244 (assert (typep error
'undefined-function
))
245 (assert (eq (cell-error-name error
) 'quote
)))
246 (multiple-value-bind (result error
)
247 (ignore-errors (funcall 'and
1))
248 (assert (null result
))
249 (assert (typep error
'undefined-function
))
250 (assert (eq (cell-error-name error
) 'and
)))
252 ;;; PSETQ should behave when given complex symbol-macro arguments
253 (multiple-value-bind (sequence index
)
254 (symbol-macrolet ((x (aref a
(incf i
)))
255 (y (aref a
(incf i
))))
256 (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9)))
258 (psetq x
(aref a
(incf i
))
261 (assert (equalp sequence
#(0 2 2 4 4 5 6 7 8 9)))
262 (assert (= index
4)))
264 (multiple-value-bind (result error
)
266 (let ((x (list 1 2)))
269 (assert (null result
))
270 (assert (typep error
'program-error
)))
272 ;;; COPY-SEQ should work on known-complex vectors:
274 (let ((v (make-array 0 :fill-pointer
0)))
275 (vector-push-extend 1 v
)
278 ;;; to support INLINE functions inside MACROLET, it is necessary for
279 ;;; FUNCTION-LAMBDA-EXPRESSION to return a proper lambda expression in
280 ;;; certain circumstances, one of which is when compile is called from
283 (function-lambda-expression
284 (compile nil
'(lambda (x) (block nil
(print x
)))))
285 '(lambda (x) (block nil
(print x
)))))
287 ;;; bug 62: too cautious type inference in a loop
292 (declare (optimize speed
(safety 0)))
294 (array (loop (print (car a
)))))))))
296 ;;; Bug reported by Robert E. Brown sbcl-devel 2003-02-02: compiler
299 '(lambda (key tree collect-path-p
)
300 (let ((lessp (key-lessp tree
))
301 (equalp (key-equalp tree
)))
302 (declare (type (function (t t
) boolean
) lessp equalp
))
304 (loop for node
= (root-node tree
)
305 then
(if (funcall lessp key
(node-key node
))
309 do
(return (values nil nil nil
))
310 do
(when collect-path-p
312 (when (funcall equalp key
(node-key node
))
313 (return (values node path t
))))))))
315 ;;; CONSTANTLY should return a side-effect-free function (bug caught
316 ;;; by Paul Dietz' test suite)
318 (let ((fn (constantly (progn (incf i
) 1))))
320 (assert (= (funcall fn
) 1))
322 (assert (= (funcall fn
) 1))
325 ;;; Bug 240 reported by tonyms on #lisp IRC 2003-02-25 (modified version)
326 (loop for
(fun warns-p
) in
327 '(((lambda (&optional
*x
*) *x
*) t
)
328 ((lambda (&optional
*x
* &rest y
) (values *x
* y
)) t
)
329 ((lambda (&optional
*print-length
*) (values *print-length
*)) nil
)
330 ((lambda (&optional
*print-length
* &rest y
) (values *print-length
* y
)) nil
)
331 ((lambda (&optional
*x
*) (declare (special *x
*)) (values *x
*)) nil
)
332 ((lambda (&optional
*x
* &rest y
) (declare (special *x
*)) (values *x
* y
)) nil
))
333 for real-warns-p
= (nth-value 1 (compile nil fun
))
334 do
(assert (eq warns-p real-warns-p
)))
336 ;;; Bug reported by Gilbert Baumann on #lisp IRC 2003-03-26
337 (assert (equal (funcall (eval '(lambda (x &optional
(y (pop x
))) (list x y
)))
341 ;;; Bug reported by Paul Dietz on cmucl-imp and fixed by Gerd
342 ;;; Moellmann: CONVERT-MORE-CALL failed on the following call
343 (assert (eq (eval '((lambda (&key
) 'u
) :allow-other-keys nil
)) 'u
))
345 (raises-error?
(multiple-value-bind (a b c
)
346 (eval '(truncate 3 4))
347 (declare (integer c
))
351 (assert (equal (multiple-value-list (the (values &rest integer
)
355 ;;; Bug relating to confused representation for the wild function
357 (assert (null (funcall (eval '(lambda () (multiple-value-list (values)))))))
359 ;;; &ENVIRONMENT parameter should be bound first (from Paul Dietz'
361 (assert (eql (macrolet ((foo () 1))
362 (macrolet ((%f
(&optional
(x (macroexpand '(foo) env
)) &environment env
)
367 ;;; MACROLET should check for duplicated names
368 (dolist (ll '((x (z x
))
369 (x y
&optional z x w
)
373 (x &optional
(y nil x
))
374 (x &optional
(y nil y
))
377 (&key
(y nil z
) (z nil w
))
378 (&whole x
&optional x
)
379 (&environment x
&whole x
)))
384 (macrolet ((foo ,ll nil
)
385 (bar (&environment env
)
386 `',(macro-function 'foo env
)))
389 (values nil t t
))))))
391 (assert (typep (eval `(the arithmetic-error
392 ',(make-condition 'arithmetic-error
)))
395 (assert (not (nth-value
396 2 (compile nil
'(lambda ()
397 (make-array nil
:initial-element
11))))))
399 (assert (raises-error?
(funcall (eval #'open
) "assertoid.lisp"
400 :external-format
'#:nonsense
)))
401 (assert (raises-error?
(funcall (eval #'load
) "assertoid.lisp"
402 :external-format
'#:nonsense
)))
404 (assert (= (the (values integer symbol
) (values 1 'foo
13)) 1))
406 (let ((f (compile nil
408 (declare (optimize (safety 3)))
409 (list (the fixnum
(the (real 0) (eval v
))))))))
410 (assert (raises-error?
(funcall f
0.1) type-error
))
411 (assert (raises-error?
(funcall f -
1) type-error
)))
413 ;;; the implicit block does not enclose lambda list
414 (let ((forms '((defmacro #1=#:foo
(&optional
(x (return-from #1#))))
415 #+nil
(macrolet ((#2=#:foo
(&optional
(x (return-from #2#))))))
416 (define-compiler-macro #3=#:foo
(&optional
(x (return-from #3#))))
417 (deftype #4=#:foo
(&optional
(x (return-from #4#))))
418 (define-setf-expander #5=#:foo
(&optional
(x (return-from #5#))))
419 (defsetf #6=#:foo
(&optional
(x (return-from #6#))) ()))))
421 (assert (nth-value 2 (compile nil
`(lambda () ,form
))))))
423 (assert (nth-value 2 (compile nil
425 (svref (make-array '(8 9) :adjustable t
) 1)))))
427 ;;; CHAR= did not check types of its arguments (reported by Adam Warner)
428 (raises-error?
(funcall (compile nil
'(lambda (x y z
) (char= x y z
)))
431 (raises-error?
(funcall (compile nil
433 (declare (optimize (speed 3) (safety 3)))
438 ;;; Compiler lost return type of MAPCAR and friends
439 (dolist (fun '(mapcar mapc maplist mapl
))
440 (assert (nth-value 2 (compile nil
442 (1+ (,fun
#'print x
)))))))
444 (assert (nth-value 2 (compile nil
446 (declare (notinline mapcar
))
447 (1+ (mapcar #'print
'(1 2 3)))))))
449 ;;; bug found by Paul Dietz: (SETF AREF) for bit vectors with constant
450 ;;; index was effectless
451 (let ((f (compile nil
'(lambda (a v
)
452 (declare (type simple-bit-vector a
) (type bit v
))
453 (declare (optimize (speed 3) (safety 0)))
456 (let ((y (make-array 2 :element-type
'bit
:initial-element
0)))
457 (assert (equal y
#*00))
459 (assert (equal y
#*10))))
461 (handler-bind ((sb-ext:compiler-note
#'error
))
462 (compile nil
'(lambda (x)
463 (declare (type (simple-array (simple-string 3) (5)) x
))
464 (aref (aref x
0) 0))))
467 (let ((f (compile nil
'(lambda (x) (typep x
'(not (member 0d0
)))))))
468 (assert (funcall f
1d0
)))
470 (compile nil
'(lambda (x)
471 (declare (double-float x
))
475 ;;; bogus optimization of BIT-NOT
476 (multiple-value-bind (result x
)
477 (eval '(let ((x (eval #*1001)))
478 (declare (optimize (speed 2) (space 3))
479 (type (bit-vector) x
))
480 (values (bit-not x nil
) x
)))
481 (assert (equal x
#*1001))
482 (assert (equal result
#*0110)))
484 ;;; the VECTOR type in CONCATENATE/MERGE/MAKE-SEQUENCE means (VECTOR T).
485 (handler-bind ((sb-ext:compiler-note
#'error
))
486 (assert (equalp (funcall
490 (let ((x (make-sequence 'vector
10 :initial-element
'a
)))
493 #(a a a a b a a a a a
))))
495 ;;; this is not a check for a bug, but rather a test of compiler
497 (dolist (type '((integer 0 *) ; upper bound
500 (real * (-10)) ; lower bound
505 (declare (optimize (speed 3) (compilation-speed 0)))
506 (loop for i from
1 to
(the (integer -
17 10) n
) by
2
507 collect
(when (> (random 10) 5)
508 (the ,type
(- i
11)))))))))
512 ;;; We suppose that INTEGER arithmetic cannot be efficient, and the
513 ;;; compiler has an optimized VOP for +; so this code should cause an
515 (assert (eq (block nil
517 (compile nil
'(lambda (i)
518 (declare (optimize speed
))
519 (declare (type integer i
))
521 (sb-ext:compiler-note
(c) (return :good
))))
524 ;;; bug 277: IGNORE/IGNORABLE declarations should be acceptable for
526 (assert (not (nth-value 1 (compile nil
'(lambda (u v
)
527 (symbol-macrolet ((x u
)
533 ;;; bug reported by Paul Dietz: wrong optimizer for (EXPT ... 0)
534 (loop for
(x type
) in
537 (-14/3 (rational -
8 11))
546 (#c
(-3 4) (complex fixnum
))
547 (#c
(-3 4) (complex rational
))
548 (#c
(-3/7 4) (complex rational
))
549 (#c
(2s0 3s0
) (complex short-float
))
550 (#c
(2f0 3f0
) (complex single-float
))
551 (#c
(2d0 3d0
) (complex double-float
))
552 (#c
(2l0 3l0) (complex long-float
))
553 (#c
(2d0 3s0
) (complex float
))
554 (#c
(2 3f0
) (complex real
))
555 (#c
(2 3d0
) (complex real
))
556 (#c
(-3/7 4) (complex real
))
559 do
(dolist (zero '(0 0s0
0f0
0d0
0l0))
560 (dolist (real-zero (list zero
(- zero
)))
561 (let* ((src `(lambda (x) (expt (the ,type x
) ,real-zero
)))
562 (fun (compile nil src
))
563 (result (1+ (funcall (eval #'*) x real-zero
))))
564 (assert (eql result
(funcall fun x
)))))))
566 ;;; (SIGNED-BYTE 1) [ returned from the logxor derive-type optimizer ]
567 ;;; wasn't recognized as a good type specifier.
568 (let ((fun (lambda (x y
)
569 (declare (type (integer -
1 0) x y
) (optimize speed
))
571 (assert (= (funcall fun
0 0) 0))
572 (assert (= (funcall fun
0 -
1) -
1))
573 (assert (= (funcall fun -
1 -
1) 0)))
575 ;;; from PFD's torture test, triggering a bug in our effective address
580 (declare (type (integer 8 22337) b
))
583 (* (logandc1 (max -
29303 b
) 4) b
)
584 (abs (logorc1 (+ (logandc1 -
11 b
) 2607688420) -
31153924)))
585 (logeqv (max a
0) b
))))
587 ;;; Alpha floating point modes weren't being reset after an exception,
588 ;;; leading to an exception on the second compile, below.
589 (compile nil
'(lambda (x y
) (declare (type (double-float 0.0d0
) x y
)) (/ x y
)))
590 (handler-case (/ 1.0 0.0)
591 ;; provoke an exception
592 (arithmetic-error ()))
593 (compile nil
'(lambda (x y
) (declare (type (double-float 0.0d0
) x y
)) (/ x y
)))
595 ;;; bug reported by Paul Dietz: component last block does not have
599 (declare (notinline + logand
)
600 (optimize (speed 0)))
604 (RETURN-FROM B5 -
220)))
606 (+ 359749 35728422))))
609 ;;; bug 294 reported by Paul Dietz: miscompilation of REM and MOD
610 (assert (= (funcall (compile nil
`(lambda (b)
611 (declare (optimize (speed 3))
612 (type (integer 2 152044363) b
))
613 (rem b
(min -
16 0))))
617 (assert (= (funcall (compile nil
`(lambda (c)
618 (declare (optimize (speed 3))
619 (type (integer 23062188 149459656) c
))
624 ;;; bug reported by Paul Dietz: block splitting inside FLUSH-DEAD-CODE
628 (LOGEQV (REM C -
6758)
629 (REM B
(MAX 44 (RETURN-FROM B6 A
)))))))
631 (compile nil
'(lambda ()
633 (flet ((foo (x y
) (if (> x y
) (print x
) (print y
))))
636 (foo (return 14) 2)))))
638 ;;; bug in Alpha backend: not enough sanity checking of arguments to
640 (assert (= (funcall (compile nil
647 ;;; bug found by WHN and pfdietz: compiler failure while referencing
648 ;;; an entry point inside a deleted lambda
649 (compile nil
'(lambda ()
654 (flet ((truly (fn bbd
)
658 (multiple-value-prog1
675 (wum #'bbfn
"hc3" (list)))
677 (compile nil
'(lambda () (flet ((%f
() (unwind-protect nil
))) nil
)))
679 ;;; the strength reduction of constant multiplication used (before
680 ;;; sbcl-0.8.4.x) to lie to the compiler. This meant that, under
681 ;;; certain circumstances, the compiler would derive that a perfectly
682 ;;; reasonable multiplication never returned, causing chaos. Fixed by
683 ;;; explicitly doing modular arithmetic, and relying on the backends
688 (declare (type (integer 178956970 178956970) x
)
694 ;;; bug in modular arithmetic and type specifiers
695 (assert (= (funcall (compile nil
(lambda (x) (logand x x
0)))
699 ;;; MISC.99 from Paul Dietz' random tester: FAST-ASH-MOD32-C VOP
700 ;;; produced wrong result for shift >=32 on X86
701 (assert (= 0 (funcall
704 (declare (type (integer 4303063 101130078) a
))
705 (mask-field (byte 18 2) (ash a
77))))
708 ;;; MISC.101 and MISC.103: FLUSH-DEST did not mark the USE's block for
709 ;;; type check regeneration
710 (assert (eql (funcall
711 (compile nil
'(lambda (a c
)
712 (declare (type (integer 185501219873 303014665162) a
))
713 (declare (type (integer -
160758 255724) c
))
714 (declare (optimize (speed 3)))
716 (- -
554046873252388011622614991634432
718 (unwind-protect 2791485))))
719 (max (ignore-errors a
)
720 (let ((v6 (- v8
(restart-case 980))))
724 (assert (eql (funcall
725 (compile nil
'(lambda (a b
)
733 (load-time-value -
6876935))))
734 (if (logbitp 1 a
) b
(setq a -
1522022182249))))))))
735 -
1802767029877 -
12374959963)
738 ;;; various MISC.*, related to NODEs/LVARs with derived type NIL
739 (assert (eql (funcall (compile nil
'(lambda (c)
740 (declare (type (integer -
3924 1001809828) c
))
741 (declare (optimize (speed 3)))
742 (min 47 (if (ldb-test (byte 2 14) c
)
744 (ignore-errors -
732893970)))))
747 (assert (eql (funcall
748 (compile nil
'(lambda (b)
749 (declare (type (integer -
1598566306 2941) b
))
750 (declare (optimize (speed 3)))
751 (max -
148949 (ignore-errors b
))))
754 (assert (eql (funcall
755 (compile nil
'(lambda (b c
)
756 (declare (type (integer -
4 -
3) c
))
758 (flet ((%f1
(f1-1 f1-2 f1-3
)
759 (if (logbitp 0 (return-from b7
760 (- -
815145138 f1-2
)))
761 (return-from b7 -
2611670)
763 (let ((v2 (%f1 -
2464 (%f1 -
1146 c c
) -
2)))
767 (assert (eql (funcall
770 (declare (type (integer -
29742055786 23602182204) b
))
771 (declare (type (integer -
7409 -
2075) c
))
772 (declare (optimize (speed 3)))
776 (ignore-errors (return-from b6
777 (if (= c
8) b
82674))))))
781 (assert (equal (multiple-value-list
783 (compile nil
'(lambda (a)
784 (declare (type (integer -
944 -
472) a
))
785 (declare (optimize (speed 3)))
789 (if (= 55957 a
) -
117 (ignore-errors
790 (return-from b3 a
))))))))
795 (assert (zerop (funcall
798 (declare (type (integer 79828 2625480458) a
))
799 (declare (type (integer -
4363283 8171697) b
))
800 (declare (type (integer -
301 0) c
))
801 (if (equal 6392154 (logxor a b
))
805 (logior (logandc2 c v5
)
806 (common-lisp:handler-case
807 (ash a
(min 36 22477)))))))))
810 ;;; MISC.152, 153: deleted code and iteration var type inference
811 (assert (eql (funcall
815 (let ((v1 (let ((v8 (unwind-protect 9365)))
819 (labels ((%f11
(f11-1) f11-1
))
823 (labels ((%f6
(f6-1 f6-2 f6-3
) v1
))
824 (dpb (unwind-protect a
)
826 (labels ((%f4
() 27322826))
827 (%f6 -
2 -
108626545 (%f4
))))))))))))
831 (assert (eql (funcall
836 ((-96879 -
1035 -
57680 -
106404 -
94516 -
125088)
837 (unwind-protect 90309179))
838 ((-20811 -
86901 -
9368 -
98520 -
71594)
839 (let ((v9 (unwind-protect 136707)))
842 (let ((v4 (return-from b3 v9
)))
843 (- (ignore-errors (return-from b3 v4
))))))))
851 (assert (eql (funcall
862 &optional
(f17-4 185155520) (f17-5 c
)
865 (%f17 -
1046 a
1115306 (%f17 b -
146330 422) -
337817)))
866 (f15-5 a
) (f15-6 -
40))
867 (return-from b3 -
16)))
868 (multiple-value-call #'%f15
(values -
519354 a
121 c -
1905))))))
873 (assert (eql (funcall
877 (declare (notinline list apply
))
878 (declare (optimize (safety 3)))
879 (declare (optimize (speed 0)))
880 (declare (optimize (debug 0)))
881 (labels ((%f12
(f12-1 f12-2
)
882 (labels ((%f2
(f2-1 f2-2
)
889 (return-from %f12 b
)))
892 (%f18
(%f18
150 -
64 f12-1
)
899 &optional
(f7-3 (%f6
)))
903 (apply #'%f12
(list 774 -
4413)))))
908 (assert (eql (funcall
912 (declare (notinline values
))
913 (declare (optimize (safety 3)))
914 (declare (optimize (speed 0)))
915 (declare (optimize (debug 0)))
918 &optional
(f11-3 c
) (f11-4 7947114)
920 (flet ((%f3
(f3-1 &optional
(f3-2 b
) (f3-3 5529))
922 (multiple-value-call #'%f3
923 (values (%f3 -
30637724 b
) c
)))))
925 (if (and nil
(%f11 a a
))
926 (if (%f11 a
421778 4030 1)
932 (%f11 c a c -
4 214720)
944 ;;; MISC.177, 182: IR2 copy propagation missed a hidden write to a
945 ;;; local lambda argument
951 (declare (type (integer 804561 7640697) a
))
952 (declare (type (integer -
1 10441401) b
))
953 (declare (type (integer -
864634669 55189745) c
))
954 (declare (ignorable a b c
))
955 (declare (optimize (speed 3)))
956 (declare (optimize (safety 1)))
957 (declare (optimize (debug 1)))
960 (labels ((%f4
() (round 200048 (max 99 c
))))
963 (labels ((%f3
(f3-1) -
162967612))
964 (%f3
(let* ((v8 (%f4
)))
965 (setq f11-1
(%f4
)))))))))
966 (%f11 -
120429363 (%f11
62362 b
)))))
967 6714367 9645616 -
637681868)
970 ;;; Bug reported by Paul F. Dietz caused by derive type loss in VALUE
972 (assert (equal (multiple-value-list
974 (compile nil
'(lambda ()
975 (declare (optimize (speed 1) (space 0) (safety 3) (debug 3) (compilation-speed 1)))
978 (flet ((%f16
() 0)) (%f16
))))))))