X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=d76500f083396e62061167c6bf58d094e505f60f;hb=a0a413499415738d23cc40baa44e9c404af54a94;hp=5cdbc1aec5ace1518ed84b7ff2cde44513c29ff0;hpb=8b78dfb8dc6c72c73a9c1732f0869e3f02281519;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 5cdbc1a..d76500f 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -72,7 +72,9 @@
   ;; allocation of this slot, or NIL until defaulted
   (allocation nil :type (member :instance :class nil))
   ;; If ALLOCATION is :CLASS, this is a cons whose car holds the value.
-  (cell nil :type (or cons null)))
+  (cell nil :type (or cons null))
+  ;; slot documentation
+  (documentation nil :type (or string null)))
 
 ;;; KLUDGE: It's not clear to me why CONDITION-CLASS has itself listed
 ;;; in its CPL, while other classes derived from CONDITION-CLASS don't
@@ -428,6 +430,7 @@
 	       (slot-name (first spec))
 	       (allocation :instance)
 	       (initform-p nil)
+	       documentation
 	       initform)
 	  (collect ((initargs)
 		    (readers)
@@ -451,6 +454,13 @@
 		  (:initarg (initargs arg))
 		  (:allocation
 		   (setq allocation arg))
+		  (:documentation
+		   (when documentation
+		     (error "more than one :DOCUMENTATION in ~S" spec))
+		   (unless (stringp arg)
+		     (error "slot :DOCUMENTATION argument is not a string: ~S"
+			    arg))
+		   (setq documentation arg))
 		  (:type)
 		  (t
 		   (error "unknown slot option:~%  ~S" (first options))))))
@@ -463,6 +473,7 @@
 		     :readers ',(readers)
 		     :writers ',(writers)
 		     :initform-p ',initform-p
+		     :documentation ',documentation
 		     :initform
 		     ,(if (constantp initform)
 			  `',(eval initform)
@@ -661,6 +672,15 @@
 ;;;; setup of CONDITION machinery, only because that makes it easier to
 ;;;; get cold init to work.
 
+(define-condition values-type-error (type-error)
+  ()
+  (:report
+   (lambda (condition stream)
+     (format stream
+	     "~@<The values set ~2I~:_[~{~S~^ ~}] ~I~_is not of type ~2I~_~S.~:>"
+	     (type-error-datum condition)
+	     (type-error-expected-type condition)))))
+
 ;;; KLUDGE: a condition for floating point errors when we can't or
 ;;; won't figure out what type they are. (In FreeBSD and OpenBSD we
 ;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably