X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=a9f9fe86c21a7ee78816c2e64a3dc73d6852b9dd;hb=5cd15f4133804a16c5d367556da160144e741852;hp=e704d5e29edd7fd1712df9596df5ff07896d5e54;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index e704d5e..a9f9fe8 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -69,7 +69,7 @@
 (!defstruct-with-alternate-metaclass condition
   :slot-names (actual-initargs assigned-slots)
   :boa-constructor %make-condition-object
-  :superclass-name instance
+  :superclass-name t
   :metaclass-name condition-classoid
   :metaclass-constructor make-condition-classoid
   :dd-type structure)
@@ -873,6 +873,15 @@
                      (duplicate-definition-name c))))
   (:default-initargs :references (list '(:ansi-cl :section (3 2 2 3)))))
 
+(define-condition constant-modified (reference-condition warning)
+  ((fun-name :initarg :fun-name :reader constant-modified-fun-name))
+  (:report (lambda (c s)
+             (format s "~@<Destructive function ~S called on ~
+                        constant data.~@:>"
+                     (constant-modified-fun-name c))))
+  (:default-initargs :references (list '(:ansi-cl :special-operator quote)
+                                       '(:ansi-cl :section (3 2 2 3)))))
+
 (define-condition package-at-variance (reference-condition simple-warning)
   ()
   (:default-initargs :references (list '(:ansi-cl :macro defpackage))))