source: trunk/source/tests/ansi-tests/make-package.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 14.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 08:02:43 1998
4;;;; Contains: Tests of MAKE-PACKAGE
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10;;; make-package
11
12;; Test basic make-package, using string, symbol and character
13;;    package-designators
14
15(deftest make-package.1
16  (progn
17    (safely-delete-package "TEST1")
18    (let ((p (ignore-errors (make-package "TEST1"))))
19      (prog1
20          (and (packagep p)
21               (equalt (package-name p) "TEST1")
22               (equalt (package-nicknames p) nil)
23               (equalt (package-used-by-list p) nil))
24        (safely-delete-package p))))
25  t)
26
27(deftest make-package.2
28  (progn
29    (safely-delete-package '#:|TEST1|)
30    (let ((p (ignore-errors (make-package '#:|TEST1|))))
31      (prog1
32          (and (packagep p)
33               (equalt (package-name p) "TEST1")
34               (equalt (package-nicknames p) nil)
35               (equalt (package-used-by-list p) nil))
36        (safely-delete-package p))))
37  t)
38
39(deftest make-package.3
40  (progn
41    (safely-delete-package #\X)
42    (let ((p (ignore-errors (make-package #\X))))
43      (prog1
44          (and (packagep p)
45               (equalt (package-name p) "X")
46               (equalt (package-nicknames p) nil)
47               (equalt (package-used-by-list p) nil))
48        (safely-delete-package p))))
49  t)
50
51;; Same, but with a null :use list
52
53(deftest make-package.4
54  (progn
55    (safely-delete-package "TEST1")
56    (let ((p (ignore-errors (make-package "TEST1" :use nil))))
57      (prog1
58          (and (packagep p)
59               (equalt (package-name p) "TEST1")
60               (equalt (package-nicknames p) nil)
61               (equalt (package-use-list p) nil)
62               (equalt (package-used-by-list p) nil))
63        (safely-delete-package p))))
64  t)
65
66(deftest make-package.5
67  (progn
68    (safely-delete-package '#:|TEST1|)
69    (let ((p (ignore-errors (make-package '#:|TEST1| :use nil))))
70      (prog1
71          (and (packagep p)
72               (equalt (package-name p) "TEST1")
73               (equalt (package-nicknames p) nil)
74               (equalt (package-use-list p) nil)
75               (equalt (package-used-by-list p) nil))
76        (safely-delete-package p))))
77  t)
78
79(deftest make-package.6
80  (progn
81    (safely-delete-package #\X)
82    (let ((p (make-package #\X)))
83      (prog1
84          (and (packagep p)
85               (equalt (package-name p) "X")
86               (equalt (package-nicknames p) nil)
87               ;; (equalt (package-use-list p) nil)
88               (equalt (package-used-by-list p) nil))
89        (safely-delete-package p))))
90  t)
91
92;; Same, but use the A package
93
94(deftest make-package.7
95  (progn
96    (set-up-packages)
97    (safely-delete-package "TEST1")
98    (let ((p (ignore-errors (make-package "TEST1" :use '("A")))))
99      (prog1
100          (and (packagep p)
101               (equalt (package-name p) "TEST1")
102               (equalt (package-nicknames p) nil)
103               (equalt (package-use-list p) (list (find-package "A")))
104               (equalt (package-used-by-list p) nil))
105        (safely-delete-package p))))
106  t)
107
108(deftest make-package.7a
109  (progn
110    (set-up-packages)
111    (safely-delete-package "TEST1")
112    (let ((p (ignore-errors (make-package "TEST1" :use '(#:|A|)))))
113      (prog1
114          (and (packagep p)
115               (equalt (package-name p) "TEST1")
116               (equalt (package-nicknames p) nil)
117               (equalt (package-use-list p) (list (find-package "A")))
118               (equalt (package-used-by-list p) nil))
119        (safely-delete-package p))))
120  t)
121
122(deftest make-package.7b
123  (progn
124    (set-up-packages)
125    (safely-delete-package "TEST1")
126    (let ((p (ignore-errors (make-package "TEST1" :use '(#\A)))))
127      (prog1
128          (and (packagep p)
129               (equalt (package-name p) "TEST1")
130               (equalt (package-nicknames p) nil)
131               (equalt (package-use-list p) (list (find-package "A")))
132               (equalt (package-used-by-list p) nil))
133        (safely-delete-package p))))
134  t)
135
136(deftest make-package.8
137  (progn
138    (set-up-packages)
139    (safely-delete-package '#:|TEST1|)
140    (let ((p (ignore-errors (make-package '#:|TEST1| :use '("A")))))
141      (multiple-value-prog1
142          (values (notnot (packagep p))
143                  (equalt (package-name p) "TEST1")
144                  (equalt (package-nicknames p) nil)
145                  (equalt (package-use-list p) (list (find-package "A")))
146                  (equalt (package-used-by-list p) nil))
147        (safely-delete-package p))))
148  t t t t t)
149
150(deftest make-package.8a
151  (progn
152    (set-up-packages)
153    (safely-delete-package '#:|TEST1|)
154    (let ((p (ignore-errors (make-package '#:|TEST1| :use '(#:|A|)))))
155      (multiple-value-prog1
156          (values (notnot (packagep p))
157                  (equalt (package-name p) "TEST1")
158                  (equalt (package-nicknames p) nil)
159                  (equalt (package-use-list p) (list (find-package "A")))
160                  (equalt (package-used-by-list p) nil))
161        (safely-delete-package p))))
162  t t t t t)
163
164(deftest make-package.8b
165  (progn
166    (set-up-packages)
167    (safely-delete-package '#:|TEST1|)
168    (let ((p (ignore-errors (make-package '#:|TEST1| :use '(#\A)))))
169      (multiple-value-prog1
170          (values (packagep p)
171                  (equalt (package-name p) "TEST1")
172                  (equalt (package-nicknames p) nil)
173                  (equalt (package-use-list p) (list (find-package "A")))
174                  (equalt (package-used-by-list p) nil))
175        (safely-delete-package p))))
176  t t t t t)
177
178(deftest make-package.9
179  (progn
180    (set-up-packages)
181    (safely-delete-package #\X)
182    (let ((p (ignore-errors (make-package #\X :use '("A")))))
183      (multiple-value-prog1
184          (values (notnot (packagep p))
185                  (equalt (package-name p) "X")
186                  (equalt (package-nicknames p) nil)
187                  (equalt (package-use-list p) (list (find-package "A")))
188                  (equalt (package-used-by-list p) nil))
189        (safely-delete-package p))))
190  t t t t t)
191
192(deftest make-package.9a
193  (progn
194    (set-up-packages)
195    (safely-delete-package #\X)
196    (let ((p (ignore-errors (make-package #\X :use '(#:|A|)))))
197      (multiple-value-prog1
198          (values (notnot (packagep p))
199                  (equalt (package-name p) "X")
200                  (equalt (package-nicknames p) nil)
201                  (equalt (package-use-list p) (list (find-package "A")))
202                  (equalt (package-used-by-list p) nil))
203        (safely-delete-package p))))
204  t t t t t)
205
206(deftest make-package.9b
207  (progn
208    (set-up-packages)
209    (safely-delete-package #\X)
210    (let ((p (ignore-errors (make-package #\X :use '(#\A)))))
211      (multiple-value-prog1
212          (values (notnot (packagep p))
213                  (equalt (package-name p) "X")
214                  (equalt (package-nicknames p) nil)
215                  (equalt (package-use-list p) (list (find-package "A")))
216                  (equalt (package-used-by-list p) nil))
217        (safely-delete-package p))))
218  t t t t t)
219
220;; make-package with nicknames
221
222(deftest make-package.10
223  (progn
224    (mapc #'safely-delete-package '("TEST1" "F"))
225    (let ((p (make-package "TEST1" :nicknames '("F"))))
226      (multiple-value-prog1
227          (values (notnot (packagep p))
228                  (equalt (package-name p) "TEST1")
229                  (equalt (package-nicknames p) '("F"))
230                  (equalt (package-used-by-list p) nil))
231        (safely-delete-package p))))
232  t t t t)
233
234(deftest make-package.11
235  (progn
236    (mapc #'safely-delete-package '("TEST1" "G"))
237    (let ((p (make-package '#:|TEST1| :nicknames '(#:|G|))))
238      (multiple-value-prog1
239          (values (notnot (packagep p))
240                  (equalt (package-name p) "TEST1")
241                  (equalt (package-nicknames p) '("G"))
242                  (equalt (package-used-by-list p) nil))
243        (safely-delete-package p))))
244  t t t t)
245
246(deftest make-package.12
247  (progn
248    (mapc #'safely-delete-package '("TEST1" "G"))
249    (let ((p (make-package '#:|TEST1| :nicknames '(#\G))))
250      (multiple-value-prog1
251          (values (notnot (packagep p))
252                  (equalt (package-name p) "TEST1")
253                  (equalt (package-nicknames p) '("G"))
254                  (equalt (package-used-by-list p) nil))
255        (safely-delete-package p))))
256  t t t t)
257
258(deftest make-package.13
259  (progn
260    (mapc #'safely-delete-package '(#\X #\F #\G #\H))
261    (let ((p (make-package #\X :nicknames '("F" #\G #:|H|))))
262      (multiple-value-prog1
263          (values (notnot (packagep p))
264                  (equalt (package-name p) "X")
265                  (set-exclusive-or (package-nicknames p)
266                                    '("F" "G" "H")
267                                    :test #'equal)
268                  (equalt (package-used-by-list p) nil))
269        (safely-delete-package p))))
270  t t nil t)
271
272;;; Specialized sequences as designators
273
274;;; The package name being a specialized sequence
275
276(defmacro def-make-package-test1 (test-name name-form)
277  `(deftest ,test-name
278     (let ((name ,name-form))
279       (assert (string= name "TEST1"))
280       (safely-delete-package "TEST1")
281       (let ((p (ignore-errors (make-package name))))
282         (multiple-value-prog1
283          (values (notnot (packagep p))
284                  (equalt (package-name p) "TEST1")
285                  (equalt (package-nicknames p) nil)
286                  (equalt (package-used-by-list p) nil))
287          (safely-delete-package p))))
288     t t t t))
289
290(def-make-package-test1 make-package.14
291  (make-array 5 :initial-contents "TEST1"
292              :element-type 'base-char))
293
294(def-make-package-test1 make-package.15
295  (make-array 12 :initial-contents "TEST1xxxyyyz"
296              :fill-pointer 5
297              :element-type 'base-char))
298
299(def-make-package-test1 make-package.16
300  (make-array 12 :initial-contents "TEST1xxxyyyz"
301              :fill-pointer 5
302              :element-type 'character))
303
304(def-make-package-test1 make-package.17
305  (make-array 5 :initial-contents "TEST1"
306              :adjustable t
307              :element-type 'base-char))
308
309(def-make-package-test1 make-package.18
310  (make-array 5 :initial-contents "TEST1"
311              :adjustable t
312              :element-type 'character))
313
314(def-make-package-test1 make-package.19
315  (let* ((etype 'base-char)
316         (name0 (make-array 10 :initial-contents "xxTEST1yyy"
317                            :element-type etype)))
318    (make-array 5 :element-type etype
319                :displaced-to name0
320                :displaced-index-offset 2)))
321
322(def-make-package-test1 make-package.20
323  (let* ((etype 'character)
324         (name0 (make-array 10 :initial-contents "xxTEST1yyy"
325                            :element-type etype)))
326    (make-array 5 :element-type etype
327                :displaced-to name0
328                :displaced-index-offset 2)))
329
330;;; Nicknames being specialized sequences
331
332(defmacro def-make-package-test2 (test-name name-form)
333  `(deftest ,test-name
334     (let ((name ,name-form)
335           (nickname "TEST1-NICKNAME"))
336       (safely-delete-package "TEST1")
337       (safely-delete-package nickname)
338       (let ((p (make-package name :nicknames (list nickname))))
339         (multiple-value-prog1
340             (values (notnot (packagep p))
341                     (equalt (package-name p) "TEST1")
342                     (equalt (package-nicknames p) (list nickname))
343                     (equalt (package-used-by-list p) nil))
344             (safely-delete-package p))))
345     t t t t))
346
347(def-make-package-test2 make-package.21
348  (make-array 5 :initial-contents "TEST1"
349              :element-type 'base-char))
350
351(def-make-package-test2 make-package.22
352  (make-array 12 :initial-contents "TEST1xxxyyyz"
353              :fill-pointer 5
354              :element-type 'base-char))
355
356(def-make-package-test2 make-package.23
357  (make-array 12 :initial-contents "TEST1xxxyyyz"
358              :fill-pointer 5
359              :element-type 'character))
360
361(def-make-package-test2 make-package.24
362  (make-array 5 :initial-contents "TEST1"
363              :adjustable t
364              :element-type 'base-char))
365
366(def-make-package-test2 make-package.25
367  (make-array 5 :initial-contents "TEST1"
368              :adjustable t
369              :element-type 'character))
370
371(def-make-package-test2 make-package.26
372  (let* ((etype 'base-char)
373         (name0 (make-array 10 :initial-contents "xxTEST1yyy"
374                            :element-type etype)))
375    (make-array 5 :element-type etype
376                :displaced-to name0
377                :displaced-index-offset 2)))
378
379(def-make-package-test2 make-package.27
380  (let* ((etype 'character)
381         (name0 (make-array 10 :initial-contents "xxTEST1yyy"
382                            :element-type etype)))
383    (make-array 5 :element-type etype
384                :displaced-to name0
385                :displaced-index-offset 2)))
386
387;;; USE names being specialized sequences
388
389(defmacro def-make-package-test3 (test-name name-form)
390  `(deftest ,test-name
391     (let ((name ,name-form))
392       (set-up-packages)
393       (safely-delete-package "TEST1")
394       (assert (find-package name))
395       (let ((p (ignore-errors (make-package "TEST1" :use (list name)))))
396         (multiple-value-prog1
397             (values (notnot (packagep p))
398                     (equalt (package-name p) "TEST1")
399                     (equalt (package-nicknames p) nil)
400                     (equalt (package-use-list p) (list (find-package name)))
401                     (equalt (package-used-by-list p) nil))
402             (safely-delete-package p))))
403     t t t t t))
404
405(def-make-package-test3 make-package.28
406  (make-array 1 :initial-contents "A" :element-type 'base-char))
407
408(def-make-package-test3 make-package.29
409  (make-array 8 :initial-contents "Axxxyyyz"
410              :fill-pointer 1
411              :element-type 'base-char))
412
413(def-make-package-test3 make-package.30
414  (make-array 8 :initial-contents "Axxxyyyz"
415              :fill-pointer 1
416              :element-type 'character))
417
418(def-make-package-test3 make-package.31
419  (make-array 1 :initial-contents "A"
420              :adjustable t
421              :element-type 'base-char))
422
423(def-make-package-test3 make-package.32
424  (make-array 1 :initial-contents "A"
425              :adjustable t
426              :element-type 'character))
427
428(def-make-package-test3 make-package.33
429  (let* ((etype 'base-char)
430         (name0 (make-array 10 :initial-contents "xxAyyy0123"
431                            :element-type etype)))
432    (make-array 1 :element-type etype
433                :displaced-to name0
434                :displaced-index-offset 2)))
435
436(def-make-package-test3 make-package.34
437  (let* ((etype 'character)
438         (name0 (make-array 10 :initial-contents "xxAzzzzyyy"
439                            :element-type etype)))
440    (make-array 1 :element-type etype
441                :displaced-to name0
442                :displaced-index-offset 2)))
443
444;; Signal a continuable error if the package or any nicknames
445;; exist as packages or nicknames of packages
446
447(deftest make-package.error.1
448  (progn
449    (set-up-packages)
450    (handle-non-abort-restart (make-package "A")))
451  success) 
452
453(deftest make-package.error.2
454  (progn
455    (set-up-packages)
456    (handle-non-abort-restart (make-package "Q")))
457  success)
458
459(deftest make-package.error.3
460  (progn
461    (set-up-packages)
462    (handle-non-abort-restart
463     (safely-delete-package "TEST1")
464     (make-package "TEST1" :nicknames '("A"))))
465  success)
466
467(deftest make-package.error.4
468  (handle-non-abort-restart
469   (safely-delete-package "TEST1")
470   (set-up-packages)
471   (make-package "TEST1" :nicknames '("Q")))
472  success)
473
474(deftest make-package.error.5
475  (signals-error (make-package) program-error)
476  t)
477
478(deftest make-package.error.6
479  (progn
480    (safely-delete-package "MPE6")
481    (signals-error (make-package "MPE6" :bad t) program-error))
482  t)
483
484(deftest make-package.error.7
485  (progn
486    (safely-delete-package "MPE7")
487    (signals-error (make-package "MPE7" :nicknames) program-error))
488  t)
489
490(deftest make-package.error.8
491  (progn
492    (safely-delete-package "MPE8")
493    (signals-error (make-package "MPE8" :use) program-error))
494  t)
495
496(deftest make-package.error.9
497  (progn
498    (safely-delete-package "MPE9")
499    (signals-error (make-package "MPE9" 'bad t) program-error))
500  t)
501
502(deftest make-package.error.10
503  (progn
504    (safely-delete-package "MPE10")
505    (signals-error (make-package "MPE10" 1 2) program-error))
506  t)
507
508(deftest make-package.error.11
509  (progn
510    (safely-delete-package "MPE11")
511    (signals-error (make-package "MPE11" 'bad t :allow-other-keys nil)
512                   program-error))
513  t)
Note: See TracBrowser for help on using the repository browser.