From c92ed9e146effcd017fea24e4d1fc5e26af73ae0 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 19 Mar 2011 14:33:16 +0000
Subject: [PATCH] 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.
---
 src/code/condition.lisp |   28 ++++++++++++++++------------
 version.lisp-expr       |    2 +-
 2 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index fc216f0..acaf32b 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -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
diff --git a/version.lisp-expr b/version.lisp-expr
index d85c22e..aceeb6f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"
-- 
1.7.10.4