From 1f0efb731e8427080690f8ecaf9a56fc287a9d88 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 15 Sep 2004 19:48:32 +0000 Subject: [PATCH] 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. --- src/code/condition.lisp | 3 ++- src/code/cross-condition.lisp | 13 ++++++++++--- src/code/late-format.lisp | 26 +++++++++++++++++--------- src/code/target-format.lisp | 3 ++- version.lisp-expr | 2 +- 5 files changed, 32 insertions(+), 15 deletions(-) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 1511705..618db15 100644 --- 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 --- 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 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -9,7 +9,7 @@ (in-package "SB!FORMAT") -(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 --- 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 --- 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" -- 1.7.10.4