implicit generic function warning improvement

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 3562d0c..08f2f99 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -264,7 +264,8 @@
                   (condition-classoid type)
                   (class
                    ;; Punt to CLOS.
-                   (return-from make-condition (apply #'make-instance type args)))
+                   (return-from make-condition
+                     (apply #'make-instance type args)))
                   (classoid
                    (error 'simple-type-error
                           :datum type
@@ -275,7 +276,8 @@
                    (error 'simple-type-error
                           :datum type
                           :expected-type 'condition-class
-                          :format-control "Bad type argument:~%  ~S"
+                          :format-control
+                          "~s doesn't designate a condition class."
                           :format-arguments (list type)))))
          (res (make-condition-object args)))
     (setf (%instance-layout res) (classoid-layout class))
@@ -586,7 +588,8 @@
            ;; is a lambda referring to condition slot accessors:
            ;; they're not proclaimed as functions before it has run if
            ;; we're under EVAL or loaded as source.
-           (%set-condition-report ',name ,report))))))
+           (%set-condition-report ',name ,report)
+           ',name)))))
 \f
 ;;;; various CONDITIONs specified by ANSI
 
@@ -1002,8 +1005,9 @@
   ((name :initarg :name :reader implicit-generic-function-name))
   (:report
    (lambda (condition stream)
-     (format stream "~@<Implicitly creating new generic function ~S.~:@>"
-             (implicit-generic-function-name condition)))))
+     (let ((*package* (find-package :keyword)))
+       (format stream "~@<Implicitly creating new generic function ~S.~:@>"
+               (implicit-generic-function-name condition))))))
 
 (define-condition extension-failure (reference-condition simple-error)
   ())
@@ -1612,7 +1616,7 @@ the usual naming convention (names like *FOO*) for special variables"
 
 (define-condition deprecation-condition ()
   ((name :initarg :name :reader deprecated-name)
-   (replacement :initarg :replacement :reader deprecated-name-replacement)
+   (replacements :initarg :replacements :reader deprecated-name-replacements)
    (since :initarg :since :reader deprecated-since)
    (runtime-error :initarg :runtime-error :reader deprecated-name-runtime-error)))
 
@@ -1620,14 +1624,21 @@ the usual naming convention (names like *FOO*) for special variables"
   (let ((*package* (find-package :keyword)))
     (if *print-escape*
         (print-unreadable-object (condition stream :type t)
-          (format stream "~S is deprecated~@[, use ~S~]"
+          (apply #'format
+                 stream "~S is deprecated.~
+                         ~#[~; Use ~S instead.~; ~
+                               Use ~S or ~S instead.~:; ~
+                               Use~@{~#[~; or~] ~S~^,~} instead.~]"
                   (deprecated-name condition)
-                  (deprecated-name-replacement condition)))
-        (format stream "~@<~S has been deprecated as of SBCL ~A~
-                        ~@[, use ~S instead~].~:@>"
+                  (deprecated-name-replacements condition)))
+        (apply #'format
+               stream "~@<~S has been deprecated as of SBCL ~A.~
+                       ~#[~; Use ~S instead.~; ~
+                             Use ~S or ~S instead.~:; ~
+                             Use~@{~#[~; or~] ~S~^,~:_~} instead.~]~:@>"
                 (deprecated-name condition)
                 (deprecated-since condition)
-                (deprecated-name-replacement condition)))))
+                (deprecated-name-replacements condition)))))
 
 (define-condition early-deprecation-warning (style-warning deprecation-condition)
   ())