source: trunk/source/tests/ansi-tests/unuse-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: 9.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 08:06:48 1998
4;;;; Contains: Tests of UNUSE-PACKAGE
5
6(in-package :cl-test)
7
8(compile-and-load "package-aux.lsp")
9
10(declaim (optimize (safety 3)))
11
12;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13;;; unuse-package
14
15(deftest unuse-package.1
16  (progn
17    (safely-delete-package "H")
18    (safely-delete-package "G")
19    (let* ((pg (make-package "G" :use nil))
20           (ph (make-package "H" :use '("G")))
21           (i 0) x y)
22      (prog1
23          (and
24           (equal (package-use-list ph) (list pg))
25           (equal (package-used-by-list pg) (list ph))
26           (unuse-package (progn (setf x (incf i)) pg)
27                          (progn (setf y (incf i)) ph))
28           (eql i 2) (eql x 1) (eql y 2)
29           (equal (package-use-list ph) nil)
30           (null (package-used-by-list pg)))
31        (safely-delete-package "H")
32        (safely-delete-package "G"))))
33  t)
34
35(deftest unuse-package.2
36  (progn
37    (safely-delete-package "H")
38    (safely-delete-package "G")
39    (let* ((pg (make-package "G" :use nil))
40           (ph (make-package "H" :use '("G"))))
41      (prog1
42          (and
43           (equal (package-use-list ph) (list pg))
44           (equal (package-used-by-list pg) (list ph))
45           (unuse-package "G" ph)
46           (equal (package-use-list ph) nil)
47           (null (package-used-by-list pg)))
48        (safely-delete-package "H")
49        (safely-delete-package "G"))))
50  t) 
51
52(deftest unuse-package.3
53  (progn
54    (safely-delete-package "H")
55    (safely-delete-package "G")
56    (let* ((pg (make-package "G" :use nil))
57           (ph (make-package "H" :use '("G"))))
58      (prog1
59          (and
60           (equal (package-use-list ph) (list pg))
61           (equal (package-used-by-list pg) (list ph))
62           (unuse-package :|G| ph)
63           (equal (package-use-list ph) nil)
64           (null (package-used-by-list pg)))
65        (safely-delete-package "H")
66        (safely-delete-package "G"))))
67  t)
68
69(deftest unuse-package.4
70  (progn
71    (safely-delete-package "H")
72    (safely-delete-package "G")
73    (let* ((pg (make-package "G" :use nil))
74           (ph (make-package "H" :use '("G"))))
75      (prog1
76          (and
77           (equal (package-use-list ph) (list pg))
78           (equal (package-used-by-list pg) (list ph))
79           (ignore-errors (unuse-package #\G ph))
80           (equal (package-use-list ph) nil)
81           (null (package-used-by-list pg)))
82        (safely-delete-package "H")
83        (safely-delete-package "G"))))
84  t)
85
86(deftest unuse-package.5
87  (progn
88    (safely-delete-package "H")
89    (safely-delete-package "G")
90    (let* ((pg (make-package "G" :use nil))
91           (ph (make-package "H" :use '("G"))))
92      (prog1
93          (and
94           (equal (package-use-list ph) (list pg))
95           (equal (package-used-by-list pg) (list ph))
96           (unuse-package (list pg) ph)
97           (equal (package-use-list ph) nil)
98           (null (package-used-by-list pg)))
99        (safely-delete-package "H")
100        (safely-delete-package "G"))))
101  t) 
102
103(deftest unuse-package.6
104  (progn
105    (safely-delete-package "H")
106    (safely-delete-package "G")
107    (let* ((pg (make-package "G" :use nil))
108           (ph (make-package "H" :use '("G"))))
109      (prog1
110          (and
111           (equal (package-use-list ph) (list pg))
112           (equal (package-used-by-list pg) (list ph))
113           (unuse-package (list "G") ph)
114           (equal (package-use-list ph) nil)
115           (null (package-used-by-list pg)))
116        (safely-delete-package "H")
117        (safely-delete-package "G"))))
118  t)
119
120(deftest unuse-package.7
121  (progn
122    (safely-delete-package "H")
123    (safely-delete-package "G")
124    (let* ((pg (make-package "G" :use nil))
125           (ph (make-package "H" :use '("G"))))
126      (prog1
127          (and
128           (equal (package-use-list ph) (list pg))
129           (equal (package-used-by-list pg) (list ph))
130           (unuse-package (list :|G|) ph)
131           (equal (package-use-list ph) nil)
132           (null (package-used-by-list pg)))
133        (safely-delete-package "H")
134        (safely-delete-package "G"))))
135  t)
136
137(deftest unuse-package.8
138  (progn
139    (safely-delete-package "H")
140    (safely-delete-package "G")
141    (let* ((pg (make-package "G" :use nil))
142           (ph (make-package "H" :use '("G"))))
143      (prog1
144          (and
145           (equal (package-use-list ph) (list pg))
146           (equal (package-used-by-list pg) (list ph))
147           (ignore-errors (unuse-package (list #\G) ph))
148           (equal (package-use-list ph) nil)
149           (null (package-used-by-list pg)))
150        (safely-delete-package "H")
151        (safely-delete-package "G"))))
152  t)
153
154;; Now test with multiple packages
155
156(deftest unuse-package.9
157  (progn
158    (dolist (p '("H1" "H2" "G1" "G2" "G3"))
159      (safely-delete-package p))
160    (let* ((pg1 (make-package "G1" :use nil))
161           (pg2 (make-package "G2" :use nil))
162           (pg3 (make-package "G3" :use nil))
163           (ph1 (make-package "H1" :use (list pg1 pg2 pg3)))
164           (ph2 (make-package "H2" :use (list pg1 pg2 pg3))))
165      (let ((pubg1 (sort-package-list (package-used-by-list pg1)))
166            (pubg2 (sort-package-list (package-used-by-list pg2)))
167            (pubg3 (sort-package-list (package-used-by-list pg3)))
168            (puh1  (sort-package-list (package-use-list ph1)))
169            (puh2  (sort-package-list (package-use-list ph2))))
170        (prog1
171            (and
172             (= (length (remove-duplicates (list pg1 pg2 pg3 ph1 ph2)))
173                5)
174             (equal (list ph1 ph2) pubg1)
175             (equal (list ph1 ph2) pubg2)
176             (equal (list ph1 ph2) pubg3)
177             (equal (list pg1 pg2 pg3) puh1)
178             (equal (list pg1 pg2 pg3) puh2)
179             (unuse-package (list pg1 pg3) ph1)
180             (equal (package-use-list ph1) (list pg2))
181             (equal (package-used-by-list pg1) (list ph2))
182             (equal (package-used-by-list pg3) (list ph2))
183             (equal (sort-package-list (package-use-list ph2))
184                    (list pg1 pg2 pg3))
185             (equal (sort-package-list (package-used-by-list pg2))
186                    (list ph1 ph2))
187             t)
188          (dolist (p '("H1" "H2" "G1" "G2" "G3"))
189            (safely-delete-package p))))))
190  t)
191
192;;; Specialized sequences
193
194(defmacro def-unuse-package-test (test-name &key
195                                            (user "H")
196                                            (used "G"))
197  `(deftest ,test-name
198     (let ((user-name ,user)
199           (used-name ,used))
200       (safely-delete-package user-name)
201       (safely-delete-package used-name)
202       (let* ((pused (make-package used-name :use nil))
203              (puser (make-package user-name :use (list used-name))))
204         (prog1
205             (and
206              (equal (package-use-list puser) (list pused))
207              (equal (package-used-by-list pused) (list puser))
208              (unuse-package (list used-name) user-name)
209              (equal (package-use-list puser) nil)
210              (null (package-used-by-list pused)))
211           (safely-delete-package user-name)
212           (safely-delete-package used-name))))
213     t))
214
215;;; Specialized user package designator
216
217(def-unuse-package-test unuse-package.10
218  :user (make-array 5 :initial-contents "TEST1" :element-type 'base-char))
219
220(def-unuse-package-test unuse-package.11
221  :user (make-array 10 :initial-contents "TEST1ABCDE"
222                    :fill-pointer 5 :element-type 'base-char))
223
224(def-unuse-package-test unuse-package.12
225  :user (make-array 10 :initial-contents "TEST1ABCDE"
226                    :fill-pointer 5 :element-type 'character))
227
228(def-unuse-package-test unuse-package.13
229  :user (make-array 5 :initial-contents "TEST1"
230                    :adjustable t :element-type 'base-char))
231
232(def-unuse-package-test unuse-package.14
233  :user (make-array 5 :initial-contents "TEST1"
234                    :adjustable t :element-type 'character))
235
236(def-unuse-package-test unuse-package.15
237  :user (let* ((etype 'base-char)
238               (name0 (make-array 10 :element-type etype
239                                  :initial-contents "xxxxxTEST1")))
240          (make-array 5 :element-type etype
241                      :displaced-to name0
242                      :displaced-index-offset 5)))
243
244(def-unuse-package-test unuse-package.16
245  :user
246  (let* ((etype 'character)
247         (name0 (make-array 10 :element-type etype
248                            :initial-contents "xxxxxTEST1")))
249    (make-array 5 :element-type etype
250                :displaced-to name0
251                :displaced-index-offset 5)))
252
253;;; Specialed used package designator
254
255(def-unuse-package-test unuse-package.17
256  :used (make-array 5 :initial-contents "TEST1" :element-type 'base-char))
257
258(def-unuse-package-test unuse-package.18
259  :used (make-array 10 :initial-contents "TEST1ABCDE"
260                    :fill-pointer 5 :element-type 'base-char))
261
262(def-unuse-package-test unuse-package.19
263  :used (make-array 10 :initial-contents "TEST1ABCDE"
264                    :fill-pointer 5 :element-type 'character))
265
266(def-unuse-package-test unuse-package.20
267  :used (make-array 5 :initial-contents "TEST1"
268                    :adjustable t :element-type 'base-char))
269
270(def-unuse-package-test unuse-package.21
271  :used (make-array 5 :initial-contents "TEST1"
272                    :adjustable t :element-type 'character))
273
274(def-unuse-package-test unuse-package.22
275  :used (let* ((etype 'base-char)
276               (name0 (make-array 10 :element-type etype
277                                  :initial-contents "xxxxxTEST1")))
278          (make-array 5 :element-type etype
279                      :displaced-to name0
280                      :displaced-index-offset 5)))
281
282(def-unuse-package-test unuse-package.23
283  :used
284  (let* ((etype 'character)
285         (name0 (make-array 10 :element-type etype
286                            :initial-contents "xxxxxTEST1")))
287    (make-array 5 :element-type etype
288                :displaced-to name0
289                :displaced-index-offset 5)))
290
291;;; Error tests
292
293(deftest unuse-package.error.1
294  (signals-error (unuse-package) program-error)
295  t)
296
297(deftest unuse-package.error.2
298  (progn
299    (safely-delete-package "UPE2A")
300    (safely-delete-package "UPE2")
301    (make-package "UPE2" :use ())
302    (make-package "UPE2A" :use '("UPE2"))
303    (signals-error (unuse-package "UPE2" "UPE2A" nil) program-error))
304  t)
Note: See TracBrowser for help on using the repository browser.