X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpackages.impure.lisp;fp=tests%2Fpackages.impure.lisp;h=80a807d4c5791eb0f50740ffcb0954de18d9508b;hb=447788f1b408a8e9ec15ca822851dcd0bee52f82;hp=31046f5115d71f0e65e63ace7871782d3346bee0;hpb=1ecb2d07a7a3c0964d473c1eca66cebd4223e47a;p=sbcl.git

diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp
index 31046f5..80a807d 100644
--- a/tests/packages.impure.lisp
+++ b/tests/packages.impure.lisp
@@ -388,3 +388,80 @@ if a restart was invoked."
            (assert (eq (intern "BAR" p1) (intern "BAR" p2))))
       (when p1 (delete-package p1))
       (when p2 (delete-package p2)))))
+
+(with-test (:name (:package-at-variance-restarts :shadow))
+  (let (p)
+    (unwind-protect
+         (progn
+           (setf p (eval `(defpackage :package-at-variance-restarts.1
+                            (:use :cl)
+                            (:shadow "CONS"))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::keep-them))))
+             (eval `(defpackage :package-at-variance-restarts.1
+                      (:use :cl))))
+           (assert (not (eq 'cl:cons (intern "CONS" p))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::drop-them))))
+             (eval `(defpackage :package-at-variance-restarts.1
+                      (:use :cl))))
+           (assert (eq 'cl:cons (intern "CONS" p))))
+      (when p (delete-package p)))))
+
+(with-test (:name (:package-at-variance-restarts :use))
+  (let (p)
+    (unwind-protect
+         (progn
+           (setf p (eval `(defpackage :package-at-variance-restarts.2
+                            (:use :cl))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::keep-them))))
+             (eval `(defpackage :package-at-variance-restarts.2
+                      (:use))))
+           (assert (eq 'cl:cons (intern "CONS" p)))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::drop-them))))
+             (eval `(defpackage :package-at-variance-restarts.2
+                      (:use))))
+           (assert (not (eq 'cl:cons (intern "CONS" p)))))
+      (when p (delete-package p)))))
+
+(with-test (:name (:package-at-variance-restarts :export))
+  (let (p)
+    (unwind-protect
+         (progn
+           (setf p (eval `(defpackage :package-at-variance-restarts.4
+                            (:export "FOO"))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::keep-them))))
+             (eval `(defpackage :package-at-variance-restarts.4)))
+           (assert (eq :external (nth-value 1 (find-symbol "FOO" p))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::drop-them))))
+             (eval `(defpackage :package-at-variance-restarts.4)))
+           (assert (eq :internal (nth-value 1 (find-symbol "FOO" p)))))
+      (when p (delete-package p)))))
+
+(with-test (:name (:package-at-variance-restarts :implement))
+  (let (p)
+    (unwind-protect
+         (progn
+           (setf p (eval `(defpackage :package-at-variance-restarts.5
+                            (:implement :sb-int))))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::keep-them))))
+             (eval `(defpackage :package-at-variance-restarts.5)))
+           (assert (member p (package-implemented-by-list :sb-int)))
+           (handler-bind ((sb-kernel::package-at-variance-error
+                            (lambda (c)
+                              (invoke-restart 'sb-impl::drop-them))))
+             (eval `(defpackage :package-at-variance-restarts.5)))
+           (assert (not (member p (package-implemented-by-list :sb-int)))))
+      (when p (delete-package p)))))