From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 1 Feb 2013 13:01:11 +0000 (+0200)
Subject: remove deleted packages from implementation-packages list of other packages
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e2c40f8cdd32e299f90cbd7aab985e15928a37cb;p=sbcl.git

remove deleted packages from implementation-packages list of other packages
---

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 892ceaf..238ac91 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -706,6 +706,8 @@ implementation it is ~S." *default-package-use-list*)
                                               (mapcar #'package-name use-list))))
                     (dolist (p use-list)
                       (unuse-package package p))))
+                (dolist (p (package-implements-list package))
+                  (remove-implementation-package package p))
                 (with-package-graph ()
                   ;; Check for races, restart if necessary.
                   (let ((package2 (find-package package-designator)))
diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index 80a807d..4008419 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -465,3 +465,29 @@ if a restart was invoked."
              (eval `(defpackage :package-at-variance-restarts.5)))
            (assert (not (member p (package-implemented-by-list :sb-int)))))
       (when p (delete-package p)))))
+
+(with-test (:name (:delete-package :implementation-package))
+  (let (p1 p2)
+    (unwind-protect
+         (progn
+           (setf p1 (make-package "DELETE-PACKAGE/IMPLEMENTATION-PACKAGE.1")
+                 p2 (make-package "DELETE-PACKAGE/IMPLEMENTATION-PACKAGE.2"))
+           (add-implementation-package p2 p1)
+           (assert (= 1 (length (package-implemented-by-list p1))))
+           (delete-package p2)
+           (assert (= 0 (length (package-implemented-by-list p1)))))
+      (when p1 (delete-package p1))
+      (when p2 (delete-package p2)))))
+
+(with-test (:name (:delete-package :implementated-package))
+  (let (p1 p2)
+    (unwind-protect
+         (progn
+           (setf p1 (make-package "DELETE-PACKAGE/IMPLEMENTED-PACKAGE.1")
+                 p2 (make-package "DELETE-PACKAGE/IMPLEMENTED-PACKAGE.2"))
+           (add-implementation-package p2 p1)
+           (assert (= 1 (length (package-implements-list p2))))
+           (delete-package p1)
+           (assert (= 0 (length (package-implements-list p2)))))
+      (when p1 (delete-package p1))
+      (when p2 (delete-package p2)))))