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.
@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
(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
(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)
(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))
(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))
(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)
(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
(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
(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
(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