find-symbol.lsp 4.33 KB
Newer Older
1 2 3
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 25 07:49:34 1998
4
;;;; Contains: Tests for FIND-SYMBOL
5 6

(in-package :cl-test)
7

8
(compile-and-load "packages-00.lsp")
9 10

;;(declaim (optimize (safety 3)))
11 12 13 14

;; Test find-symbol, with the various combinations of
;; package designators

15
(deftest find-symbol.1
16
  (find-symbol "aBmAchb1c")
17 18
  nil nil)

19
(deftest find-symbol.2
20
  (find-symbol "aBmAchb1c" "CL")
21 22
  nil nil)

23
(deftest find-symbol.3
24
  (find-symbol "aBmAchb1c" "COMMON-LISP")
25 26
  nil nil)

27
(deftest find-symbol.4
28
  (find-symbol "aBmAchb1c" "KEYWORD")
29 30
  nil nil)

31
(deftest find-symbol.5
32
  (find-symbol "aBmAchb1c" "COMMON-LISP-USER")
33 34
  nil nil)

35
(deftest find-symbol.6
36
  (find-symbol (string '#:car) "CL")
37 38
  car :external)

39
(deftest find-symbol.7
40
  (find-symbol (string '#:car) "COMMON-LISP")
41 42
  car :external)

43
(deftest find-symbol.8
44
  (values (find-symbol (string '#:car) "COMMON-LISP-USER"))
45
  car #| :inherited |# )
46

47
(deftest find-symbol.9
48
  (find-symbol (string '#:car) "CL-TEST")
49 50
  car :inherited)

51
(deftest find-symbol.10
52
  (find-symbol (string '#:test) "KEYWORD")
53 54
  :test :external)

55
(deftest find-symbol.11
56
  (find-symbol (string '#:find-symbol.11) "CL-TEST")
57
  find-symbol.11 :internal)
58

59
(deftest find-symbol.12
60 61 62 63
  (progn
    (set-up-packages)
    (let ((vals (multiple-value-list (find-symbol "FOO" #\A))))
      (values (length vals)
sds's avatar
sds committed
64 65 66
              (package-name (symbol-package (first vals)))
              (symbol-name (first vals))
              (second vals))))
67
  2 "A" "FOO" :external)
68

69
(deftest find-symbol.13
70
  (progn
71
    (set-up-packages)
72
    (intern "X" (find-package "A"))
73 74
    (let ((vals (multiple-value-list (find-symbol "X" #\A))))
      (values (length vals)
sds's avatar
sds committed
75 76 77
              (package-name (symbol-package (first vals)))
              (symbol-name (first vals))
              (second vals))))
78
  2 "A" "X" :internal)
79

80
(deftest find-symbol.14
81 82 83 84
  (progn
    (set-up-packages)
    (let ((vals (multiple-value-list (find-symbol "FOO" #\B))))
      (values (length vals)
sds's avatar
sds committed
85 86 87
              (package-name (symbol-package (first vals)))
              (symbol-name (first vals))
              (second vals))))
88
  2 "A" "FOO" :inherited)
89

90
(deftest find-symbol.15
91 92
  (find-symbol "FOO" "FS-B")
  FS-A::FOO :inherited)
93

94
(deftest find-symbol.16
95 96
  (find-symbol "FOO" (find-package "FS-B"))
  FS-A::FOO :inherited)
97

98
(deftest find-symbol.17
99
  (let ((name (make-array '(3) :initial-contents "FOO"
sds's avatar
sds committed
100
                          :element-type 'base-char)))
101 102
    (find-symbol name "FS-B"))
  FS-A::FOO :inherited)
103

104
(deftest find-symbol.18
105
  (let ((name (make-array '(4) :initial-contents "FOOD"
sds's avatar
sds committed
106 107
                          :element-type 'character
                          :fill-pointer 3)))
108 109
    (find-symbol name "FS-B"))
  FS-A::FOO :inherited)
110

111
(deftest find-symbol.19
112
  (let ((name (make-array '(4) :initial-contents "FOOD"
sds's avatar
sds committed
113 114
                          :element-type 'base-char
                          :fill-pointer 3)))
115 116
    (find-symbol name "FS-B"))
  FS-A::FOO :inherited)
117

118
(deftest find-symbol.20
119
  (let* ((name0 (make-array '(5) :initial-contents "XFOOY"
sds's avatar
sds committed
120 121 122 123
                            :element-type 'character))
         (name (make-array '(3) :element-type 'character
                           :displaced-to name0
                           :displaced-index-offset 1)))
124 125
    (find-symbol name "FS-B"))
  FS-A::FOO :inherited)
126

127
(deftest find-symbol.21
128
  (let* ((name0 (make-array '(5) :initial-contents "XFOOY"
sds's avatar
sds committed
129 130 131 132
                            :element-type 'base-char))
         (name (make-array '(3) :element-type 'base-char
                           :displaced-to name0
                           :displaced-index-offset 1)))
133 134
    (find-symbol name "FS-B"))
  FS-A::FOO :inherited)
135 136

(deftest find-symbol.22
137 138
  (find-symbol "FOO" (make-array '(4) :initial-contents "FS-B" :element-type 'base-char))
  FS-A::FOO :inherited)
139 140

(deftest find-symbol.23
141
  (find-symbol "FOO" (make-array '(5) :initial-contents "FS-BX"
sds's avatar
sds committed
142 143
                                 :fill-pointer 4
                                 :element-type 'base-char))
144
  FS-A::FOO :inherited)
145 146 147



148 149 150
(deftest find-symbol.order.1
  (let ((i 0) x y)
    (values
151
     (find-symbol (progn (setf x (incf i)) (string '#:car))
sds's avatar
sds committed
152
                  (progn (setf y (incf i)) "COMMON-LISP"))
153 154 155
     i x y))
  car 2 1 2)

156
(deftest find-symbol.error.1
157 158
  (signals-error (find-symbol) program-error)
  t)
159 160

(deftest find-symbol.error.2
161 162
  (signals-error (find-symbol "CAR" "CL" nil) program-error)
  t)