X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=d548cffceff945be14b47ebc0dd474afce77004d;hb=30b24d582dd8620b91c798e38a8aa9a6b999b4be;hp=3fa764a64347ec8a4fa445e68c190a7e4d2bf8ef;hpb=1913e44aa31172eb3c345115a2acb367356f6b4b;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 3fa764a..d548cff 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)
 
@@ -1597,5 +1597,47 @@
 (assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'warning))))
 (assert (not (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'hash-table))))
 (assert (eq t (sb-pcl::layout-for-std-class-p (sb-pcl::find-layout 'standard-object))))
+
+;;;; bug 402: PCL used to warn about non-standard declarations
+(declaim (declaration bug-402-d))
+(defgeneric bug-402-gf (x))
+(with-test (:name :bug-402)
+  (handler-bind ((warning #'error))
+    (eval '(defmethod bug-402-gf (x)
+            (declare (bug-402-d x))
+            x))))
+
+;;;; non-keyword :default-initargs + :before method on shared initialize
+;;;; interacted badly with CTOR optimizations
+(defclass ctor-default-initarg-problem ()
+  ((slot :initarg slotto))
+  (:default-initargs slotto 123))
+(defmethod shared-initialize :before ((instance ctor-default-initarg-problem) slot-names &rest initargs)
+  (format t "~&Rock on: ~A~%" initargs))
+(defun provoke-ctor-default-initarg-problem ()
+  (make-instance 'ctor-default-initarg-problem))
+(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)))
 
 ;;;; success