X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcondition.lisp;h=faa04474d8eeb6a46231f38e6ffc77e38fc4ff82;hb=bcd323c39d6f5f80020ba4a5d9eb8d348c6cc499;hp=bbeac70866a4507a74279d680fe1bb43b65df1e6;hpb=f1f283e6bee12b7d70bcec52aa226d0532a490fb;p=sbcl.git diff --git a/src/code/condition.lisp b/src/code/condition.lisp index bbeac70..faa0447 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -13,26 +13,6 @@ (in-package "SB!KERNEL") -;;;; miscellaneous support utilities - -;;; Signalling an error when trying to print an error condition is -;;; generally a PITA, so whatever the failure encountered when -;;; wondering about FILE-POSITION within a condition printer, 'tis -;;; better silently to give up than to try to complain. -(defun file-position-or-nil-for-error (stream &optional (pos nil posp)) - ;; Arguably FILE-POSITION shouldn't be signalling errors at all; but - ;; "NIL if this cannot be determined" in the ANSI spec doesn't seem - ;; absolutely unambiguously to prohibit errors when, e.g., STREAM - ;; has been closed so that FILE-POSITION is a nonsense question. So - ;; my (WHN) impression is that the conservative approach is to - ;; IGNORE-ERRORS. (I encountered this failure from within a homebrew - ;; defsystemish operation where the ERROR-STREAM had been CL:CLOSEd, - ;; I think by nonlocally exiting through a WITH-OPEN-FILE, by the - ;; time an error was reported.) - (if posp - (ignore-errors (file-position stream pos)) - (ignore-errors (file-position stream)))) - ;;;; the CONDITION class (/show0 "condition.lisp 20") @@ -588,7 +568,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))))) ;;;; various CONDITIONs specified by ANSI @@ -768,29 +749,6 @@ (:report (lambda (condition stream) (%report-reader-error condition stream :simple t)))) -(defun stream-error-position-info (stream &optional position) - (unless (interactive-stream-p stream) - (let ((now (file-position-or-nil-for-error stream)) - (pos position)) - (when (and (not pos) now (plusp now)) - ;; FILE-POSITION is the next character -- error is at the previous one. - (setf pos (1- now))) - (let (lineno colno) - (when (and pos - (< pos sb!xc:array-dimension-limit) - (file-position stream :start)) - (let ((string - (make-string pos :element-type (stream-element-type stream)))) - (when (= pos (read-sequence string stream)) - ;; Lines count from 1, columns from 0. It's stupid and traditional. - (setq lineno (1+ (count #\Newline string)) - colno (- pos (or (position #\Newline string :from-end t) 0))))) - (file-position-or-nil-for-error stream now)) - (remove-if-not #'second - (list (list :line lineno) - (list :column colno) - (list :file-position pos))))))) - ;;; base REPORTing of a READER-ERROR ;;; ;;; When SIMPLE, we expect and use SIMPLE-CONDITION-ish FORMAT-CONTROL @@ -954,6 +912,12 @@ (define-condition package-at-variance (reference-condition simple-warning) () + (:default-initargs :references (list '(:ansi-cl :macro defpackage) + '(:sbcl :variable *on-package-variance*)))) + +(define-condition package-at-variance-error (reference-condition simple-condition + package-error) + () (:default-initargs :references (list '(:ansi-cl :macro defpackage)))) (define-condition defconstant-uneql (reference-condition error) @@ -1004,8 +968,9 @@ ((name :initarg :name :reader implicit-generic-function-name)) (:report (lambda (condition stream) - (format stream "~@" - (implicit-generic-function-name condition))))) + (let ((*package* (find-package :keyword))) + (format stream "~@" + (implicit-generic-function-name condition)))))) (define-condition extension-failure (reference-condition simple-error) ()) @@ -1614,7 +1579,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))) @@ -1622,14 +1587,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) ()) @@ -1729,5 +1701,14 @@ not exists.") condition, stepping into the current form. Signals a CONTROL-ERROR is the restart does not exist.")) -(/show0 "condition.lisp end of file") +;;; Compiler macro magic + +(define-condition compiler-macro-keyword-problem () + ((argument :initarg :argument :reader compiler-macro-keyword-argument)) + (:report (lambda (condition stream) + (format stream "~@" + (compiler-macro-keyword-argument condition))))) +(/show0 "condition.lisp end of file")