16 |
(safely-delete-package "TEST4") |
(safely-delete-package "TEST4") |
17 |
(handler-case |
(handler-case |
18 |
(let* ((p1 (prog1 |
(let* ((p1 (prog1 |
19 |
(make-package "TEST4") |
(make-package "TEST4" :use nil) |
20 |
(export (intern "A" "TEST4") "TEST4"))) |
(export (intern "A" "TEST4") "TEST4"))) |
21 |
(p2 (make-package "TEST5" :use '("TEST4"))) |
(p2 (make-package "TEST5" :use '("TEST4"))) |
22 |
(r1 (package-shadowing-symbols "TEST4")) |
(r1 (package-shadowing-symbols "TEST4")) |
56 |
(safely-delete-package "G") |
(safely-delete-package "G") |
57 |
(handler-case |
(handler-case |
58 |
(let* ((p1 (prog1 |
(let* ((p1 (prog1 |
59 |
(make-package "G") |
(make-package "G" :use nil) |
60 |
(export (intern "A" "G") "G"))) |
(export (intern "A" "G") "G"))) |
61 |
(p2 (make-package "H" :use '("G"))) |
(p2 (make-package "H" :use '("G"))) |
62 |
(r1 (package-shadowing-symbols "G")) |
(r1 (package-shadowing-symbols "G")) |
94 |
(safely-delete-package "G") |
(safely-delete-package "G") |
95 |
(handler-case |
(handler-case |
96 |
(let* ((p1 (prog1 |
(let* ((p1 (prog1 |
97 |
(make-package "G") |
(make-package "G" :use nil) |
98 |
(export (intern "A" "G") "G"))) |
(export (intern "A" "G") "G"))) |
99 |
(p2 (make-package "H" :use '("G"))) |
(p2 (make-package "H" :use '("G"))) |
100 |
(r1 (package-shadowing-symbols "G")) |
(r1 (package-shadowing-symbols "G")) |
131 |
(handler-case |
(handler-case |
132 |
(progn |
(progn |
133 |
(safely-delete-package :G) |
(safely-delete-package :G) |
134 |
(make-package :G) |
(make-package :G :use nil) |
135 |
(let ((s1 (intern "X" :G))) |
(let ((s1 (intern "X" :G))) |
136 |
(shadow "X" :G) |
(shadow "X" :G) |
137 |
(multiple-value-bind* (s2 kind) |
(multiple-value-bind* (s2 kind) |
152 |
(progn |
(progn |
153 |
(safely-delete-package :H) |
(safely-delete-package :H) |
154 |
(safely-delete-package :G) |
(safely-delete-package :G) |
155 |
(make-package :G) |
(make-package :G :use nil) |
156 |
(export (intern "X" :G) :G) |
(export (intern "X" :G) :G) |
157 |
(make-package :H :use '("G")) |
(make-package :H :use '("G")) |
158 |
(shadow "X" :H) |
(shadow "X" :H) |
174 |
(handler-case |
(handler-case |
175 |
(progn |
(progn |
176 |
(safely-delete-package :G) |
(safely-delete-package :G) |
177 |
(make-package :G) |
(make-package :G :use nil) |
178 |
(shadow '("X" "Y" |Z|) :G) |
(shadow '("X" "Y" |Z|) :G) |
179 |
(let ((results |
(let ((results |
180 |
(append (multiple-value-list |
(append (multiple-value-list |
202 |
(handler-case |
(handler-case |
203 |
(let ((i 0) x y) |
(let ((i 0) x y) |
204 |
(safely-delete-package :G) |
(safely-delete-package :G) |
205 |
(make-package :G) |
(make-package :G :use nil) |
206 |
(shadow (progn (setf x (incf i)) '(#\X #\Y)) |
(shadow (progn (setf x (incf i)) '(#\X #\Y)) |
207 |
(progn (setf y (incf i)) :G)) |
(progn (setf y (incf i)) :G)) |
208 |
(let ((results |
(let ((results |
222 |
(safely-delete-package :G)) |
(safely-delete-package :G)) |
223 |
(2 1 2 "X" :internal "Y" :internal 2)) |
(2 1 2 "X" :internal "Y" :internal 2)) |
224 |
|
|
225 |
|
;;; Specialized string tests |
226 |
|
|
227 |
|
(deftest shadow.8 |
228 |
|
(prog1 |
229 |
|
(handler-case |
230 |
|
(progn |
231 |
|
(safely-delete-package :G) |
232 |
|
(make-package :G :use nil) |
233 |
|
(let* ((name (make-array '(1) :initial-contents "X" |
234 |
|
:element-type 'base-char)) |
235 |
|
(s1 (intern name :G))) |
236 |
|
(shadow name :G) |
237 |
|
(multiple-value-bind* (s2 kind) |
238 |
|
(find-symbol "X" :G) |
239 |
|
(list (eqt s1 s2) |
240 |
|
(symbol-name s2) |
241 |
|
(package-name (symbol-package s2)) |
242 |
|
kind)))) |
243 |
|
(error (c) c)) |
244 |
|
(safely-delete-package "G")) |
245 |
|
(t "X" "G" :internal)) |
246 |
|
|
247 |
|
(deftest shadow.9 |
248 |
|
(prog1 |
249 |
|
(handler-case |
250 |
|
(progn |
251 |
|
(safely-delete-package :G) |
252 |
|
(make-package :G :use nil) |
253 |
|
(let* ((name (make-array '(3) :initial-contents "XYZ" |
254 |
|
:fill-pointer 1 |
255 |
|
:element-type 'character)) |
256 |
|
(s1 (intern name :G))) |
257 |
|
(shadow name :G) |
258 |
|
(multiple-value-bind* (s2 kind) |
259 |
|
(find-symbol "X" :G) |
260 |
|
(list (eqt s1 s2) |
261 |
|
(symbol-name s2) |
262 |
|
(package-name (symbol-package s2)) |
263 |
|
kind)))) |
264 |
|
(error (c) c)) |
265 |
|
(safely-delete-package "G")) |
266 |
|
(t "X" "G" :internal)) |
267 |
|
|
268 |
|
(deftest shadow.10 |
269 |
|
(prog1 |
270 |
|
(handler-case |
271 |
|
(progn |
272 |
|
(safely-delete-package :G) |
273 |
|
(make-package :G :use nil) |
274 |
|
(let* ((name (make-array '(1) :initial-contents "X" |
275 |
|
:adjustable t |
276 |
|
:element-type 'base-char)) |
277 |
|
(s1 (intern name :G))) |
278 |
|
(shadow name :G) |
279 |
|
(multiple-value-bind* (s2 kind) |
280 |
|
(find-symbol "X" :G) |
281 |
|
(list (eqt s1 s2) |
282 |
|
(symbol-name s2) |
283 |
|
(package-name (symbol-package s2)) |
284 |
|
kind)))) |
285 |
|
(error (c) c)) |
286 |
|
(safely-delete-package "G")) |
287 |
|
(t "X" "G" :internal)) |
288 |
|
|
289 |
|
|
290 |
|
|
291 |
|
|
292 |
(deftest shadow.error.1 |
(deftest shadow.error.1 |
293 |
(signals-error (shadow) program-error) |
(signals-error (shadow) program-error) |
294 |
t) |
t) |