X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=57e96361961725860ed11dd9f0d17ed3805bb0a3;hb=3a2c2a2217f77e0d1a44a581c83e0311ebc2594a;hp=33936a536dab2d4183ad55ace6828723b9166839;hpb=d4fb62259d04a4513d6ae20ca9f2487c4dfe1c1a;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 33936a5..57e9636 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -308,12 +308,17 @@
 ;;; BUG 48a. and b. (symbol-macrolet handling), fixed by Eric Marsden
 ;;; and Raymond Toy for CMUCL, fix ported for sbcl-0.7.6.18.
 (multiple-value-bind (function warnings-p failure-p)
-    (compile nil '(lambda () (symbol-macrolet ((t nil)) t)))
+    (compile nil '(lambda ()
+                   ;; not interested in the package lock violation here
+                   (declare (sb-ext:disable-package-locks t))
+                   (symbol-macrolet ((t nil)) t)))
   (assert failure-p)
   (assert (raises-error? (funcall function) program-error)))
 (multiple-value-bind (function warnings-p failure-p)
     (compile nil
 	     '(lambda ()
+               ;; not interested in the package lock violation here
+               (declare (sb-ext:disable-package-locks *standard-input*))
 		(symbol-macrolet ((*standard-input* nil))
 		  *standard-input*)))
   (assert failure-p)
@@ -893,7 +898,7 @@
 
 ;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual)
 (defvar *compiler-note-count* 0)
-#-alpha ; KLUDGE
+#-(or alpha x86-64) ; FIXME: make a better test!
 (handler-bind ((sb-ext:compiler-note (lambda (c)
 				       (declare (ignore c))
 				       (incf *compiler-note-count*))))
@@ -910,6 +915,15 @@
     (assert (= *compiler-note-count* 1))
     (assert (equal (multiple-value-list (funcall fun 1)) '(5 -5)))))
 
+(handler-case
+    (eval '(flet ((%f (&key) nil)) (%f nil nil)))
+  (error (c) :good)
+  (:no-error (val) (error "no error: ~S" val)))
+(handler-case
+    (eval '(labels ((%f (&key x) x)) (%f nil nil)))
+  (error (c) :good)
+  (:no-error (val) (error "no error: ~S" val)))
+
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
 
@@ -976,5 +990,82 @@
 	  (grovel-results name))))))
 (identify-suspect-vops)
 
+;;;; 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)