0.8.14.26:

	Add references to the FORMAT subsystem
	... make FORMAT-ERROR inherit from REFERENCE-CONDITION;
	... make REFERENCE-CONDITION exist on the host, with
		more-or-less the same interface (though no printing);
	... elide printing "See also: " if we have a reference condition
		but no references.  (This change in a
		REFERENCE-CONDITION's contract is probably going to
		irritate our friends in the slime world...);
	... decorate format-related logic with :REFERENCES initargs.

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 1511705..618db15 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -822,7 +822,8 @@
 (def!method print-object :around ((o reference-condition) s)
   (call-next-method)
   (unless (or *print-escape* *print-readably*)
-    (when *print-condition-references*
+    (when (and *print-condition-references*
+               (reference-condition-references o))
       (format s "~&See also:~%")
       (pprint-logical-block (s nil :per-line-prefix "  ")
        (do* ((rs (reference-condition-references o) (cdr rs))

diff --git a/src/code/cross-condition.lisp b/src/code/cross-condition.lisp
index 1f865bc..e74fc3c 100644 (file)
--- a/src/code/cross-condition.lisp
+++ b/src/code/cross-condition.lisp
@@ -17,13 +17,20 @@
 ;;; compiler, it will only be a style-warning.
 (define-condition format-too-many-args-warning (simple-warning) ())
 
-;;; OAOOM warning: see condition.lisp -- we want a full definition in
-;;; the cross-compiler as well, in order to have nice error messages
-;;; instead of complaints of undefined-function
+;;; KLUDGE: OAOOM warning: see condition.lisp -- we want a full
+;;; definition in the cross-compiler as well, in order to have nice
+;;; error messages instead of complaints of undefined-function
 ;;; ENCAPSULATED-CONDITION.
 (define-condition encapsulated-condition (condition)
   ((condition :initarg :condition :reader encapsulated-condition)))
 
+;;; KLUDGE: another OAOOM problem, this time to allow conditions with
+;;; REFERENCE-CONDITION in their supercondition list on the host.
+;;; (This doesn't feel like the entirely right solution, it has to be
+;;; said.)  -- CSR, 2004-09-15
+(define-condition reference-condition ()
+  ((references :initarg :references :reader reference-condition-references)))
+
 (define-condition bug (simple-error)
   ()
   (:report

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index fef1acc..c365bb8 100644 (file)
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -9,7 +9,7 @@
 
 (in-package "SB!FORMAT")
 \f
-(define-condition format-error (error)
+(define-condition format-error (error reference-condition)
   ((complaint :reader format-error-complaint :initarg :complaint)
    (args :reader format-error-args :initarg :args :initform nil)
    (control-string :reader format-error-control-string
@@ -21,7 +21,8 @@
                     :initarg :second-relative :initform nil)
    (print-banner :reader format-error-print-banner :initarg :print-banner
                 :initform t))
-  (:report %print-format-error))
+  (:report %print-format-error)
+  (:default-initargs :references nil))
 
 (defun %print-format-error (condition stream)
   (format stream
@@ -106,7 +107,8 @@
                :offset (min pprint-offset justification-offset)
                :second-relative (- (max pprint-offset justification-offset)
                                    (min pprint-offset justification-offset)
-                                   1))))
+                                   1)
+               :references (list '(:ansi-cl :section (22 3 5 2))))))
     (nreverse result)))
 
 (defun parse-directive (string start)
@@ -124,7 +126,8 @@
               (error 'format-error
                      :complaint "parameters found after #\\: or #\\@ modifier"
                      :control-string string
-                     :offset posn))))
+                     :offset posn
+                      :references (list '(:ansi-cl :section (22 3)))))))
       (loop
        (let ((char (get-char)))
          (cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))
@@ -175,14 +178,16 @@
                     (error 'format-error
                            :complaint "too many colons supplied"
                            :control-string string
-                           :offset posn)
+                           :offset posn
+                            :references (list '(:ansi-cl :section (22 3))))
                     (setf colonp t)))
                ((char= char #\@)
                 (if atsignp
                     (error 'format-error
                            :complaint "too many #\\@ characters supplied"
                            :control-string string
-                           :offset posn)
+                           :offset posn
+                            :references (list '(:ansi-cl :section (22 3))))
                     (setf atsignp t)))
                (t
                 (when (and (char= (schar string (1- posn)) #\,)
@@ -1030,9 +1035,10 @@
             ;; situation.
             (error 'format-error
                    :complaint "~D illegal directive~:P found inside justification block"
-                   :args (list count)))
+                   :args (list count)
+                    :references (list '(:ansi-cl :section (22 3 5 2)))))
           (expand-format-justification segments colonp atsignp
-                                     first-semi params)))
+                                        first-semi params)))
      remaining)))
 
 (def-complex-format-directive #\> ()
@@ -1056,7 +1062,9 @@
                              "cannot include format directives inside the ~
                               ~:[suffix~;prefix~] segment of ~~<...~~:>"
                              :args (list prefix-p)
-                             :offset (1- (format-directive-end directive)))
+                             :offset (1- (format-directive-end directive))
+                              :references
+                              (list '(:ansi-cl :section (22 3 5 2))))
                       (apply #'concatenate 'string list)))))
        (case (length segments)
          (0 (values prefix-default nil suffix-default))

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index f03d70f..3860132 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -1067,7 +1067,8 @@
                  ;; situation.
                  (error 'format-error
                         :complaint "~D illegal directive~:P found inside justification block"
-                        :args (list count)))
+                        :args (list count)
+                         :references (list '(:ansi-cl :section (22 3 5 2)))))
                (interpret-format-justification stream orig-args args
                                                segments colonp atsignp
                                                first-semi params))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 0105321..0168b3e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.14.25"
+"0.8.14.26"