\f
;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual)
(defvar *compiler-note-count* 0)
-#-alpha ; FIXME: make a better test!
+#-(or alpha x86-64) ; FIXME: make a better test!
(handler-bind ((sb-ext:compiler-note (lambda (c)
(declare (ignore c))
(incf *compiler-note-count*))))
(grovel-results name))))))
(identify-suspect-vops)
\f
+;;;; tests for compiler output
+(let* ((*error-output* (make-broadcast-stream))
+ (output (with-output-to-string (*standard-output*)
+ (compile-file "compiler-output-test.lisp"
+ :print nil :verbose nil))))
+ (print output)
+ (assert (zerop (length output))))
+
+;;;; bug 305: INLINE/NOTINLINE causing local ftype to be lost
+
+(define-condition optimization-error (error) ())
+
+(labels ((compile-lambda (type sense)
+ (handler-bind ((compiler-note (lambda (_)
+ (declare (ignore _))
+ (error 'optimization-error))))
+ (values
+ (compile
+ nil
+ `(lambda ()
+ (declare
+ ,@(when type '((ftype (function () (integer 0 10)) bug-305)))
+ (,sense bug-305)
+ (optimize speed))
+ (1+ (bug-305))))
+ nil)))
+ (expect-error (sense)
+ (multiple-value-bind (f e) (ignore-errors (compile-lambda nil sense))
+ (assert (not f))
+ (assert (typep e 'optimization-error))))
+ (expect-pass (sense)
+ (multiple-value-bind (f e) (ignore-errors (compile-lambda t sense))
+ (assert f)
+ (assert (not e)))))
+ (expect-error 'inline)
+ (expect-error 'notinline)
+ (expect-pass 'inline)
+ (expect-pass 'notinline))
+
+;;; bug 211e: bogus style warning from duplicated keyword argument to
+;;; a local function.
+(handler-bind ((style-warning #'error))
+ (let ((f (compile nil '(lambda ()
+ (flet ((foo (&key y) (list y)))
+ (list (foo :y 1 :y 2)))))))
+ (assert (equal '((1)) (funcall f)))))
+
+;;; check that EQL is optimized when other argument is (OR SYMBOL FIXNUM).
+(handler-bind ((compiler-note #'error))
+ (let ((f1 (compile nil '(lambda (x1 y1)
+ (declare (type (or symbol fixnum) x1)
+ (optimize speed))
+ (eql x1 y1))))
+ (f2 (compile nil '(lambda (x2 y2)
+ (declare (type (or symbol fixnum) y2)
+ (optimize speed))
+ (eql x2 y2)))))
+ (let ((fix (random most-positive-fixnum))
+ (sym (gensym))
+ (e-count 0))
+ (assert (funcall f1 fix fix))
+ (assert (funcall f2 fix fix))
+ (assert (funcall f1 sym sym))
+ (assert (funcall f2 sym sym))
+ (handler-bind ((type-error (lambda (c)
+ (incf e-count)
+ (continue c))))
+ (flet ((test (f x y)
+ (with-simple-restart (continue "continue with next test")
+ (funcall f x y)
+ (error "fell through with (~S ~S ~S)" f x y))))
+ (test f1 "oops" 42)
+ (test f1 (1+ most-positive-fixnum) 42)
+ (test f2 42 "oops")
+ (test f2 42 (1+ most-positive-fixnum))))
+ (assert (= e-count 4)))))
+
;;; success
(quit :unix-status 104)