0.9.6.22:
[sbcl.git] / src / code / condition.lisp
index e704d5e..a9f9fe8 100644 (file)
@@ -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)
                      (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))))