remove deleted packages from implementation-packages list of other packages
authorNikodemus Siivola <nikodemus@random-state.net>
Fri, 1 Feb 2013 13:01:11 +0000 (15:01 +0200)
committerNikodemus Siivola <nikodemus@random-state.net>
Fri, 1 Feb 2013 13:23:40 +0000 (15:23 +0200)
src/code/target-package.lisp
tests/packages.impure.lisp

index 892ceaf..238ac91 100644 (file)
@@ -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)))
index 80a807d..4008419 100644 (file)
@@ -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)))))