/[gcl]/gcl/tests/pack11.tst
ViewVC logotype

Diff of /gcl/tests/pack11.tst

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26