12 |
|
|
13 |
;; Simple unintern of an internal symbol, package explicitly |
;; Simple unintern of an internal symbol, package explicitly |
14 |
;; given as a package object |
;; given as a package object |
15 |
(deftest unintern-1 |
(deftest unintern.1 |
16 |
(progn |
(progn |
17 |
(safely-delete-package "H") |
(safely-delete-package "H") |
18 |
(prog1 |
(prog1 |
19 |
(let ((p (make-package "H"))) |
(let ((p (make-package "H")) |
20 |
|
(i 0) x y) |
21 |
(intern "FOO" p) |
(intern "FOO" p) |
22 |
(multiple-value-bind* (sym access) |
(multiple-value-bind* |
23 |
(find-symbol "FOO" p) |
(sym access) |
24 |
(and |
(find-symbol "FOO" p) |
25 |
(eqt access :internal) |
(and |
26 |
(unintern sym p) |
(eqt access :internal) |
27 |
(null (symbol-package sym)) |
(unintern (progn (setf x (incf i)) sym) |
28 |
(not (find-symbol "FOO" p))))) |
(progn (setf y (incf i)) p)) |
29 |
|
(eql i 2) (eql x 1) (eql y 2) |
30 |
|
(null (symbol-package sym)) |
31 |
|
(not (find-symbol "FOO" p))))) |
32 |
(safely-delete-package "H"))) |
(safely-delete-package "H"))) |
33 |
t) |
t) |
34 |
|
|
35 |
;; Simple unintern, package taken from the *PACKAGES* |
;; Simple unintern, package taken from the *PACKAGES* |
36 |
;; special variable (should this have unwind protect?) |
;; special variable (should this have unwind protect?) |
37 |
(deftest unintern-2 |
(deftest unintern.2 |
38 |
(progn |
(progn |
39 |
(safely-delete-package "H") |
(safely-delete-package "H") |
40 |
(prog1 |
(prog1 |
52 |
t) |
t) |
53 |
|
|
54 |
;; Simple unintern, package given as string |
;; Simple unintern, package given as string |
55 |
(deftest unintern-3 |
(deftest unintern.3 |
56 |
(progn |
(progn |
57 |
(safely-delete-package "H") |
(safely-delete-package "H") |
58 |
(prog1 |
(prog1 |
69 |
t) |
t) |
70 |
|
|
71 |
;; Simple unintern, package given as symbol |
;; Simple unintern, package given as symbol |
72 |
(deftest unintern-4 |
(deftest unintern.4 |
73 |
(progn |
(progn |
74 |
(safely-delete-package "H") |
(safely-delete-package "H") |
75 |
(prog1 |
(prog1 |
86 |
t) |
t) |
87 |
|
|
88 |
;; Simple unintern, package given as character |
;; Simple unintern, package given as character |
89 |
(deftest unintern-5 |
(deftest unintern.5 |
90 |
(handler-case |
(handler-case |
91 |
(progn |
(progn |
92 |
(safely-delete-package "H") |
(safely-delete-package "H") |
109 |
|
|
110 |
;; Unintern an external symbol that is also inherited |
;; Unintern an external symbol that is also inherited |
111 |
|
|
112 |
(deftest unintern-6 |
(deftest unintern.6 |
113 |
(handler-case |
(handler-case |
114 |
(progn |
(progn |
115 |
(safely-delete-package "H") |
(safely-delete-package "H") |
139 |
|
|
140 |
;; unintern a symbol that is shadowing another symbol |
;; unintern a symbol that is shadowing another symbol |
141 |
|
|
142 |
(deftest unintern-7 |
(deftest unintern.7 |
143 |
(block failed |
(block failed |
144 |
(safely-delete-package "H") |
(safely-delete-package "H") |
145 |
(safely-delete-package "G") |
(safely-delete-package "G") |
168 |
|
|
169 |
;; Error situation: when the symbol is uninterned, creates |
;; Error situation: when the symbol is uninterned, creates |
170 |
;; a name conflict from two used packages |
;; a name conflict from two used packages |
171 |
(deftest unintern-8 |
(deftest unintern.8 |
172 |
(block failed |
(block failed |
173 |
(safely-delete-package "H") |
(safely-delete-package "H") |
174 |
(safely-delete-package "G1") |
(safely-delete-package "G1") |
204 |
;; Now, inherit the same symbol through two intermediate |
;; Now, inherit the same symbol through two intermediate |
205 |
;; packages. No error should occur when the shadowing |
;; packages. No error should occur when the shadowing |
206 |
;; is removed |
;; is removed |
207 |
(deftest unintern-9 |
(deftest unintern.9 |
208 |
(block failed |
(block failed |
209 |
(safely-delete-package "H") |
(safely-delete-package "H") |
210 |
(safely-delete-package "G1") |
(safely-delete-package "G1") |