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.
(def!method print-object :around ((o reference-condition) s)
(call-next-method)
(unless (or *print-escape* *print-readably*)
(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))
(format s "~&See also:~%")
(pprint-logical-block (s nil :per-line-prefix " ")
(do* ((rs (reference-condition-references o) (cdr rs))
;;; compiler, it will only be a style-warning.
(define-condition format-too-many-args-warning (simple-warning) ())
;;; 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)))
;;; 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
(define-condition bug (simple-error)
()
(:report
(in-package "SB!FORMAT")
\f
(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
((complaint :reader format-error-complaint :initarg :complaint)
(args :reader format-error-args :initarg :args :initform nil)
(control-string :reader format-error-control-string
:initarg :second-relative :initform nil)
(print-banner :reader format-error-print-banner :initarg :print-banner
:initform t))
: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
(defun %print-format-error (condition stream)
(format stream
:offset (min pprint-offset justification-offset)
:second-relative (- (max pprint-offset justification-offset)
(min pprint-offset justification-offset)
:offset (min pprint-offset justification-offset)
:second-relative (- (max pprint-offset justification-offset)
(min pprint-offset justification-offset)
+ 1)
+ :references (list '(:ansi-cl :section (22 3 5 2))))))
(nreverse result)))
(defun parse-directive (string start)
(nreverse result)))
(defun parse-directive (string start)
(error 'format-error
:complaint "parameters found after #\\: or #\\@ modifier"
:control-string string
(error 'format-error
:complaint "parameters found after #\\: or #\\@ modifier"
:control-string string
+ :offset posn
+ :references (list '(:ansi-cl :section (22 3)))))))
(loop
(let ((char (get-char)))
(cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))
(loop
(let ((char (get-char)))
(cond ((or (char<= #\0 char #\9) (char= char #\+) (char= char #\-))
(error 'format-error
:complaint "too many colons supplied"
:control-string string
(error 'format-error
:complaint "too many colons supplied"
:control-string string
+ :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
(setf colonp t)))
((char= char #\@)
(if atsignp
(error 'format-error
:complaint "too many #\\@ characters supplied"
:control-string string
+ :offset posn
+ :references (list '(:ansi-cl :section (22 3))))
(setf atsignp t)))
(t
(when (and (char= (schar string (1- posn)) #\,)
(setf atsignp t)))
(t
(when (and (char= (schar string (1- posn)) #\,)
;; situation.
(error 'format-error
:complaint "~D illegal directive~:P found inside justification block"
;; situation.
(error 'format-error
:complaint "~D illegal directive~:P found inside justification block"
+ :args (list count)
+ :references (list '(:ansi-cl :section (22 3 5 2)))))
(expand-format-justification segments colonp atsignp
(expand-format-justification segments colonp atsignp
remaining)))
(def-complex-format-directive #\> ()
remaining)))
(def-complex-format-directive #\> ()
"cannot include format directives inside the ~
~:[suffix~;prefix~] segment of ~~<...~~:>"
:args (list prefix-p)
"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))
(apply #'concatenate 'string list)))))
(case (length segments)
(0 (values prefix-default nil suffix-default))
;; situation.
(error 'format-error
:complaint "~D illegal directive~:P found inside justification block"
;; situation.
(error 'format-error
:complaint "~D illegal directive~:P found inside justification block"
+ :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))))
(interpret-format-justification stream orig-args args
segments colonp atsignp
first-semi params))))
;;; 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".)
;;; 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".)