X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=877073cad42b1e6a264d370bf85654938204d702;hb=5919ecc5fee77630855da6aeeabdc7d8cc4f2762;hp=174e3289be1662203ddb0b263fbe2af68cd6d28f;hpb=7727c77c8b05dcbcf9f8878a26f94cc14ccd5218;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 174e328..877073c 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1344,7 +1344,7 @@
 (defclass class-with-odd-class-name-method ()
   ((a :accessor class-name)))
 
-;;; another case where precomputing (this time on PRINT-OBJET) and
+;;; another case where precomputing (this time on PRINT-OBJECT) and
 ;;; lazily-finalized classes caused problems.  (report from James Y
 ;;; Knight sbcl-devel 20-07-2006)
 
@@ -1619,5 +1619,60 @@
 (handler-bind ((warning #'error))
   (assert (= 123 (slot-value (provoke-ctor-default-initarg-problem) 'slot))))
 
+;;;; discriminating net on streams used to generate code deletion notes on
+;;;; first call
+(defgeneric stream-fd (stream direction))
+(defmethod stream-fd ((stream sb-sys:fd-stream) direction)
+  (declare (ignore direction))
+  (sb-sys:fd-stream-fd stream))
+(defmethod stream-fd ((stream synonym-stream) direction)
+  (stream-fd (symbol-value (synonym-stream-symbol stream)) direction))
+(defmethod stream-fd ((stream two-way-stream) direction)
+  (ecase direction
+    (:input
+     (stream-fd
+      (two-way-stream-input-stream stream) direction))
+    (:output
+     (stream-fd
+      (two-way-stream-output-stream stream) direction))))
+(with-test (:name (:discriminating-name :code-deletion-note))
+  (handler-bind ((compiler-note #'error))
+    (stream-fd sb-sys:*stdin* :output)
+    (stream-fd sb-sys:*stdin* :output)))
+
+(with-test (:name :bug-380)
+  (defclass bug-380 ()
+    ((slot :accessor bug380-slot)))
+  (fmakunbound 'foo-slot)
+  (defgeneric foo-slot (x y z))
+  (defclass foo ()
+    ((slot :accessor foo-slot-value))))
+
+;;; SET and (SETF SYMBOL-VALUE) used to confuse permuation vector
+;;; optimizations
+(defclass fih ()
+  ((x :initform :fih)))
+(defclass fah ()
+  ((x :initform :fah)))
+(declaim (special *fih*))
+(defmethod fihfah ((*fih* fih))
+  (set '*fih* (make-instance 'fah))
+  (list (slot-value *fih* 'x)
+        (eval '(slot-value *fih* 'x))))
+(defmethod fihfah ((fah fah))
+  (declare (special fah))
+  (set 'fah (make-instance 'fih))
+  (list (slot-value fah 'x)
+        (eval '(slot-value fah 'x))))
+(with-test (:name :set-of-a-method-specializer)
+  (assert (equal '(:fah :fah) (fihfah (make-instance 'fih))))
+  (assert (equal '(:fih :fih) (fihfah (make-instance 'fah)))))
+
+(defmethod no-implicit-declarations-for-local-specials ((faax double-float))
+  (declare (special faax))
+  (set 'faax (when (< faax 0) (- faax)))
+  faax)
+(with-test (:name :no-implicit-declarations-for-local-specials)
+  (assert (not (no-implicit-declarations-for-local-specials 1.0d0))))
 
 ;;;; success