:good
(values result1 result2))))
:good))
+;;; MISC.275
+(assert
+ (zerop
+ (funcall
+ (compile
+ nil
+ '(lambda (b)
+ (declare (notinline funcall min coerce))
+ (declare
+ (optimize (speed 1)
+ (space 2)
+ (safety 2)
+ (debug 1)
+ (compilation-speed 1)))
+ (flet ((%f12 (f12-1)
+ (coerce
+ (min
+ (if f12-1 (multiple-value-prog1
+ b (return-from %f12 0))
+ 0))
+ 'integer)))
+ (funcall #'%f12 0))))
+ -33)))
+
+;;; Discussion of a CMUCL PCL bug on Sparc with Raymond Toy revealed a
+;;; potential problem: optimizers and type derivers for MAX and MIN
+;;; were not consistent in treating EQUALP, but not EQL, arguments.
+(dolist (f '(min max))
+ (loop for complex-arg-args in '((1d0 2d0) (0d0 1d0))
+ for complex-arg = `(if x ,@complex-arg-args)
+ do
+ (loop for args in `((1 ,complex-arg)
+ (,complex-arg 1))
+ for form = `(,f ,@args)
+ for f1 = (compile nil `(lambda (x) ,form))
+ and f2 = (compile nil `(lambda (x) (declare (notinline min max))
+ ,form))
+ do
+ (dolist (x '(nil t))
+ (assert (eql (funcall f1 x) (funcall f2 x)))))))
+
+;;;
+(handler-case (compile nil '(lambda (x)
+ (declare (optimize (speed 3) (safety 0)))
+ (the double-float (sqrt (the double-float x)))))
+ (sb-ext:compiler-note ()
+ (error "Compiler does not trust result type assertion.")))
+
+(let ((f (compile nil '(lambda (x)
+ (declare (optimize speed (safety 0)))
+ (block nil
+ (the double-float
+ (multiple-value-prog1
+ (sqrt (the double-float x))
+ (when (< x 0)
+ (return :minus)))))))))
+ (assert (eql (funcall f -1d0) :minus))
+ (assert (eql (funcall f 4d0) 2d0)))
+
+;;; bug 304: SBCL produced something similar to (/ (ASH x 4) 8)
+(handler-case
+ (compile nil '(lambda (a i)
+ (locally
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)
+ (inhibit-warnings 0)))
+ (declare (type (alien (* (unsigned 8))) a)
+ (type (unsigned-byte 32) i))
+ (deref a i))))
+ (compiler-note () (error "The code is not optimized.")))
+
+(handler-case
+ (compile nil '(lambda (x)
+ (declare (type (integer -100 100) x))
+ (declare (optimize speed))
+ (declare (notinline identity))
+ (1+ (identity x))))
+ (compiler-note () (error "IDENTITY derive-type not applied.")))