rename-package.lsp 8.25 KB
Newer Older
1 2 3
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 25 08:00:28 1998
4
;;;; Contains: Tests of RENAME-PACKAGE
5 6 7 8 9 10 11

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rename-package

12
(deftest rename-package.1
13 14 15
  (block nil
    (safely-delete-package "TEST1")
    (safely-delete-package "TEST2")
16
    (let ((p (make-package "TEST1"))
sds's avatar
sds committed
17
          (i 0) x y)
18
      (unless (packagep p) (return nil))
19
      (let ((p2 (rename-package (progn (setf x (incf i)) "TEST1")
sds's avatar
sds committed
20 21 22 23 24 25 26 27 28 29 30 31 32 33
                                (progn (setf y (incf i)) "TEST2"))))
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (eql i 2)
                     (eql x 1)
                     (eql y 2)
                     (equal (package-name p2) "TEST2"))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (safely-delete-package p2)
        t)))
34 35
  t)

36
(deftest rename-package.2
37 38 39 40 41 42 43
  (block nil
    (safely-delete-package "TEST1")
    (safely-delete-package "TEST2")
    (safely-delete-package "TEST3")
    (safely-delete-package "TEST4")
    (safely-delete-package "TEST5")
    (let ((p (make-package "TEST1"))
sds's avatar
sds committed
44
          (nicknames (copy-list '("TEST3" "TEST4" "TEST5"))))
45 46
      (unless (packagep p) (return nil))
      (let ((p2 (rename-package "TEST1" "TEST2" nicknames)))
sds's avatar
sds committed
47 48 49 50 51 52 53 54 55 56 57 58 59
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (equal (package-name p2) "TEST2")
                     (null (set-exclusive-or nicknames
                                             (package-nicknames p2)
                                             :test #'equal)))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (safely-delete-package p2)
        t)))
60 61
  t)

62
(deftest rename-package.3
63 64 65 66
  (block nil
    (safely-delete-package "TEST1")
    (safely-delete-package "TEST2")
    (let ((p (make-package "TEST1"))
sds's avatar
sds committed
67
          (nicknames (copy-list '(#\M #\N))))
68 69
      (unless (packagep p) (return nil))
      (let ((p2 (ignore-errors (rename-package "TEST1" "TEST2" nicknames))))
sds's avatar
sds committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (equal (package-name p2) "TEST2")
                     (equal
                      (sort (copy-list (package-nicknames p2))
                            #'string<)
                      (sort (mapcar #'(lambda (c)
                                        (make-string 1 :initial-element c))
                                    nicknames)
                            #'string<)))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (safely-delete-package p2)
        t)))
87 88
  t)

89
(deftest rename-package.4
90 91 92 93
  (block nil
    (safely-delete-package "G")
    (safely-delete-package "TEST2")
    (let ((p (make-package "G"))
sds's avatar
sds committed
94
          (nicknames nil))
95 96
      (unless (packagep p) (return nil))
      (let ((p2 (ignore-errors (rename-package #\G "TEST2" nicknames))))
sds's avatar
sds committed
97 98 99 100 101 102 103 104 105 106 107 108 109
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (equal (package-name p2) "TEST2")
                     (null (set-exclusive-or nicknames
                                             (package-nicknames p2)
                                             :test #'equal)))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (ignore-errors (safely-delete-package p2))
        t)))
110 111
  t)

112
(deftest rename-package.5
113 114 115 116
  (block nil
    (safely-delete-package "TEST1")
    (safely-delete-package "G")
    (let ((p (make-package "TEST1"))
sds's avatar
sds committed
117
          (nicknames nil))
118 119
      (unless (packagep p) (return nil))
      (let ((p2 (ignore-errors (rename-package "TEST1" #\G nicknames))))
sds's avatar
sds committed
120 121 122 123 124 125 126 127 128 129 130 131 132
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (equal (package-name p2) "G")
                     (null (set-exclusive-or nicknames
                                             (package-nicknames p2)
                                             :test #'equal)))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (safely-delete-package p2)
        t)))
133 134
  t)

135
(deftest rename-package.6
136 137 138 139 140 141
  (block nil
    (safely-delete-package '|TEST1|)
    (safely-delete-package '|TEST2|)
    (safely-delete-package '|M|)
    (safely-delete-package '|N|)
    (let ((p (make-package '|TEST1|))
sds's avatar
sds committed
142
          (nicknames (copy-list '(|M| |N|))))
143 144
      (unless (packagep p) (return nil))
      (let ((p2 (ignore-errors (rename-package
sds's avatar
sds committed
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
                                '|TEST1| '|TEST2| nicknames))))
        (unless (packagep p2)
          (safely-delete-package p)
          (return p2))
        (unless (and (eqt p p2)
                     (equal (package-name p2) "TEST2")
                     (equal
                      (sort (copy-list (package-nicknames p2))
                            #'string<)
                      (sort (mapcar #'symbol-name nicknames)
                            #'string<)))
          (safely-delete-package p)
          (safely-delete-package p2)
          (return nil))
        (safely-delete-package p2)
        t)))
161
  t)
162

163 164 165
(deftest rename-package.7
  (block nil
    (let ((name1 (make-array '(5) :element-type 'base-char
sds's avatar
sds committed
166 167 168
                             :initial-contents "TEST1"))
          (name2 (make-array '(5) :element-type 'base-char
                             :initial-contents "TEST2")))
169 170 171
      (safely-delete-package name1)
      (safely-delete-package name2)
      (let ((p (make-package name1)))
sds's avatar
sds committed
172 173 174 175 176 177 178 179 180 181 182 183
        (unless (packagep p) (return nil))
        (let ((p2 (rename-package name1 name2)))
          (unless (packagep p2)
            (safely-delete-package p)
            (return p2))
          (unless (and (eqt p p2)
                       (equal (package-name p2) name2))
            (safely-delete-package p)
            (safely-delete-package p2)
            (return nil))
          (safely-delete-package p2)
          t))))
184 185 186 187 188
  t)

(deftest rename-package.8
  (block nil
    (let ((name1 (make-array '(10) :element-type 'base-char
sds's avatar
sds committed
189 190 191 192 193
                             :fill-pointer 5
                             :initial-contents "TEST1     "))
          (name2 (make-array '(9) :element-type 'character
                             :fill-pointer 5
                             :initial-contents "TEST2XXXX")))
194 195 196
      (safely-delete-package name1)
      (safely-delete-package name2)
      (let ((p (make-package "TEST1")))
sds's avatar
sds committed
197 198 199 200 201 202 203 204 205 206 207 208
        (unless (packagep p) (return nil))
        (let ((p2 (rename-package name1 name2)))
          (unless (packagep p2)
            (safely-delete-package p)
            (return p2))
          (unless (and (eqt p p2)
                       (string= (package-name p2) "TEST2"))
            (safely-delete-package p)
            (safely-delete-package p2)
            (return nil))
          (safely-delete-package p2)
          t))))
209 210 211 212 213
  t)

(deftest rename-package.9
  (block nil
    (let ((name1 (make-array '(5) :element-type 'character
sds's avatar
sds committed
214 215 216 217 218
                             :adjustable t
                             :initial-contents "TEST1"))
          (name2 (make-array '(5) :element-type 'base-char
                             :adjustable t
                             :initial-contents "TEST2")))
219 220 221
      (safely-delete-package name1)
      (safely-delete-package name2)
      (let ((p (make-package "TEST1")))
sds's avatar
sds committed
222 223 224 225 226 227 228 229 230 231 232 233
        (unless (packagep p) (return nil))
        (let ((p2 (rename-package name1 name2)))
          (unless (packagep p2)
            (safely-delete-package p)
            (return p2))
          (unless (and (eqt p p2)
                       (string= (package-name p2) "TEST2"))
            (safely-delete-package p)
            (safely-delete-package p2)
            (return nil))
          (safely-delete-package p2)
          t))))
234 235 236 237
  t)



238
(deftest rename-package.error.1
239 240
  (signals-error (rename-package) program-error)
  t)
241 242

(deftest rename-package.error.2
243 244
  (signals-error (rename-package "CL") program-error)
  t)
245 246

(deftest rename-package.error.3
247 248
  (signals-error (rename-package "A" "XXXXX" NIL NIL) program-error)
  t)