source: trunk/source/tests/ansi-tests/do-external-symbols.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: 3.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 21 18:26:08 2004
4;;;; Contains: Tests of DO-EXTERNAL-SYMBOLS
5
6(in-package :cl-test)
7
8(compile-and-load "package-aux.lsp")
9
10(declaim (optimize (safety 3)))
11
12(defun collect-external-symbols (pkg)
13  (remove-duplicates
14   (sort-symbols
15    (let ((all nil))
16      (do-external-symbols (x pkg all) (push x all))))))
17
18(deftest do-external-symbols.1
19    (collect-external-symbols "DS1")
20  (DS1:A DS1:B))
21
22(deftest do-external-symbols.2
23    (collect-external-symbols "DS2")
24  (DS2:A DS2:G DS2:H))
25
26(deftest do-external-symbols.3
27    (collect-external-symbols "DS3")
28  (DS1:A DS3:B DS2:G DS3:I DS3:J DS3:K))
29
30(deftest do-external-symbols.4
31    (collect-external-symbols "DS4")
32  ())
33
34(deftest do-external-symbols.5
35    (equalt (collect-external-symbols "KEYWORD")
36            (collect-symbols "KEYWORD"))
37  t)
38
39;; Test that do-external-symbols works without
40;; a return value (and that the default return value is nil)
41
42(deftest do-external-symbols.6
43  (do-external-symbols (s "DS1") (declare (ignore s)) t)
44  nil)
45
46;; Test that do-external-symbols works without
47;; a package being specified
48
49(deftest do-external-symbols.7
50  (let ((x nil)
51        (*package* (find-package "DS1")))
52    (list
53     (do-external-symbols (s) (push s x))
54     (sort-symbols x)))
55  (nil (DS1:A DS1:B)))
56
57;; Test that the tags work in the tagbody,
58;;  and that multiple statements work
59
60(deftest do-external-symbols.8
61  (handler-case
62   (let ((x nil))
63     (list
64      (do-external-symbols
65       (s "DS1")
66       (when (equalt (symbol-name s) "A") (go bar))
67       (push s x)
68       (go foo)
69       bar
70       (push t x)
71       foo)
72      (sort-symbols x)))
73   (error (c) c))
74  (NIL (DS1:B T)))
75
76;;; Specialized sequence tests
77
78(defmacro def-do-external-symbols-test (test-name name-form)
79  `(deftest ,test-name
80     (collect-external-symbols ,name-form)
81     (DS1:A DS1:B)))
82
83(def-do-external-symbols-test do-external-symbols.9
84  (make-array 3 :element-type 'base-char :initial-contents "DS1"))
85
86(def-do-external-symbols-test do-external-symbols.10
87  (make-array 6 :element-type 'base-char :initial-contents "DS1XXX"
88              :fill-pointer 3))
89
90(def-do-external-symbols-test do-external-symbols.11
91  (make-array 6 :element-type 'character :initial-contents "DS1XXX"
92              :fill-pointer 3))
93
94(def-do-external-symbols-test do-external-symbols.12
95  (make-array 3 :element-type 'base-char :initial-contents "DS1"
96              :adjustable t))
97
98(def-do-external-symbols-test do-external-symbols.13
99  (make-array 3 :element-type 'character :initial-contents "DS1"
100              :adjustable t))
101
102(def-do-external-symbols-test do-external-symbols.14
103  (let* ((etype 'base-char)
104         (name0 (make-array 6 :element-type etype :initial-contents "XDS1XX")))
105    (make-array 3 :element-type etype
106                :displaced-to name0 :displaced-index-offset 1)))
107
108(def-do-external-symbols-test do-external-symbols.15
109  (let* ((etype 'character)
110         (name0 (make-array 6 :element-type etype :initial-contents "XDS1XX")))
111    (make-array 3 :element-type etype
112                :displaced-to name0 :displaced-index-offset 1)))
113
114;;; Free declaration scope tests
115
116(deftest do-external-symbols.16
117  (block done
118    (let ((x :bad))
119      (declare (special x))
120      (let ((x :good))
121        (do-external-symbols (s (return-from done x))
122          (declare (special x))))))
123  :good)
124
125(deftest do-external-symbols.17
126  (let ((x :good))
127    (declare (special x))
128    (let ((x :bad))
129      (do-external-symbols (s "CL-TEST" x)
130        (declare (special x)))))
131  :good)
132
133;;; Test that explicit calls to macroexpand in subforms
134;;; are done in the correct environment
135
136(deftest do-external-symbols.18
137  (macrolet
138   ((%m (z) z))
139   (do-external-symbols (s (expand-in-current-env (%m "CL-TEST")) :good)))
140  :good)
141
142(deftest do-external-symbols.19
143  (macrolet
144   ((%m (z) z))
145   (do-external-symbols (s "CL-TEST" (expand-in-current-env (%m :good)))))
146  :good)
147
148;;; Error tests
149
150(def-macro-test do-external-symbols.error.1
151  (do-external-symbols (x "CL")))
Note: See TracBrowser for help on using the repository browser.