source: trunk/source/tests/ansi-tests/find-symbol.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; 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;; Test find-symbol, with the various combinations of
13;; package designators
14
15(deftest find-symbol.1
16  (find-symbol "aBmAchb1c")
17  nil nil)
18
19(deftest find-symbol.2
20  (find-symbol "aBmAchb1c" "CL")
21  nil nil)
22
23(deftest find-symbol.3
24  (find-symbol "aBmAchb1c" "COMMON-LISP")
25  nil nil)
26
27(deftest find-symbol.4
28  (find-symbol "aBmAchb1c" "KEYWORD")
29  nil nil)
30
31(deftest find-symbol.5
32  (find-symbol "aBmAchb1c" "COMMON-LISP-USER")
33  nil nil)
34
35(deftest find-symbol.6
36  (find-symbol (string '#:car) "CL")
37  car :external)
38
39(deftest find-symbol.7
40  (find-symbol (string '#:car) "COMMON-LISP")
41  car :external)
42
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  car :inherited)
50
51(deftest find-symbol.10
52  (find-symbol (string '#:test) "KEYWORD")
53  :test :external)
54
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  (progn
61    (set-up-packages)
62    (let ((vals (multiple-value-list (find-symbol "FOO" #\A))))
63      (values (length vals)
64              (package-name (symbol-package (first vals)))
65              (symbol-name (first vals))
66              (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    (let ((vals (multiple-value-list (find-symbol "X" #\A))))
74      (values (length vals)
75              (package-name (symbol-package (first vals)))
76              (symbol-name (first vals))
77              (second vals))))
78  2 "A" "X" :internal)
79
80(deftest find-symbol.14
81  (progn
82    (set-up-packages)
83    (let ((vals (multiple-value-list (find-symbol "FOO" #\B))))
84      (values (length vals)
85              (package-name (symbol-package (first vals)))
86              (symbol-name (first vals))
87              (second vals))))
88  2 "A" "FOO" :inherited)
89
90(deftest find-symbol.15
91  (find-symbol "FOO" "FS-B")
92  FS-A::FOO :inherited)
93
94(deftest find-symbol.16
95  (find-symbol "FOO" (find-package "FS-B"))
96  FS-A::FOO :inherited)
97
98(deftest find-symbol.17
99  (let ((name (make-array '(3) :initial-contents "FOO"
100                          :element-type 'base-char)))
101    (find-symbol name "FS-B"))
102  FS-A::FOO :inherited)
103
104(deftest find-symbol.18
105  (let ((name (make-array '(4) :initial-contents "FOOD"
106                          :element-type 'character
107                          :fill-pointer 3)))
108    (find-symbol name "FS-B"))
109  FS-A::FOO :inherited)
110
111(deftest find-symbol.19
112  (let ((name (make-array '(4) :initial-contents "FOOD"
113                          :element-type 'base-char
114                          :fill-pointer 3)))
115    (find-symbol name "FS-B"))
116  FS-A::FOO :inherited)
117
118(deftest find-symbol.20
119  (let* ((name0 (make-array '(5) :initial-contents "XFOOY"
120                            :element-type 'character))
121         (name (make-array '(3) :element-type 'character
122                           :displaced-to name0
123                           :displaced-index-offset 1)))
124    (find-symbol name "FS-B"))
125  FS-A::FOO :inherited)
126
127(deftest find-symbol.21
128  (let* ((name0 (make-array '(5) :initial-contents "XFOOY"
129                            :element-type 'base-char))
130         (name (make-array '(3) :element-type 'base-char
131                           :displaced-to name0
132                           :displaced-index-offset 1)))
133    (find-symbol name "FS-B"))
134  FS-A::FOO :inherited)
135
136(deftest find-symbol.22
137  (find-symbol "FOO" (make-array '(4) :initial-contents "FS-B" :element-type 'base-char))
138  FS-A::FOO :inherited)
139
140(deftest find-symbol.23
141  (find-symbol "FOO" (make-array '(5) :initial-contents "FS-BX"
142                                 :fill-pointer 4
143                                 :element-type 'base-char))
144  FS-A::FOO :inherited)
145
146
147
148(deftest find-symbol.order.1
149  (let ((i 0) x y)
150    (values
151     (find-symbol (progn (setf x (incf i)) (string '#:car))
152                  (progn (setf y (incf i)) "COMMON-LISP"))
153     i x y))
154  car 2 1 2)
155
156(deftest find-symbol.error.1
157  (signals-error (find-symbol) program-error)
158  t)
159
160(deftest find-symbol.error.2
161  (signals-error (find-symbol "CAR" "CL" nil) program-error)
162  t)
Note: See TracBrowser for help on using the repository browser.