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)