source: trunk/source/tests/ansi-tests/package-name.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: 4.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 21 17:48:05 2004
4;;;; Contains: Tests of PACKAGE-NAME
5
6(in-package :cl-test)
7(declaim (optimize (safety 3)))
8
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10;;; package-name
11
12(deftest package-name.1
13  (progn
14    (set-up-packages)
15    (package-name "A"))
16  "A")
17
18(deftest package-name.2
19  (progn
20    (set-up-packages)
21    (package-name #\A))
22  "A")
23
24(deftest package-name.3
25  (progn
26    (set-up-packages)
27    (package-name "Q"))
28  "A")
29
30(deftest package-name.4
31  (progn
32    (set-up-packages)
33    (package-name #\Q))
34  "A")
35
36(deftest package-name.5
37  (handler-case
38   (locally (declare (optimize safety))
39            (eval '(package-name "NOT-THERE"))
40            nil)
41   (type-error () t)
42   (package-error () t))
43  t)
44
45(deftest package-name.6
46  (handler-case
47   (locally (declare (optimize safety))
48            (eval '(package-name #\*))
49            nil)
50   (type-error () t)
51   (package-error () t))
52  t)
53
54(deftest package-name.6a
55  (handler-case
56   (locally (declare (optimize safety))
57            (eval '(locally (package-name #\*) t))
58            nil)
59   (type-error () t)
60   (package-error () t))
61  t)
62
63(deftest package-name.7
64  (package-name "CL")
65  #.(string '#:common-lisp))
66
67(deftest package-name.8
68  (package-name "COMMON-LISP")
69  #.(string '#:common-lisp))
70
71(deftest package-name.9
72  (package-name "COMMON-LISP-USER")
73  #.(string '#:common-lisp-user))
74
75(deftest package-name.10
76  (package-name "CL-USER")
77  #.(string '#:common-lisp-user))
78
79(deftest package-name.11
80  (package-name "KEYWORD")
81  #.(string '#:keyword))
82
83(deftest package-name.12
84  (package-name (find-package "CL"))
85  #.(string '#:common-lisp))
86
87(deftest package-name.13
88  (let* ((p (make-package "TEMP1"))
89         (pname1 (package-name p)))
90    (rename-package "TEMP1" "TEMP2")
91    (let ((pname2 (package-name p)))
92      (safely-delete-package p)
93      (list pname1 pname2 (package-name p))))
94  ("TEMP1" "TEMP2" nil))
95
96;; (find-package (package-name p)) == p for any package p
97(deftest package-name.14
98  (loop
99   for p in (list-all-packages) count
100   (not
101    (let ((name (package-name p)))
102      (and (stringp name)
103           (eqt (find-package name) p)))))
104  0)
105
106;; package-name applied to a package's name
107;; should return an equal string
108(deftest package-name.15
109  (loop
110   for p in (list-all-packages) count
111   (not (equal (package-name p)
112               (package-name (package-name p)))))
113  0)
114
115;;; Specialized sequence tests
116
117(defmacro def-package-name-test (test-name name-form expected-name-form)
118  `(deftest ,test-name
119     (let ((name ,name-form)
120           (expected-name ,expected-name-form))
121       (assert (string= name expected-name))
122       (safely-delete-package name)
123       (let ((p (make-package name :use nil)))
124         (equalt (package-name p) expected-name)))
125     t))
126
127(def-package-name-test package-name.16
128  (make-array 5 :element-type 'base-char :initial-contents "TEST1")
129  "TEST1")
130
131(def-package-name-test package-name.17
132  (make-array 10 :element-type 'base-char
133              :fill-pointer 5
134              :initial-contents "TEST1?????")
135  "TEST1")
136
137(def-package-name-test package-name.18
138  (make-array 10 :element-type 'character
139              :fill-pointer 5
140              :initial-contents "TEST1?????")
141  "TEST1")
142
143(def-package-name-test package-name.19
144  (make-array 5 :element-type 'base-char :adjustable t
145              :initial-contents "TEST1")
146  "TEST1")
147
148(def-package-name-test package-name.20
149  (make-array 5 :element-type 'character :adjustable t
150              :initial-contents "TEST1")
151  "TEST1")
152
153(def-package-name-test package-name.21
154  (let* ((etype 'base-char)
155         (name0 (make-array 10 :element-type etype
156                            :initial-contents "XXTEST1XXX")))
157    (make-array 5 :element-type etype :displaced-to name0
158                :displaced-index-offset 2))
159  "TEST1")
160
161(def-package-name-test package-name.22
162  (let* ((etype 'character)
163         (name0 (make-array 10 :element-type etype
164                            :initial-contents "XXTEST1XXX")))
165    (make-array 5 :element-type etype :displaced-to name0
166                :displaced-index-offset 2))
167  "TEST1")
168
169
170(deftest package-name.error.1
171  (signals-error (package-name) program-error)
172  t)
173
174(deftest package-name.error.2
175  (signals-error (package-name "CL" nil) program-error)
176  t)
177
178(deftest package-name.error.3
179  (check-type-error #'package-name #'package-designator-p)
180  nil)
Note: See TracBrowser for help on using the repository browser.