/[gcl]/gcl/ansi-tests/packages-16.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/packages-16.lsp

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

revision 1.2 by pfdietz, Thu Oct 10 02:06:31 2002 UTC revision 1.3 by pfdietz, Sat Oct 12 04:25:43 2002 UTC
# Line 107  Line 107 
107        (ignore-errors        (ignore-errors
108         (let ((p (ignore-errors (eval `(defpackage "H" (:use)         (let ((p (ignore-errors (eval `(defpackage "H" (:use)
109                                          (:shadow "foo"))))))                                          (:shadow "foo"))))))
110           (and           (list
111            (packagep p)            (not (not (packagep p)))
112            (equal (package-name p)              "H")            (equal (package-name p)              "H")
113            (equal (package-use-list p)          nil)            (equal (package-use-list p)          nil)
114            (equal (package-used-by-list p)      nil)            (equal (package-used-by-list p)      nil)
# Line 123  Line 123 
123                                             (list sym))))                                             (list sym))))
124            (equal (documentation p t)             nil)            (equal (documentation p t)             nil)
125            ))))            ))))
126    t)      (t t t t t t t t))
127    
128  ;; Test defpackage shadow and null use, with several ways  ;; Test defpackage shadow and null use, with several ways
129  ;; of specifying the name of the shadowed symbol  ;; of specifying the name of the shadowed symbol
130  (deftest defpackage-6  (deftest defpackage-6
131      (loop      (loop
132          for s in '(:|f| #\f) count          for s in '(:|f| #\f)
133            (not          collect
134             (ignore-errors          (ignore-errors
135              (ignore-errors (delete-package "H"))            (ignore-errors (delete-package "H"))
136              (let ((p (ignore-errors (eval `(defpackage "H"            (let ((p (ignore-errors (eval `(defpackage "H"
137                                               (:use)                                             (:use)
138                                               (:shadow ,s))))))                                             (:shadow ,s))))))
139                (and              (list
140                 (packagep p)               (not (not (packagep p)))
141                 (equal (package-name p)              "H")               (equal (package-name p)              "H")
142                 (equal (package-use-list p)          nil)               (equal (package-use-list p)          nil)
143                 (equal (package-used-by-list p)      nil)               (equal (package-used-by-list p)      nil)
144                 (equal (package-nicknames p)         nil)               (equal (package-nicknames p)         nil)
145                 (eql (num-symbols-in-package p) 1)               (eql (num-symbols-in-package p) 1)
146                 (multiple-value-bind (sym access)               (multiple-value-bind (sym access)
147                                      (find-symbol "f" p)                   (find-symbol "f" p)
148                                      (and (eq access :internal)                 (and (eq access :internal)
149                                           (equal (symbol-name sym) "f")                      (equal (symbol-name sym) "f")
150                                           (equal (symbol-package sym) p)                      (equal (symbol-package sym) p)
151                                           (equal (package-shadowing-symbols p)                      (equal (package-shadowing-symbols p)
152                                                  (list sym))))                             (list sym))))
153                 (equal (documentation p t)             nil)               (equal (documentation p t)             nil)
154                 )))))               ))))
155    0)      ((t t t t t t t t)
156         (t t t t t t t t)))
157    
158    
159  ;; Testing defpackage with shadowing-import-from.  ;; Testing defpackage with shadowing-import-from.
160  ;; Test several ways of specifying the symbol name  ;; Test several ways of specifying the symbol name
161  (deftest defpackage-7  (deftest defpackage-7
162      (progn    (progn
163        (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
164        (ignore-errors (delete-package "G"))      (ignore-errors (delete-package "G"))
165        (let ((pg (make-package "G" :use nil)))      (let ((pg (make-package "G" :use nil)))
166          ;; Populate package G with several symbols        ;; Populate package G with several symbols
167          (export (intern "A" pg) pg)        (export (intern "A" pg) pg)
168          (export (intern "foo" pg) pg)        (export (intern "foo" pg) pg)
169          (intern "bar" pg)        (intern "bar" pg)
170          ;; Do test with several ways of specifying the        ;; Do test with several ways of specifying the
171          ;; shadowing-imported symbol        ;; shadowing-imported symbol
172          (loop        (loop
173              for n in '("A" :|A| #\A) count         for n in '("A" :|A| #\A)
174                (not         collect
175                 (ignore-errors         (ignore-errors
176                   (ignore-errors (delete-package "H"))           (ignore-errors (delete-package "H"))
177                   (let ((p (ignore-errors           (let ((p (ignore-errors
178                             (eval                      (eval
179                              `(defpackage "H"                       `(defpackage "H"
180                                 (:use)                          (:use)
181                                 (:shadowing-import-from "G" ,n))))))                          (:shadowing-import-from "G" ,n))))))
182                     (and             (list
183                      (packagep p)              (not (not (packagep p)))
184                      (equal (package-name p)              "H")              (equal (package-name p)              "H")
185                      (equal (package-use-list p)          nil)              (equal (package-use-list p)          nil)
186                      (equal (package-used-by-list p)      nil)              (equal (package-used-by-list p)      nil)
187                      (equal (package-nicknames p)         nil)              (equal (package-nicknames p)         nil)
188                      (eql (num-symbols-in-package p) 1)              (eql (num-symbols-in-package p) 1)
189                      (multiple-value-bind (sym access)              (multiple-value-bind (sym access)
190                          (find-symbol "A" p)                  (find-symbol "A" p)
191                        (and (eq access :internal)                (and (eq access :internal)
192                             (equal (symbol-name sym) "A")                     (equal (symbol-name sym) "A")
193                             (equal (symbol-package sym) pg)                     (equal (symbol-package sym) pg)
194                             (equal (package-shadowing-symbols p)                     (equal (package-shadowing-symbols p)
195                                    (list sym))))                            (list sym))))
196                      (equal (documentation p t)             nil)              (equal (documentation p t)             nil)
197                      )))))))              ))))))
198    0)    ((t t t t t t t t)
199       (t t t t t t t t)
200       (t t t t t t t t)))
201    
202  ;; Test import-from option  ;; Test import-from option
203  ;; Test for each way of specifying the imported symbol name,  ;; Test for each way of specifying the imported symbol name,
# Line 206  Line 209 
209        (ignore-errors (delete-package "G"))        (ignore-errors (delete-package "G"))
210        (let ((pg (eval '(defpackage "G" (:use) (:intern "A" "B" "C")))))        (let ((pg (eval '(defpackage "G" (:use) (:intern "A" "B" "C")))))
211          (loop          (loop
212            for pn in '("G" #:|G| #\G) sum            for pn in '("G" #:|G| #\G)
213                (loop            collect
214                    for n in '("B" #:|B| #\B) count            (loop
215                      (not             for n in '("B" #:|B| #\B)
216                       (ignore-errors             collect
217                         (ignore-errors (delete-package "H"))             (ignore-errors
218                         (let ((p (ignore-errors               (ignore-errors (delete-package "H"))
219                                   (eval `(defpackage               (let ((p (ignore-errors
220                                              "H" (:use)                          (eval `(defpackage
221                                              (:import-from ,pn ,n "A"))))))                                   "H" (:use)
222                           (and                                   (:import-from ,pn ,n "A"))))))
223                            (packagep p)                 (list
224                            (equal (package-name p)              "H")                  (not (not (packagep p)))
225                            (equal (package-use-list p)          nil)                  (equal (package-name p)              "H")
226                            (equal (package-used-by-list p)      nil)                  (equal (package-use-list p)          nil)
227                            (equal (package-nicknames p)         nil)                  (equal (package-used-by-list p)      nil)
228                            (equal (package-shadowing-symbols p) nil)                  (equal (package-nicknames p)         nil)
229                            (eql (num-symbols-in-package p) 2)                  (equal (package-shadowing-symbols p) nil)
230                            (multiple-value-bind (sym access)                  (eql (num-symbols-in-package p) 2)
231                                (find-symbol "A" p)                  (multiple-value-bind (sym access)
232                              (and (eq access :internal)                      (find-symbol "A" p)
233                                   (equal (symbol-name sym) "A")                    (and (eq access :internal)
234                                   (equal (symbol-package sym) pg)))                         (equal (symbol-name sym) "A")
235                            (multiple-value-bind (sym access)                         (equal (symbol-package sym) pg)))
236                                (find-symbol "B" p)                  (multiple-value-bind (sym access)
237                              (and (eq access :internal)                      (find-symbol "B" p)
238                                   (equal (symbol-name sym) "B")                    (and (eq access :internal)
239                                   (equal (symbol-package sym) pg)))                         (equal (symbol-name sym) "B")
240                            (equal (documentation p t)             nil)                         (equal (symbol-package sym) pg)))
241                            ))))))))                  (equal (documentation p t)             nil)
242    0)                  )))))))
243        (((t t t t t t t t t) (t t t t t t t t t) (t t t t t t t t t))
244         ((t t t t t t t t t) (t t t t t t t t t) (t t t t t t t t t))
245         ((t t t t t t t t t) (t t t t t t t t t) (t t t t t t t t t))))
246    
247  ;; Test defpackage with export option  ;; Test defpackage with export option
248    
249  (deftest defpackage-9  (deftest defpackage-9
250      (progn    (progn
251        (loop      (loop
252            for n in '("Z" #:|Z| #\Z) count       for n in '("Z" #:|Z| #\Z)
253              (not       collect
254               (ignore-errors       (ignore-errors
255                 (ignore-errors (delete-package "H"))         (ignore-errors (delete-package "H"))
256                 (let ((p (ignore-errors         (let ((p (ignore-errors
257                           (eval `(defpackage                    (eval `(defpackage
258                                      "H"                             "H"
259                                    (:export "Q" ,n "R") (:use))))))                             (:export "Q" ,n "R") (:use))))))
260                   (and           (list
261                    (packagep p)            (not (not (packagep p)))
262                    (equal (package-name p)              "H")            (equal (package-name p)              "H")
263                    (equal (package-use-list p)          nil)            (equal (package-use-list p)          nil)
264                    (equal (package-used-by-list p)      nil)            (equal (package-used-by-list p)      nil)
265                    (equal (package-nicknames p)         nil)            (equal (package-nicknames p)         nil)
266                    (equal (package-shadowing-symbols p) nil)            (equal (package-shadowing-symbols p) nil)
267                    (eql (num-symbols-in-package p) 3)            (eql (num-symbols-in-package p) 3)
268                    (loop            (loop
269                        for s in '("Q" "Z" "R") do             for s in '("Q" "Z" "R") do
270                          (unless             (unless
271                              (multiple-value-bind (sym access)                 (multiple-value-bind (sym access)
272                                  (find-symbol s p)                     (find-symbol s p)
273                                (and (eq access :external)                   (and (eq access :external)
274                                     (equal (symbol-name sym) s)                        (equal (symbol-name sym) s)
275                                     (equal (symbol-package sym) p)))                        (equal (symbol-package sym) p)))
276                            (return nil))               (return nil))
277                        finally (return t))             finally (return t))
278                    ))))))            )))))
279    0)    ((t t t t t t t t)(t t t t t t t t)(t t t t t t t t)))
280    
281  ;; Test defpackage with the intern option  ;; Test defpackage with the intern option
282    
283  (deftest defpackage-10  (deftest defpackage-10
284      (progn    (progn
285        (loop      (loop
286            for n in '("Z" #:|Z| #\Z) count       for n in '("Z" #:|Z| #\Z)
287              (not       collect
288               (ignore-errors       (ignore-errors
289                 (ignore-errors (delete-package "H"))         (ignore-errors (delete-package "H"))
290                 (let ((p (ignore-errors         (let ((p (ignore-errors
291                           (eval `(defpackage                    (eval `(defpackage
292                                      "H"                             "H"
293                                    (:intern "Q" ,n "R") (:use))))))                             (:intern "Q" ,n "R") (:use))))))
294                   (and           (list
295                    (packagep p)            (not (not (packagep p)))
296                    (equal (package-name p)              "H")            (equal (package-name p)              "H")
297                    (equal (package-use-list p)          nil)            (equal (package-use-list p)          nil)
298                    (equal (package-used-by-list p)      nil)            (equal (package-used-by-list p)      nil)
299                    (equal (package-nicknames p)         nil)            (equal (package-nicknames p)         nil)
300                    (equal (package-shadowing-symbols p) nil)            (equal (package-shadowing-symbols p) nil)
301                    (eql (num-symbols-in-package p) 3)            (eql (num-symbols-in-package p) 3)
302                    (loop            (loop
303                        for s in '("Q" "Z" "R") do             for s in '("Q" "Z" "R") do
304                          (unless             (unless
305                              (multiple-value-bind (sym access)                 (multiple-value-bind (sym access)
306                                  (find-symbol s p)                     (find-symbol s p)
307                                (and (eq access :internal)                   (and (eq access :internal)
308                                     (equal (symbol-name sym) s)                        (equal (symbol-name sym) s)
309                                     (equal (symbol-package sym) p)))                        (equal (symbol-package sym) p)))
310                            (return nil))               (return nil))
311                        finally (return t))             finally (return t))
312                    ))))))            )))))
313    0)    ((t t t t t t t t) (t t t t t t t t) (t t t t t t t t)))
314    
315  ;; Test defpackage with size  ;; Test defpackage with size
316    
317  (deftest defpackage-11  (deftest defpackage-11
318      (ignore-errors    (ignore-errors
319        (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
320        (let ((p (ignore-errors      (let ((p (ignore-errors
321                  (eval '(defpackage "H" (:use) (:size 0))))))                 (eval '(defpackage "H" (:use) (:size 0))))))
322          (and        (list
323           (packagep p)         (not (not (packagep p)))
324           (equal (package-name p)              "H")         (equal (package-name p)              "H")
325           (equal (package-use-list p)          nil)         (equal (package-use-list p)          nil)
326           (equal (package-used-by-list p)      nil)         (equal (package-used-by-list p)      nil)
327           (equal (package-nicknames p)         nil)         (equal (package-nicknames p)         nil)
328           (equal (package-shadowing-symbols p) nil)         (equal (package-shadowing-symbols p) nil)
329           (zerop (num-symbols-in-package p)))))         (not (not (zerop (num-symbols-in-package p)))))))
330    t)    (t t t t t t t))
331    
332  (deftest defpackage-12  (deftest defpackage-12
333      (ignore-errors    (ignore-errors
334        (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
335        (let ((p (ignore-errors      (let ((p (ignore-errors
336                  (eval '(defpackage "H" (:use) (:size 10000))))))                 (eval '(defpackage "H" (:use) (:size 10000))))))
337          (and        (list
338           (packagep p)         (not (not (packagep p)))
339           (equal (package-name p)              "H")         (equal (package-name p)              "H")
340           (equal (package-use-list p)          nil)         (equal (package-use-list p)          nil)
341           (equal (package-used-by-list p)      nil)         (equal (package-used-by-list p)      nil)
342           (equal (package-nicknames p)         nil)         (equal (package-nicknames p)         nil)
343           (equal (package-shadowing-symbols p) nil)         (equal (package-shadowing-symbols p) nil)
344           (zerop (num-symbols-in-package p)))))         (not (not (zerop (num-symbols-in-package p)))))))
345    t)    (t t t t t t t))
346    
347  ;; defpackage error handling  ;; defpackage error handling
348    
349  ;; Repeated size field should cause a program-error  ;; Repeated size field should cause a program-error
350  (deftest defpackage-13  (deftest defpackage-13
351      (progn    (progn
352        (ignore-errors (delete-package "H"))      (ignore-errors (delete-package "H"))
353        (handler-case      (handler-case
354            (eval '(defpackage "H" (:use) (:size 10) (:size 20)))       (eval '(defpackage "H" (:use) (:size 10) (:size 20)))
355          (program-error () 'program-error)       (program-error () 'program-error)
356          (error (c) c)))       (error (c) c)))
357    program-error)    program-error)
358    
359  ;; Repeated documentation field should cause a program-error  ;; Repeated documentation field should cause a program-error
# Line 363  Line 369 
369    program-error)    program-error)
370    
371  ;; When a nickname refers to an existing package or nickname,  ;; When a nickname refers to an existing package or nickname,
372  ;; signal a program-error  ;; signal a package-error
373    
374  (deftest defpackage-15  (deftest defpackage-15
375      (progn      (progn
# Line 371  Line 377 
377        (handler-case        (handler-case
378            (eval '(defpackage "H" (:use)            (eval '(defpackage "H" (:use)
379                    (:nicknames "A")))                    (:nicknames "A")))
380          (program-error () 'program-error)          (package-error () 'package-error)
381          (error (c) c)))          (error (c) c)))
382    program-error)    package-error)
383    
384  (deftest defpackage-16  (deftest defpackage-16
385      (progn      (progn
# Line 381  Line 387 
387        (handler-case        (handler-case
388            (eval '(defpackage "H" (:use)            (eval '(defpackage "H" (:use)
389                    (:nicknames "Q")))                    (:nicknames "Q")))
390          (program-error () 'program-error)          (package-error () 'package-error)
391          (error (c) c)))          (error (c) c)))
392    program-error)    package-error)
393    
394  ;; Names in :shadow, :shadowing-import-from, :import-from, and :intern  ;; Names in :shadow, :shadowing-import-from, :import-from, and :intern
395  ;; must be disjoint, or a package-error is signalled.  ;; must be disjoint, or a package-error is signalled.

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

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