1.0.46.38: tad more information PACKAGE-LOCK-VIOLATION conditions
* Add the current *PACKAGE* when the error is signaled to the
condition.
* Now that SIMPLE-CONDITION :FORMAT-CONTROL defaults to NIL,
PACKAGE-LOCK-VIOLATION can inherit from SIMPLE-CONDITION instead of
definining its own FORMAT-CONTROL and FORMAT-ARGUMENTS slots.
Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.5222
diff -u -r1.5222 version.lisp-expr
--- version.lisp-expr 19 Mar 2011 14:31:29 -0000 1.5222
+++ version.lisp-expr 19 Mar 2011 14:32:06 -0000
@@ -20,4 +20,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".)
-"1.0.46.37"
+"1.0.46.38"
Index: src/code/condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.112
diff -u -r1.112 condition.lisp
--- src/code/condition.lisp 19 Mar 2011 14:31:29 -0000 1.112
+++ src/code/condition.lisp 19 Mar 2011 14:32:06 -0000
@@ -1014,22 +1014,26 @@
#!+sb-package-locks
(progn
-(define-condition package-lock-violation (reference-condition package-error)
- ((format-control :initform nil :initarg :format-control
- :reader package-error-format-control)
- (format-arguments :initform nil :initarg :format-arguments
- :reader package-error-format-arguments))
+(define-condition package-lock-violation (package-error
+ reference-condition
+ simple-condition)
+ ((current-package :initform *package*
+ :reader package-lock-violation-in-package))
(:report
(lambda (condition stream)
- (let ((control (package-error-format-control condition)))
+ (let ((control (simple-condition-format-control condition))
+ (error-package (package-name (package-error-package condition)))
+ (current-package (package-name
(package-lock-violation-in-package condition))))
(if control
(apply #'format stream
- (format nil "~~@<Lock on package ~A violated when ~A.~~:@>"
- (package-name (package-error-package condition))
- control)
- (package-error-format-arguments condition))
- (format stream "~@<Lock on package ~A violated.~:@>"
- (package-name (package-error-package condition)))))))
+ (format nil "~~@<Lock on package ~A violated when
~A while in package ~A.~~:@>"
+ error-package
+ control
+ current-package)
+ (simple-condition-format-arguments condition))
+ (format stream "~@<Lock on package ~A violated while in
package ~A.~:@>"
+ error-package
+ current-package)))))
;; no :default-initargs -- reference-stuff provided by the
;; signalling form in target-package.lisp
#!+sb-doc
|