1 |
|
;; packages-test |
2 |
|
; ------------- |
3 |
|
|
4 |
|
;;testfile fuer kapitel 11 |
5 |
|
|
6 |
|
(packagep *package*) |
7 |
|
T |
8 |
|
;;list-all-packages und typtest |
9 |
|
(let ((p (list-all-packages))) |
10 |
|
(every #'packagep p)) |
11 |
|
T |
12 |
|
|
13 |
|
;;11.6 obligate Paketnamen u. deren Abkuerzungen |
14 |
|
|
15 |
|
;;vorhandensein der standardpakete und find-package dafuer |
16 |
|
|
17 |
|
(and (find-package 'lisp) t) |
18 |
|
T |
19 |
|
(and (find-package 'user) t) |
20 |
|
T |
21 |
|
(and (find-package 'keyword) t) |
22 |
|
T |
23 |
|
(and (find-package 'system) t) |
24 |
|
T |
25 |
|
(and (find-package 'sys) t) |
26 |
|
T |
27 |
|
(and (find-package "sys") t) |
28 |
|
NIL |
29 |
|
(and (find-package "sys") t) |
30 |
|
NIL |
31 |
|
(and (find-package "system") t) |
32 |
|
NIL |
33 |
|
(and (find-package "SYSTEM") t) |
34 |
|
T |
35 |
|
(and (find-package "SYS") t) |
36 |
|
T |
37 |
|
|
38 |
|
;nicknames |
39 |
|
(find "SYS" (package-nicknames 'sys) :test #'string=) |
40 |
|
"SYS" |
41 |
|
|
42 |
|
;package-name |
43 |
|
(package-name 'sys) |
44 |
|
"SYSTEM" |
45 |
|
(package-name 'system) |
46 |
|
"SYSTEM" |
47 |
|
(package-name "USER") |
48 |
|
"USER" |
49 |
|
(package-name "SYS") |
50 |
|
"SYSTEM" |
51 |
|
|
52 |
|
|
53 |
|
;;; 11.7 anlegen von paketen, export import ... |
54 |
|
|
55 |
|
;package-funktionen mit nutzerdefinierten paketen |
56 |
|
|
57 |
|
;falls test1 bereits existiert |
58 |
|
(and (find-package 'test1) |
59 |
|
(in-package 'test1) |
60 |
|
(rename-package (find-package 'test1) 'test1-old) |
61 |
|
nil) |
62 |
|
nil |
63 |
|
|
64 |
|
;make-package |
65 |
|
(package-name (make-package 'test1 :nicknames '(t1 tst1))) |
66 |
|
"TEST1" |
67 |
|
|
68 |
|
;package-use-list |
69 |
|
;(package-use-list (find-package 'test1)) |
70 |
|
;("LISP") |
71 |
|
|
72 |
|
|
73 |
|
(and (in-package 'test1) T) |
74 |
|
T |
75 |
|
|
76 |
|
|
77 |
|
(export '(test1::test1-y test1::test1-z)(find-package |
78 |
|
'"TEST1")) |
79 |
|
T |
80 |
|
|
81 |
|
(export '(test1::test1-a test1::test1-b test1::test1-c) (find-package |
82 |
|
'test1)) |
83 |
|
T |
84 |
|
|
85 |
|
(setf test1-a -2 |
86 |
|
test1-b -1 |
87 |
|
test1-c 0 |
88 |
|
test1-x 1 |
89 |
|
test1-y 2 |
90 |
|
test1-z 3) |
91 |
|
3 |
92 |
|
|
93 |
|
;falls test2 bereits existiert |
94 |
|
(and |
95 |
|
(find-package 'test2) |
96 |
|
(rename-package (find-package 'test2) 'test2-old) |
97 |
|
nil) |
98 |
|
nil |
99 |
|
|
100 |
|
(package-name (in-package 'test2 :nicknames '("T2" "TST2") :use 'test1)) |
101 |
|
"TEST2" |
102 |
|
|
103 |
|
(lisp:package-name (lisp:find-package 'test2)) |
104 |
|
"TEST2" |
105 |
|
|
106 |
|
(lisp:package-name lisp:*package*) |
107 |
|
"TEST2" |
108 |
|
|
109 |
|
(lisp:import '(lisp:error) (lisp:find-package 'test2)) |
110 |
|
LISP:T |
111 |
|
|
112 |
|
(lisp:and (lisp:boundp 'test1-x) test1-x) |
113 |
|
LISP:NIL |
114 |
|
|
115 |
|
(lisp:unintern 'test1-x) |
116 |
|
LISP:T |
117 |
|
|
118 |
|
(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)")) |
119 |
|
#+XCL 1 #-XCL ERROR |
120 |
|
|
121 |
|
(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x) |
122 |
|
1 |
123 |
|
|
124 |
|
(lisp:and (lisp:boundp 'test1-y) test1-y) |
125 |
|
#+XCL LISP:NIL #-XCL 2 |
126 |
|
|
127 |
|
(lisp:unintern 'test1-y) |
128 |
|
#+XCL LISP:T #-XCL LISP:NIL |
129 |
|
|
130 |
|
(lisp:and (lisp:boundp 'test1:test1-y) test1:test1-y) |
131 |
|
#+XCL ERROR #-XCL 2 |
132 |
|
|
133 |
|
(lisp:and (lisp:boundp 'test1::test1-y) test1::test1-y) |
134 |
|
2 |
135 |
|
|
136 |
|
(lisp:import '(test1::test1-x test1::test1-y) (lisp:find-package 'test2)) |
137 |
|
LISP:T |
138 |
|
|
139 |
|
(lisp:and (lisp:boundp 'test1-x) test1-x) |
140 |
|
1 |
141 |
|
|
142 |
|
(eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)")) |
143 |
|
#+XCL 1 #-XCL ERROR |
144 |
|
|
145 |
|
(lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x) |
146 |
|
1 |
147 |
|
|
148 |
|
(lisp:and (lisp:boundp 'test1-z) test1-z) |
149 |
|
#+XCL LISP:NIL #-XCL 3 |
150 |
|
|
151 |
|
(lisp:unintern 'test1-z (lisp:find-package 'test2)) |
152 |
|
#+XCL LISP:T #-XCL LISP:NIL |
153 |
|
|
154 |
|
(lisp:and (lisp:boundp 'test1:test1-z) test1:test1-z) |
155 |
|
#+XCL ERROR #-XCL 3 |
156 |
|
|
157 |
|
test1::test1-z |
158 |
|
3 |
159 |
|
|
160 |
|
(lisp:unexport '(test1::test1-x test1::test1-y) (lisp:find-package 'test1)) |
161 |
|
LISP:T |
162 |
|
|
163 |
|
(lisp:and (lisp:boundp 'test1-x) test1-x) |
164 |
|
1 |
165 |
|
|
166 |
|
(lisp:and (lisp:boundp 'test1-y) test1-y) |
167 |
|
#+XCL LISP:NIL #-XCL 2 |
168 |
|
|
169 |
|
(lisp:unintern 'test1-x (lisp:find-package 'test2)) |
170 |
|
LISP:T |
171 |
|
|
172 |
|
(eval (read-from-string "test1:test1-x")) |
173 |
|
ERROR |
174 |
|
|
175 |
|
test1::test1-x |
176 |
|
1 |
177 |
|
|
178 |
|
test1-z |
179 |
|
3 |
180 |
|
|
181 |
|
(lisp:unintern 'test1-z (lisp:find-package 'test2)) |
182 |
|
#+XCL LISP:T #-XCL LISP:NIL |
183 |
|
|
184 |
|
test1:test1-z |
185 |
|
3 |
186 |
|
|
187 |
|
test1::test1-z |
188 |
|
3 |
189 |
|
|
190 |
|
(lisp:import 'test1::test1-z (lisp:find-package 'test2)) |
191 |
|
LISP:T |
192 |
|
|
193 |
|
test1-z |
194 |
|
3 |
195 |
|
|
196 |
|
test1:test1-z |
197 |
|
3 |
198 |
|
|
199 |
|
test1::test1-z |
200 |
|
3 |
201 |
|
|
202 |
|
test1-c |
203 |
|
#+XCL ERROR #-XCL 0 |
204 |
|
|
205 |
|
(lisp:unintern 'test-c (lisp:find-package 'test2)) |
206 |
|
LISP:T |
207 |
|
|
208 |
|
test1:test1-c |
209 |
|
0 |
210 |
|
|
211 |
|
test1::test1-c |
212 |
|
0 |
213 |
|
|
214 |
|
(lisp:import '(test1::test1-a test1::test1-b test1::test1-c) |
215 |
|
(lisp:find-package 'test2)) |
216 |
|
LISP:T |
217 |
|
|
218 |
|
test1-c |
219 |
|
0 |
220 |
|
|
221 |
|
test1:test1-c |
222 |
|
0 |
223 |
|
|
224 |
|
test1::test1-c |
225 |
|
0 |
226 |
|
|
227 |
|
(lisp:eq 'test1-c 'test1::test1-c) |
228 |
|
LISP:T |
229 |
|
|
230 |
|
;Ende nutzerdefinierte Pakete |
231 |
|
|
232 |
|
;; test in standardmaessig vorgegebenen paketen |
233 |
|
|
234 |
|
; export | import | unintern |
235 |
|
|
236 |
|
(lisp:and (lisp:in-package 'user) lisp:T) |
237 |
|
LISP:T |
238 |
|
|
239 |
|
(setf x 1 y 2 z 3) |
240 |
|
3 |
241 |
|
|
242 |
|
(and(in-package 'editor)T) |
243 |
|
T |
244 |
|
|
245 |
|
(unintern 'x) |
246 |
|
T |
247 |
|
|
248 |
|
(unintern 'y) |
249 |
|
T |
250 |
|
|
251 |
|
(unintern 'z) |
252 |
|
T |
253 |
|
|
254 |
|
user::x |
255 |
|
1 |
256 |
|
|
257 |
|
(eval (read-from-string "user:x")) |
258 |
|
ERROR |
259 |
|
|
260 |
|
x |
261 |
|
error |
262 |
|
|
263 |
|
(eq 'x 'user::x) |
264 |
|
NIL |
265 |
|
|
266 |
|
(unintern 'x) |
267 |
|
T |
268 |
|
|
269 |
|
(export '(user::x user::y) (find-package 'user)) |
270 |
|
T |
271 |
|
|
272 |
|
user::x |
273 |
|
1 |
274 |
|
|
275 |
|
user:x |
276 |
|
1 |
277 |
|
|
278 |
|
x |
279 |
|
error |
280 |
|
|
281 |
|
(unintern 'x) |
282 |
|
T |
283 |
|
|
284 |
|
(import 'user:x (find-package 'editor)) |
285 |
|
T |
286 |
|
|
287 |
|
x |
288 |
|
1 |
289 |
|
|
290 |
|
(eq 'x 'user::x) |
291 |
|
t |
292 |
|
|
293 |
|
(eq 'x 'user:x) |
294 |
|
t |
295 |
|
|
296 |
|
(eq 'editor::x 'user::x) |
297 |
|
t |
298 |
|
|
299 |
|
;; unexport |
300 |
|
|
301 |
|
(and (in-package 'user) T) |
302 |
|
T |
303 |
|
|
304 |
|
(unexport 'y) |
305 |
|
T |
306 |
|
|
307 |
|
(and (in-package 'editor) T) |
308 |
|
T |
309 |
|
|
310 |
|
y |
311 |
|
ERROR |
312 |
|
|
313 |
|
(eval (read-from-string "user:y")) |
314 |
|
ERROR |
315 |
|
|
316 |
|
user::y |
317 |
|
2 |
318 |
|
|
319 |
|
;; shadowing-import -- zunaechst ohne geerbte symbole!! |
320 |
|
|
321 |
|
(and (in-package 'user)(package-name *package*)) |
322 |
|
"USER" |
323 |
|
|
324 |
|
(setf d 4 e 5 f 6 y 111 x 222) |
325 |
|
222 |
326 |
|
|
327 |
|
(export '(user::a user::b user::c user::y user::x) (find-package 'user)) |
328 |
|
T |
329 |
|
|
330 |
|
(import '(user::a user::b user::c user::y) (find-package 'editor)) |
331 |
|
ERROR |
332 |
|
|
333 |
|
(and (make-package 'shadow-test)(in-package 'shadow-test)t) |
334 |
|
T |
335 |
|
|
336 |
|
(setf x 'shadow-test) |
337 |
|
shadow-test |
338 |
|
|
339 |
|
(shadowing-import '(user::d user::e user::f user::x)(find-package 'shadow-test)) |
340 |
|
T |
341 |
|
|
342 |
|
x |
343 |
|
222 |
344 |
|
|
345 |
|
(eq user::x x) |
346 |
|
T |
347 |
|
|
348 |
|
; shadow |
349 |
|
|
350 |
|
(shadow '(e f) (find-package 'shadow-test)) |
351 |
|
t |
352 |
|
|
353 |
|
(setf e 'shadow-test-e) |
354 |
|
shadow-test-e |
355 |
|
|
356 |
|
(eq 'e 'user::e) |
357 |
|
#+XCL nil #-XCL t |
358 |
|
|
359 |
|
e |
360 |
|
shadow-test-e |
361 |
|
|
362 |
|
(eval (read-from-string "user:e")) |
363 |
|
error |
364 |
|
|
365 |
|
user::e |
366 |
|
#+XCL 5 #-XCL shadow-test-e |
367 |
|
|
368 |
|
; use-package | unuse-package |
369 |
|
|
370 |
|
(and (make-package 'use-test)(in-package 'use-test) t) |
371 |
|
t |
372 |
|
|
373 |
|
(use-package '(user)) |
374 |
|
T |
375 |
|
|
376 |
|
user::d |
377 |
|
4 |
378 |
|
|
379 |
|
(eval (read-from-string "user:d")) |
380 |
|
#+XCL 4 #-XCL ERROR |
381 |
|
|
382 |
|
d |
383 |
|
ERROR |
384 |
|
|
385 |
|
(unuse-package 'user) |
386 |
|
T |
387 |
|
|
388 |
|
user::d |
389 |
|
4 |
390 |
|
|
391 |
|
(eval (read-from-string "user:d")) |
392 |
|
ERROR |
393 |
|
|
394 |
|
d |
395 |
|
ERROR |
396 |
|
|
397 |
|
;make-package mit beutzung eines paketes, dass geerbte symbole enthaelt |
398 |
|
|
399 |
|
(and (make-package 'inherit :nicknames '(inh i) )(in-package 'inherit) T) |
400 |
|
T |
401 |
|
|
402 |
|
(setf a 'inherita b 'inheritb) |
403 |
|
inheritb |
404 |
|
|
405 |
|
(export '(a b) (find-package 'inherit)) |
406 |
|
T |
407 |
|
|
408 |
|
(and (make-package 'inherit1 :use 'inherit)(in-package 'inherit1) T) |
409 |
|
T |
410 |
|
|
411 |
|
a |
412 |
|
inherit::inherita |
413 |
|
|
414 |
|
b |
415 |
|
inherit::inheritb |
416 |
|
|
417 |
|
(lisp:setf c 'inherit1c) |
418 |
|
inherit1c |
419 |
|
|
420 |
|
(lisp:and (lisp:make-package 'inherit2 :use 'inherit1) |
421 |
|
(lisp:in-package 'inherit2) lisp:T) |
422 |
|
LISP:T |
423 |
|
|
424 |
|
a |
425 |
|
#+XCL inherita #-XCL LISP:ERROR |
426 |
|
|
427 |
|
b |
428 |
|
#+XCL inheritb #-XCL LISP:ERROR |
429 |
|
|
430 |
|
c |
431 |
|
#+XCL inherit1c #-XCL LISP:ERROR |
432 |
|
|
433 |
|
(eval (read-from-string "(lisp:eq 'c 'inherit1:c)")) |
434 |
|
#+XCL LISP:T #-XCL LISP:ERROR |
435 |
|
|
436 |
|
(eval (read-from-string "(lisp:eq 'a 'inherit:a)")) |
437 |
|
#+XCL LISP:T #-XCL LISP:ERROR |
438 |
|
|
439 |
|
(eval (read-from-string "(lisp:eq 'b 'inherit:b)")) |
440 |
|
#+XCL LISP:T #-XCL LISP:ERROR |
441 |
|
|
442 |
|
(lisp:eq 'c 'inherit1::c) |
443 |
|
#+XCL LISP:T #-XCL LISP:NIL |
444 |
|
|
445 |
|
(lisp:eq 'a 'inherit::a) |
446 |
|
#+XCL LISP:T #-XCL LISP:NIL |
447 |
|
|
448 |
|
(lisp:eq 'b 'inherit::b) |
449 |
|
#+XCL LISP:T #-XCL LISP:NIL |
450 |
|
|
451 |
|
;find-all-symbols |
452 |
|
|
453 |
|
(lisp:and (lisp:in-package 'user) lisp:T) |
454 |
|
LISP:T |
455 |
|
|
456 |
|
; find-all-symbols fehlerhaft |
457 |
|
(and (member 'user::x (setf s (find-all-symbols 'x)))T) |
458 |
|
T |
459 |
|
|
460 |
|
(eval (read-from-string "(and (member 'editor:x s) t)")) |
461 |
|
#+XCL T #-XCL ERROR |
462 |
|
|
463 |
|
(and (member 'user::x (setf s1 (find-all-symbols 'x)))T) |
464 |
|
T |
465 |
|
|
466 |
|
(set-difference s s1) |
467 |
|
nil ;Ende Kommentar |
468 |
|
|
469 |
|
;do-symbols | do-external-symbols | do-all-symbols |
470 |
|
|
471 |
|
(setf sym nil |
472 |
|
esym nil |
473 |
|
asym nil |
474 |
|
) |
475 |
|
nil |
476 |
|
|
477 |
|
(do-symbols (s (find-package 'user))(push (symbol-name s) sym)) |
478 |
|
nil |
479 |
|
|
480 |
|
(do-external-symbols (s (find-package 'user))(push (symbol-name s) esym)) |
481 |
|
nil |
482 |
|
|
483 |
|
(do-all-symbols (s)(push (symbol-name s) asym)) |
484 |
|
nil |
485 |
|
|
486 |
|
(find "ESYM" sym :test #'string=) |
487 |
|
"ESYM" |
488 |
|
|
489 |
|
(find "ESYM" esym :test #'string=) |
490 |
|
nil |
491 |
|
|
492 |
|
(find "LAMBDA-LIST-KEYWORDS" esym :test #'string=) |
493 |
|
#+XCL "LAMBDA-LIST-KEYWORDS" #-XCL NIL |
494 |
|
|
495 |
|
;(count "LAMBDA-LIST-KEYWORDS" asym :test #'string=) |
496 |
|
;T ;viel zu lang |
497 |
|
|
498 |
|
; modules | provide | (require nicht getestet !) |
499 |
|
|
500 |
|
(and *modules* T) |
501 |
|
#+XCL T #+CLISP NIL |
502 |
|
|
503 |
|
(and (provide 'provide-test) t) |
504 |
|
t |
505 |
|
|
506 |
|
(find "PROVIDE-TEST" *modules* :test #'string=) |
507 |
|
"PROVIDE-TEST" |
508 |
|
|
509 |
|
(format t "End of file") |
510 |
|
nil |
511 |
|
|