package-nicknames.lsp 3.51 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 25 07:51:26 1998
;;;; Contains: Tests of PACKAGE-NICKNAMES

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; package-nicknames

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

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

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

(deftest package-nicknames.4
pfdietz's avatar
pfdietz committed
31
32
33
  (progn
    (set-up-packages)
    (package-nicknames "B"))
34
35
36
  nil)

(deftest package-nicknames.5
pfdietz's avatar
pfdietz committed
37
38
39
  (progn
    (set-up-packages)
    (package-nicknames #\B))
40
41
42
  nil)

(deftest package-nicknames.6
pfdietz's avatar
pfdietz committed
43
44
45
  (progn
    (set-up-packages)
    (package-nicknames '#:|B|))
46
47
48
  nil)

(deftest package-nicknames.7
pfdietz's avatar
pfdietz committed
49
50
51
  (subsetp '(#.(string '#:cl))
	   (package-nicknames "COMMON-LISP")
	   :test #'string=)
52
53
54
  t)

(deftest package-nicknames.8
pfdietz's avatar
pfdietz committed
55
56
57
58
  (notnot
   (subsetp '(#.(string '#:cl-user))
	    (package-nicknames "COMMON-LISP-USER")
	    :test #'string=))
59
60
61
62
63
64
65
66
67
68
69
  t)

(deftest package-nicknames.9
  (signals-error (package-nicknames 10) type-error)
  t)

(deftest package-nicknames.9a
  (signals-error (locally (package-nicknames 10) t) type-error)
  t)

(deftest package-nicknames.10
pfdietz's avatar
pfdietz committed
70
71
72
  (progn
    (set-up-packages)
    (package-nicknames (find-package "A")))
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
  ("Q"))

(deftest package-nicknames.11
  (handler-case
   (locally (declare (optimize safety))
	    (eval '(package-nicknames "NOT-A-PACKAGE-NAME"))
	    nil)
   (type-error () t)
   (package-error () t))
  t)

;; (find-package n) == p for each n in (package-nicknames p),
;; for any package p
(deftest package-nicknames.12
  (loop
   for p in (list-all-packages) sum
   (loop
    for nk in (package-nicknames p) count
	 (not
	  (and (stringp nk)
	       (eqt p (find-package nk))))))
  0)

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
;;; Specialized sequence names tests

(defmacro def-package-nicknames-test (test-name name-form)
  `(deftest ,test-name
     (let ((name ,name-form))
       (safely-delete-package name)
       (let ((p (make-package name :use nil)))
	  (package-nicknames p)))
     nil))

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

(def-package-nicknames-test package-nicknames.17
  (make-array 10 :element-type 'base-char
	      :fill-pointer 5
	      :initial-contents "TEST1?????"))

(def-package-nicknames-test package-nicknames.18
  (make-array 10 :element-type 'character
	      :fill-pointer 5
	      :initial-contents "TEST1?????"))

(def-package-nicknames-test package-nicknames.19
  (make-array 5 :element-type 'base-char :adjustable t
	      :initial-contents "TEST1"))

(def-package-nicknames-test package-nicknames.20
  (make-array 5 :element-type 'character :adjustable t
	      :initial-contents "TEST1"))

(def-package-nicknames-test package-nicknames.21
  (let* ((etype 'base-char)
	 (name0 (make-array 10 :element-type etype
			    :initial-contents "XXTEST1XXX")))
    (make-array 5 :element-type etype :displaced-to name0
		:displaced-index-offset 2)))

(def-package-nicknames-test package-nicknames.22
  (let* ((etype 'character)
	 (name0 (make-array 10 :element-type etype
			    :initial-contents "XXTEST1XXX")))
    (make-array 5 :element-type etype :displaced-to name0
		:displaced-index-offset 2)))

;;; Error tests

143
144
145
146
147
148
149
(deftest package-nicknames.error.1
  (signals-error (package-nicknames) program-error)
  t)

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