find-package.lsp 3.77 KB
Newer Older
1 2 3
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 25 07:50:39 1998
4
;;;; Contains: Tests for FIND-PACKAGE
5

6

7 8 9 10 11
(declaim (optimize (safety 3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; find-package

12 13
(deftest find-package.1
  (let ((p (find-package "CL"))
sds's avatar
sds committed
14
        (p2 (find-package "COMMON-LISP")))
15
    (and p p2 (eqt p p2)))
16 17
  t)

18 19
(deftest find-package.2
  (let ((p (find-package "CL-USER"))
sds's avatar
sds committed
20
        (p2 (find-package "COMMON-LISP-USER")))
21
    (and p p2 (eqt p p2)))
22 23
  t)

24 25 26
(deftest find-package.3
  (let ((p (find-package "KEYWORD")))
    (and p (eqt p (symbol-package :test))))
27 28
  t)

29
(deftest find-package.4
30 31 32 33
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package "A"))))
      (if (packagep p)
sds's avatar
sds committed
34 35
          t
        p)))
36 37
  t)

38
(deftest find-package.5
39 40 41 42
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package #\A))))
      (if (packagep p)
sds's avatar
sds committed
43 44
          t
        p)))
45 46
  t)

47
(deftest find-package.6
48 49 50 51
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package "B"))))
      (if (packagep p)
sds's avatar
sds committed
52 53
          t
        p)))
54 55
  t)

56
(deftest find-package.7
57 58 59 60
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package #\B))))
      (if (packagep p)
sds's avatar
sds committed
61 62
          t
        p)))
63 64
  t)

65
(deftest find-package.8
66 67 68
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package "Q")))
sds's avatar
sds committed
69
          (p2 (ignore-errors (find-package "A"))))
70
      (and (packagep p)
sds's avatar
sds committed
71 72
           (packagep p2)
           (eqt p p2))))
73 74
  t)

75
(deftest find-package.9
76 77 78
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package "A")))
sds's avatar
sds committed
79
          (p2 (ignore-errors (find-package "B"))))
80
      (eqt p p2)))
81 82
  nil)

83
(deftest find-package.10
84 85 86
  (progn
    (set-up-packages)
    (let ((p (ignore-errors (find-package #\Q)))
sds's avatar
sds committed
87
          (p2 (ignore-errors (find-package "Q"))))
88
      (and (packagep p)
sds's avatar
sds committed
89
           (eqt p p2))))
90 91
  t)

92 93
(deftest find-package.11
  (let* ((cl (find-package "CL"))
sds's avatar
sds committed
94
         (cl2 (find-package cl)))
95
    (and (packagep cl)
sds's avatar
sds committed
96
         (eqt cl cl2)))
97 98
  t)

99 100
(deftest find-package.12
  (let* ((name (make-array '(7) :initial-contents "KEYWORD"
sds's avatar
sds committed
101 102
                           :element-type 'base-char))
         (p (find-package name)))
103 104 105 106 107
    (and p (eqt p (symbol-package :test))))
  t)

(deftest find-package.13
  (let* ((name (make-array '(10) :initial-contents "KEYWORDXYZ"
sds's avatar
sds committed
108 109 110
                           :fill-pointer 7
                           :element-type 'base-char))
         (p (find-package name)))
111 112 113 114 115
    (and p (eqt p (symbol-package :test))))
  t)

(deftest find-package.14
  (let* ((name (make-array '(10) :initial-contents "KEYWORDXYZ"
sds's avatar
sds committed
116 117 118
                           :fill-pointer 7
                           :element-type 'character))
         (p (find-package name)))
119 120 121 122 123
    (and p (eqt p (symbol-package :test))))
  t)

(deftest find-package.15
  (let* ((name0 (make-array '(10) :initial-contents "XYKEYWORDZ"
sds's avatar
sds committed
124 125 126 127
                            :element-type 'character))
         (name (make-array '(7) :displaced-to name0 :displaced-index-offset 2
                           :element-type 'character))
         (p (find-package name)))
128 129 130 131
    (and p (eqt p (symbol-package :test))))
  t)

(deftest find-package.16
pfdietz's avatar
pfdietz committed
132
  (let* ((name (make-array '(7) :initial-contents "KEYWORD"
sds's avatar
sds committed
133 134 135
                           :adjustable t
                           :element-type 'base-char))
         (p (find-package name)))
136 137 138 139
    (and p (eqt p (symbol-package :test))))
  t)

(deftest find-package.17
pfdietz's avatar
pfdietz committed
140
  (let* ((name (make-array '(7) :initial-contents "KEYWORD"
sds's avatar
sds committed
141 142 143
                           :adjustable t
                           :element-type 'character))
         (p (find-package name)))
144 145 146 147 148
    (and p (eqt p (symbol-package :test))))
  t)

;;; Error tests

149
(deftest find-package.error.1
150 151
  (signals-error (find-package) program-error)
  t)
152

153
(deftest find-package.error.2
154 155
  (signals-error (find-package "CL" nil) program-error)
  t)