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

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

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

File size: 3.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 25 07:51:26 1998
4;;;; Contains: Tests of PACKAGE-NICKNAMES
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10;;; package-nicknames
11
12(deftest package-nicknames.1
13  (progn
14    (set-up-packages)
15    (package-nicknames "A"))
16  ("Q"))
17
18(deftest package-nicknames.2
19  (progn
20    (set-up-packages)
21    (package-nicknames #\A))
22  ("Q"))
23
24(deftest package-nicknames.3
25  (progn
26    (set-up-packages)
27    (package-nicknames ':|A|))
28  ("Q"))
29
30(deftest package-nicknames.4
31  (progn
32    (set-up-packages)
33    (package-nicknames "B"))
34  nil)
35
36(deftest package-nicknames.5
37  (progn
38    (set-up-packages)
39    (package-nicknames #\B))
40  nil)
41
42(deftest package-nicknames.6
43  (progn
44    (set-up-packages)
45    (package-nicknames '#:|B|))
46  nil)
47
48(deftest package-nicknames.7
49  (subsetp '(#.(string '#:cl))
50           (package-nicknames "COMMON-LISP")
51           :test #'string=)
52  t)
53
54(deftest package-nicknames.8
55  (notnot
56   (subsetp '(#.(string '#:cl-user))
57            (package-nicknames "COMMON-LISP-USER")
58            :test #'string=))
59  t)
60
61(deftest package-nicknames.9
62  (signals-error (package-nicknames 10) type-error)
63  t)
64
65(deftest package-nicknames.9a
66  (signals-error (locally (package-nicknames 10) t) type-error)
67  t)
68
69(deftest package-nicknames.10
70  (progn
71    (set-up-packages)
72    (package-nicknames (find-package "A")))
73  ("Q"))
74
75(deftest package-nicknames.11
76  (handler-case
77   (locally (declare (optimize safety))
78            (eval '(package-nicknames "NOT-A-PACKAGE-NAME"))
79            nil)
80   (type-error () t)
81   (package-error () t))
82  t)
83
84;; (find-package n) == p for each n in (package-nicknames p),
85;; for any package p
86(deftest package-nicknames.12
87  (loop
88   for p in (list-all-packages) sum
89   (loop
90    for nk in (package-nicknames p) count
91         (not
92          (and (stringp nk)
93               (eqt p (find-package nk))))))
94  0)
95
96;;; Specialized sequence names tests
97
98(defmacro def-package-nicknames-test (test-name name-form)
99  `(deftest ,test-name
100     (let ((name ,name-form))
101       (safely-delete-package name)
102       (let ((p (make-package name :use nil)))
103          (package-nicknames p)))
104     nil))
105
106(def-package-nicknames-test package-nicknames.16
107  (make-array 5 :element-type 'base-char :initial-contents "TEST1"))
108
109(def-package-nicknames-test package-nicknames.17
110  (make-array 10 :element-type 'base-char
111              :fill-pointer 5
112              :initial-contents "TEST1?????"))
113
114(def-package-nicknames-test package-nicknames.18
115  (make-array 10 :element-type 'character
116              :fill-pointer 5
117              :initial-contents "TEST1?????"))
118
119(def-package-nicknames-test package-nicknames.19
120  (make-array 5 :element-type 'base-char :adjustable t
121              :initial-contents "TEST1"))
122
123(def-package-nicknames-test package-nicknames.20
124  (make-array 5 :element-type 'character :adjustable t
125              :initial-contents "TEST1"))
126
127(def-package-nicknames-test package-nicknames.21
128  (let* ((etype 'base-char)
129         (name0 (make-array 10 :element-type etype
130                            :initial-contents "XXTEST1XXX")))
131    (make-array 5 :element-type etype :displaced-to name0
132                :displaced-index-offset 2)))
133
134(def-package-nicknames-test package-nicknames.22
135  (let* ((etype 'character)
136         (name0 (make-array 10 :element-type etype
137                            :initial-contents "XXTEST1XXX")))
138    (make-array 5 :element-type etype :displaced-to name0
139                :displaced-index-offset 2)))
140
141;;; Error tests
142
143(deftest package-nicknames.error.1
144  (signals-error (package-nicknames) program-error)
145  t)
146
147(deftest package-nicknames.error.2
148  (signals-error (package-nicknames "CL" nil) program-error)
149  t)
150
151(deftest package-nicknames.error.3
152  (check-type-error #'package-nicknames #'package-designator-p)
153  nil)
154
Note: See TracBrowser for help on using the repository browser.