restore old behaviour as the default for package variance

  Use *on-package-variance* to adjust.

  Hint:

    (setf *on-package-variance* '(:warn (:swank :swank-backend) :error t))

diff --git a/NEWS b/NEWS
index 5f2996c..6c28b57 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,13 @@ changes relative to sbcl-1.1.4:
     resulting from IMPORT, EXPORT, or USE-PACKAGE.
   * enhancement: variant DEFPACKAGE forms now signal a full error with
     restarts provided for resolving the situation. (lp#891351)
+  * enhancement: by setting SB-EXT:*ON-PACKAGE-VARIANCE* to :ERROR variant
+    DEFPACKAGE forms now signal a full error with restarts provided for
+    resolving the situation. Default is :WARN, which retains the previous
+    behaviour. (lp#891351)
+  * enhancement: easier to read method names in backtraces.
+  * bug fix: secondary CLOS dispatch functions have better debug names.
+    (lp#503081)
   * bug fix: deleting a package removes it from implementation-package
     lists of other packages.
 

diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo
index 0cb3688..348208c 100644 (file)
--- a/doc/manual/beyond-ansi.texinfo
+++ b/doc/manual/beyond-ansi.texinfo
@@ -94,6 +94,19 @@ Example:
 @include fun-sb-ext-add-package-local-nickname.texinfo
 @include fun-sb-ext-remove-package-local-nickname.texinfo
 
+@node  Package Variance
+@comment  node-name,  next,  previous,  up
+@section Package Variance
+
+Common Lisp standard specifies that ``If the new definition is at
+variance with the current state of that package, the consequences are
+undefined;'' SBCL by default signals a full warning and retains as
+much of the package state as possible.
+
+This can be adjusted using @code{sb-ext:*on-package-variance*}:
+
+@include var-sb-ext-star-on-package-variance-star.texinfo
+
 @node  Garbage Collection
 @comment  node-name,  next,  previous,  up
 @section Garbage Collection

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 413de56..971ab42 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -709,6 +709,8 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "REMOVE-PACKAGE-LOCAL-NICKNAME"
                "PACKAGE-LOCAL-NICKNAMES"
                "PACKAGE-LOCALLY-NICKNAMED-BY"
+               ;; behaviour on DEFPACKAGE variance
+               "*ON-PACKAGE-VARIANCE*"
 
                ;; Custom conditions & condition accessors for users to handle.
                "CODE-DELETION-NOTE"

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 99d0995..faa0447 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -912,7 +912,8 @@
 
 (define-condition package-at-variance (reference-condition simple-warning)
   ()
-  (:default-initargs :references (list '(:ansi-cl :macro defpackage))))
+  (: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)

diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp
index 003a73c..ae4d051 100644 (file)
--- a/src/code/defpackage.lisp
+++ b/src/code/defpackage.lisp
@@ -262,6 +262,46 @@
     (add-package-local-nickname (car spec) (cdr spec) package))
   package)
 
+(declaim (type list *on-package-variance*))
+(defvar *on-package-variance* '(:warn t)
+  "Specifies behavior when redefining a package using DEFPACKAGE and the
+definition is in variance with the current state of the package.
+
+The value should be of the form:
+
+  (:WARN [T | packages-names] :ERROR [T | package-names])
+
+specifying which packages get which behaviour -- with T signifying the default unless
+otherwise specified. If default is not specified, :WARN is used.
+
+:WARN keeps as much state as possible and causes SBCL to signal a full warning.
+
+:ERROR causes SBCL to signal an error when the variant DEFPACKAGE form is executed,
+with restarts provided for user to specify what action should be taken.
+
+Example:
+
+  (setf *on-package-variance* '(:warn (:swank :swank-backend) :error t))
+
+specifies to signal a warning if SWANK package is in variance, and an error otherwise.")
+
+(defun note-package-variance (&rest args &key package &allow-other-keys)
+  (let ((pname (package-name package)))
+    (destructuring-bind (&key warn error) *on-package-variance*
+      (let ((what (cond ((and (listp error) (member pname error :test #'string=))
+                         :error)
+                        ((and (listp warn) (member pname warn :test #'string=))
+                         :warn)
+                        ((eq t error)
+                         :error)
+                        (t
+                         :warn))))
+        (ecase what
+          (:error
+           (apply #'error 'sb!kernel::package-at-variance-error args))
+          (:warn
+           (apply #'warn 'sb!kernel::package-at-variance args)))))))
+
 (defun update-package-with-variance (package name nicknames source-location
                                      shadows shadowing-imports
                                      use
@@ -281,10 +321,10 @@
     (when no-longer-shadowed
       (restart-case
           (let ((*package* (find-package :keyword)))
-            (error 'sb!kernel::package-at-variance-error
-                   :format-control "~A also shadows the following symbols:~%  ~S"
-                   :format-arguments (list name no-longer-shadowed)
-                   :package package))
+            (note-package-variance
+             :format-control "~A also shadows the following symbols:~%  ~S"
+             :format-arguments (list name no-longer-shadowed)
+             :package package))
         (drop-them ()
           :report "Stop shadowing them by uninterning them."
           (dolist (sym no-longer-shadowed)
@@ -294,10 +334,10 @@
   (let ((no-longer-used (set-difference (package-use-list package) use)))
     (when no-longer-used
       (restart-case
-          (error 'sb!kernel::package-at-variance-error
-                 :format-control "~A also uses the following packages:~%  ~A"
-                 :format-arguments (list name (mapcar #'package-name no-longer-used))
-                 :package package)
+          (note-package-variance
+           :format-control "~A also uses the following packages:~%  ~A"
+           :format-arguments (list name (mapcar #'package-name no-longer-used))
+           :package package)
         (drop-them ()
           :report "Stop using them."
           (unuse-package no-longer-used package))
@@ -309,10 +349,10 @@
     (let ((no-longer-exported (set-difference old-exports exports :test #'string=)))
      (when no-longer-exported
        (restart-case
-           (error 'sb!kernel::package-at-variance-error
-                  :format-control "~A also exports the following symbols:~%  ~S"
-                  :format-arguments (list name no-longer-exported)
-                  :package package)
+           (note-package-variance
+            :format-control "~A also exports the following symbols:~%  ~S"
+            :format-arguments (list name no-longer-exported)
+            :package package)
          (drop-them ()
            :report "Unexport them."
            (unexport no-longer-exported package))
@@ -323,10 +363,10 @@
                           (mapcar #'find-undeleted-package-or-lose implement))))
     (when old-implements
       (restart-case
-          (error 'sb!kernel::package-at-variance-error
-                 :format-control "~A is also an implementation package for:~% ~{~S~^~%  ~}"
-                 :format-arguments (list name old-implements)
-                 :package package)
+          (note-package-variance
+           :format-control "~A is also an implementation package for:~% ~{~S~^~%  ~}"
+           :format-arguments (list name old-implements)
+           :package package)
         (drop-them ()
           :report "Stop being an implementation package for them."
           (dolist (p old-implements)

diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index fc49997..ae0228e 100644 (file)
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -390,7 +390,8 @@ if a restart was invoked."
       (when p2 (delete-package p2)))))
 
 (with-test (:name (:package-at-variance-restarts :shadow))
-  (let (p)
+  (let ((p nil)
+        (*on-package-variance* '(:error t)))
     (unwind-protect
          (progn
            (setf p (eval `(defpackage :package-at-variance-restarts.1
@@ -411,7 +412,8 @@ if a restart was invoked."
       (when p (delete-package p)))))
 
 (with-test (:name (:package-at-variance-restarts :use))
-  (let (p)
+  (let ((p nil)
+        (*on-package-variance* '(:error t)))
     (unwind-protect
          (progn
            (setf p (eval `(defpackage :package-at-variance-restarts.2
@@ -431,7 +433,8 @@ if a restart was invoked."
       (when p (delete-package p)))))
 
 (with-test (:name (:package-at-variance-restarts :export))
-  (let (p)
+  (let ((p nil)
+        (*on-package-variance* '(:error t)))
     (unwind-protect
          (progn
            (setf p (eval `(defpackage :package-at-variance-restarts.4
@@ -449,7 +452,8 @@ if a restart was invoked."
       (when p (delete-package p)))))
 
 (with-test (:name (:package-at-variance-restarts :implement))
-  (let (p)
+  (let ((p nil)
+        (*on-package-variance* '(:error t)))
     (unwind-protect
          (progn
            (setf p (eval `(defpackage :package-at-variance-restarts.5