source: trunk/source/tests/ansi-tests/rename-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: 6.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 08:00:28 1998
4;;;; Contains: Tests of RENAME-PACKAGE
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10;;; rename-package
11
12(deftest rename-package.1
13  (block nil
14    (safely-delete-package "TEST1")
15    (safely-delete-package "TEST2")
16    (let ((p (make-package "TEST1"))
17          (i 0) x y)
18      (unless (packagep p) (return nil))
19      (let ((p2 (rename-package (progn (setf x (incf i)) "TEST1")
20                                (progn (setf y (incf i)) "TEST2"))))
21        (unless (packagep p2)
22          (safely-delete-package p)
23          (return p2))
24        (unless (and (eqt p p2)
25                     (eql i 2)
26                     (eql x 1)
27                     (eql y 2)
28                     (equal (package-name p2) "TEST2"))
29          (safely-delete-package p)
30          (safely-delete-package p2)
31          (return nil))
32        (safely-delete-package p2)
33        t)))
34  t)
35
36(deftest rename-package.2
37  (block nil
38    (safely-delete-package "TEST1")
39    (safely-delete-package "TEST2")
40    (safely-delete-package "TEST3")
41    (safely-delete-package "TEST4")
42    (safely-delete-package "TEST5")
43    (let ((p (make-package "TEST1"))
44          (nicknames (copy-list '("TEST3" "TEST4" "TEST5"))))
45      (unless (packagep p) (return nil))
46      (let ((p2 (rename-package "TEST1" "TEST2" nicknames)))
47        (unless (packagep p2)
48          (safely-delete-package p)
49          (return p2))
50        (unless (and (eqt p p2)
51                     (equal (package-name p2) "TEST2")
52                     (null (set-exclusive-or nicknames
53                                             (package-nicknames p2)
54                                             :test #'equal)))
55          (safely-delete-package p)
56          (safely-delete-package p2)
57          (return nil))
58        (safely-delete-package p2)
59        t)))
60  t)
61
62(deftest rename-package.3
63  (block nil
64    (safely-delete-package "TEST1")
65    (safely-delete-package "TEST2")
66    (let ((p (make-package "TEST1"))
67          (nicknames (copy-list '(#\M #\N))))
68      (unless (packagep p) (return nil))
69      (let ((p2 (ignore-errors (rename-package "TEST1" "TEST2" nicknames))))
70        (unless (packagep p2)
71          (safely-delete-package p)
72          (return p2))
73        (unless (and (eqt p p2)
74                     (equal (package-name p2) "TEST2")
75                     (equal
76                      (sort (copy-list (package-nicknames p2))
77                            #'string<)
78                      (sort (mapcar #'(lambda (c)
79                                        (make-string 1 :initial-element c))
80                                    nicknames)
81                            #'string<)))
82          (safely-delete-package p)
83          (safely-delete-package p2)
84          (return nil))
85        (safely-delete-package p2)
86        t)))
87  t)
88
89(deftest rename-package.4
90  (block nil
91    (safely-delete-package "G")
92    (safely-delete-package "TEST2")
93    (let ((p (make-package "G"))
94          (nicknames nil))
95      (unless (packagep p) (return nil))
96      (let ((p2 (ignore-errors (rename-package #\G "TEST2" nicknames))))
97        (unless (packagep p2)
98          (safely-delete-package p)
99          (return p2))
100        (unless (and (eqt p p2)
101                     (equal (package-name p2) "TEST2")
102                     (null (set-exclusive-or nicknames
103                                             (package-nicknames p2)
104                                             :test #'equal)))
105          (safely-delete-package p)
106          (safely-delete-package p2)
107          (return nil))
108        (ignore-errors (safely-delete-package p2))
109        t)))
110  t)
111
112(deftest rename-package.5
113  (block nil
114    (safely-delete-package "TEST1")
115    (safely-delete-package "G")
116    (let ((p (make-package "TEST1"))
117          (nicknames nil))
118      (unless (packagep p) (return nil))
119      (let ((p2 (ignore-errors (rename-package "TEST1" #\G nicknames))))
120        (unless (packagep p2)
121          (safely-delete-package p)
122          (return p2))
123        (unless (and (eqt p p2)
124                     (equal (package-name p2) "G")
125                     (null (set-exclusive-or nicknames
126                                             (package-nicknames p2)
127                                             :test #'equal)))
128          (safely-delete-package p)
129          (safely-delete-package p2)
130          (return nil))
131        (safely-delete-package p2)
132        t)))
133  t)
134
135(deftest rename-package.6
136  (block nil
137    (safely-delete-package '|TEST1|)
138    (safely-delete-package '|TEST2|)
139    (safely-delete-package '|M|)
140    (safely-delete-package '|N|)
141    (let ((p (make-package '|TEST1|))
142          (nicknames (copy-list '(|M| |N|))))
143      (unless (packagep p) (return nil))
144      (let ((p2 (ignore-errors (rename-package
145                                '|TEST1| '|TEST2| nicknames))))
146        (unless (packagep p2)
147          (safely-delete-package p)
148          (return p2))
149        (unless (and (eqt p p2)
150                     (equal (package-name p2) "TEST2")
151                     (equal
152                      (sort (copy-list (package-nicknames p2))
153                            #'string<)
154                      (sort (mapcar #'symbol-name nicknames)
155                            #'string<)))
156          (safely-delete-package p)
157          (safely-delete-package p2)
158          (return nil))
159        (safely-delete-package p2)
160        t)))
161  t)
162
163(deftest rename-package.7
164  (block nil
165    (let ((name1 (make-array '(5) :element-type 'base-char
166                             :initial-contents "TEST1"))
167          (name2 (make-array '(5) :element-type 'base-char
168                             :initial-contents "TEST2")))
169      (safely-delete-package name1)
170      (safely-delete-package name2)
171      (let ((p (make-package name1)))
172        (unless (packagep p) (return nil))
173        (let ((p2 (rename-package name1 name2)))
174          (unless (packagep p2)
175            (safely-delete-package p)
176            (return p2))
177          (unless (and (eqt p p2)
178                       (equal (package-name p2) name2))
179            (safely-delete-package p)
180            (safely-delete-package p2)
181            (return nil))
182          (safely-delete-package p2)
183          t))))
184  t)
185
186(deftest rename-package.8
187  (block nil
188    (let ((name1 (make-array '(10) :element-type 'base-char
189                             :fill-pointer 5
190                             :initial-contents "TEST1     "))
191          (name2 (make-array '(9) :element-type 'character
192                             :fill-pointer 5
193                             :initial-contents "TEST2XXXX")))
194      (safely-delete-package name1)
195      (safely-delete-package name2)
196      (let ((p (make-package "TEST1")))
197        (unless (packagep p) (return nil))
198        (let ((p2 (rename-package name1 name2)))
199          (unless (packagep p2)
200            (safely-delete-package p)
201            (return p2))
202          (unless (and (eqt p p2)
203                       (string= (package-name p2) "TEST2"))
204            (safely-delete-package p)
205            (safely-delete-package p2)
206            (return nil))
207          (safely-delete-package p2)
208          t))))
209  t)
210
211(deftest rename-package.9
212  (block nil
213    (let ((name1 (make-array '(5) :element-type 'character
214                             :adjustable t
215                             :initial-contents "TEST1"))
216          (name2 (make-array '(5) :element-type 'base-char
217                             :adjustable t
218                             :initial-contents "TEST2")))
219      (safely-delete-package name1)
220      (safely-delete-package name2)
221      (let ((p (make-package "TEST1")))
222        (unless (packagep p) (return nil))
223        (let ((p2 (rename-package name1 name2)))
224          (unless (packagep p2)
225            (safely-delete-package p)
226            (return p2))
227          (unless (and (eqt p p2)
228                       (string= (package-name p2) "TEST2"))
229            (safely-delete-package p)
230            (safely-delete-package p2)
231            (return nil))
232          (safely-delete-package p2)
233          t))))
234  t)
235
236
237
238(deftest rename-package.error.1
239  (signals-error (rename-package) program-error)
240  t)
241
242(deftest rename-package.error.2
243  (signals-error (rename-package "CL") program-error)
244  t)
245
246(deftest rename-package.error.3
247  (signals-error (rename-package "A" "XXXXX" NIL NIL) program-error)
248  t)
Note: See TracBrowser for help on using the repository browser.