package-name.lsp 4.35 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Feb 21 17:48:05 2004
;;;; Contains: Tests of PACKAGE-NAME

(in-package :cl-test)
(declaim (optimize (safety 3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-name

(deftest package-name.1
pfdietz's avatar
pfdietz committed
13
14
15
  (progn
    (set-up-packages)
    (package-name "A"))
16
17
18
  "A")

(deftest package-name.2
pfdietz's avatar
pfdietz committed
19
20
21
  (progn
    (set-up-packages)
    (package-name #\A))
22
23
24
  "A")

(deftest package-name.3
pfdietz's avatar
pfdietz committed
25
26
27
  (progn
    (set-up-packages)
    (package-name "Q"))
28
29
30
  "A")

(deftest package-name.4
pfdietz's avatar
pfdietz committed
31
32
33
  (progn
    (set-up-packages)
    (package-name #\Q))
34
35
36
37
38
  "A")

(deftest package-name.5
  (handler-case
   (locally (declare (optimize safety))
sds's avatar
sds committed
39
40
            (eval '(package-name "NOT-THERE"))
            nil)
41
42
43
44
45
46
47
   (type-error () t)
   (package-error () t))
  t)

(deftest package-name.6
  (handler-case
   (locally (declare (optimize safety))
sds's avatar
sds committed
48
49
            (eval '(package-name #\*))
            nil)
50
51
52
53
54
55
56
   (type-error () t)
   (package-error () t))
  t)

(deftest package-name.6a
  (handler-case
   (locally (declare (optimize safety))
sds's avatar
sds committed
57
58
            (eval '(locally (package-name #\*) t))
            nil)
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
   (type-error () t)
   (package-error () t))
  t)

(deftest package-name.7
  (package-name "CL")
  #.(string '#:common-lisp))

(deftest package-name.8
  (package-name "COMMON-LISP")
  #.(string '#:common-lisp))

(deftest package-name.9
  (package-name "COMMON-LISP-USER")
  #.(string '#:common-lisp-user))

(deftest package-name.10
  (package-name "CL-USER")
  #.(string '#:common-lisp-user))

(deftest package-name.11
  (package-name "KEYWORD")
  #.(string '#:keyword))

(deftest package-name.12
  (package-name (find-package "CL"))
  #.(string '#:common-lisp))

(deftest package-name.13
  (let* ((p (make-package "TEMP1"))
sds's avatar
sds committed
89
         (pname1 (package-name p)))
90
91
92
93
94
95
96
97
98
99
100
101
102
    (rename-package "TEMP1" "TEMP2")
    (let ((pname2 (package-name p)))
      (safely-delete-package p)
      (list pname1 pname2 (package-name p))))
  ("TEMP1" "TEMP2" nil))

;; (find-package (package-name p)) == p for any package p
(deftest package-name.14
  (loop
   for p in (list-all-packages) count
   (not
    (let ((name (package-name p)))
      (and (stringp name)
sds's avatar
sds committed
103
           (eqt (find-package name) p)))))
104
105
106
107
108
109
110
111
  0)

;; package-name applied to a package's name
;; should return an equal string
(deftest package-name.15
  (loop
   for p in (list-all-packages) count
   (not (equal (package-name p)
sds's avatar
sds committed
112
               (package-name (package-name p)))))
113
114
  0)

115
116
117
118
119
;;; Specialized sequence tests

(defmacro def-package-name-test (test-name name-form expected-name-form)
  `(deftest ,test-name
     (let ((name ,name-form)
sds's avatar
sds committed
120
           (expected-name ,expected-name-form))
121
122
123
       (assert (string= name expected-name))
       (safely-delete-package name)
       (let ((p (make-package name :use nil)))
sds's avatar
sds committed
124
         (equalt (package-name p) expected-name)))
125
126
127
128
129
130
131
132
     t))

(def-package-name-test package-name.16
  (make-array 5 :element-type 'base-char :initial-contents "TEST1")
  "TEST1")

(def-package-name-test package-name.17
  (make-array 10 :element-type 'base-char
sds's avatar
sds committed
133
134
              :fill-pointer 5
              :initial-contents "TEST1?????")
135
136
137
138
  "TEST1")

(def-package-name-test package-name.18
  (make-array 10 :element-type 'character
sds's avatar
sds committed
139
140
              :fill-pointer 5
              :initial-contents "TEST1?????")
141
142
143
144
  "TEST1")

(def-package-name-test package-name.19
  (make-array 5 :element-type 'base-char :adjustable t
sds's avatar
sds committed
145
              :initial-contents "TEST1")
146
147
148
149
  "TEST1")

(def-package-name-test package-name.20
  (make-array 5 :element-type 'character :adjustable t
sds's avatar
sds committed
150
              :initial-contents "TEST1")
151
152
153
154
  "TEST1")

(def-package-name-test package-name.21
  (let* ((etype 'base-char)
sds's avatar
sds committed
155
156
         (name0 (make-array 10 :element-type etype
                            :initial-contents "XXTEST1XXX")))
157
    (make-array 5 :element-type etype :displaced-to name0
sds's avatar
sds committed
158
                :displaced-index-offset 2))
159
160
161
162
  "TEST1")

(def-package-name-test package-name.22
  (let* ((etype 'character)
sds's avatar
sds committed
163
164
         (name0 (make-array 10 :element-type etype
                            :initial-contents "XXTEST1XXX")))
165
    (make-array 5 :element-type etype :displaced-to name0
sds's avatar
sds committed
166
                :displaced-index-offset 2))
167
168
169
  "TEST1")


170
171
172
173
174
175
176
177
(deftest package-name.error.1
  (signals-error (package-name) program-error)
  t)

(deftest package-name.error.2
  (signals-error (package-name "CL" nil) program-error)
  t)

pfdietz's avatar
pfdietz committed
178
179
180
(deftest package-name.error.3
  (check-type-error #'package-name #'package-designator-p)
  nil)