do-symbols.lsp 4.07 KB
Newer Older
1
2
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
3
4
;;;; Created:  Sat Feb 21 18:24:59 2004
;;;; Contains: Tests of DO-SYMBOLS
5
6

(in-package :cl-test)
7
8
9

(compile-and-load "package-aux.lsp")

10
11
(declaim (optimize (safety 3)))

12
(deftest do-symbols.1
13
14
15
16
17
18
19
20
  (progn
    (set-up-packages)
    (equalt
     (remove-duplicates
      (sort-symbols (let ((all nil))
		      (do-symbols (x "B" all) (push x all)))))
     (list (find-symbol "BAR" "B")
	   (find-symbol "FOO" "A"))))
21
22
23
24
25
26
27
  t)

;;
;; Test up some test packages
;;

(defun collect-symbols (pkg)
28
29
30
31
  (remove-duplicates
   (sort-symbols
    (let ((all nil))
      (do-symbols (x pkg all) (push x all))))))
32

33
(deftest do-symbols.2
34
  (collect-symbols "DS1")
35
36
  (DS1:A DS1:B DS1::C DS1::D))

37
(deftest do-symbols.3
38
  (collect-symbols "DS2")
39
40
  (DS2:A DS2::E DS2::F DS2:G DS2:H))

41
(deftest do-symbols.4
42
  (collect-symbols "DS3")
43
44
  (DS1:A DS3:B DS2:G DS2:H DS3:I DS3:J DS3:K DS3::L DS3::M))

45
(deftest do-symbols.5
46
47
48
  (remove-duplicates
   (collect-symbols "DS4")
   :test #'(lambda (x y)
49
50
	     (and (eqt x y)
		  (not (eqt x 'DS4::B)))))
51
52
53
  (DS1:A DS1:B DS2::F DS3:G DS3:I DS3:J DS3:K DS4::X DS4::Y DS4::Z))


54
;; Test that do-symbols works without
55
56
;; a return value (and that the default return value is nil)

57
(deftest do-symbols.6
58
  (do-symbols (s "DS1") (declare (ignore s)) t)
59
60
  nil)

61
;; Test that do-symbols works without a package being specified
62

63
(deftest do-symbols.7
64
65
66
67
68
69
70
71
72
73
  (let ((x nil)
	(*package* (find-package "DS1")))
    (list
     (do-symbols (s) (push s x))
     (sort-symbols x)))
  (nil (DS1:A DS1:B DS1::C DS1::D)))

;; Test that the tags work in the tagbody,
;;  and that multiple statements work

74
(deftest do-symbols.8
75
76
77
78
79
  (handler-case
   (let ((x nil))
     (list
      (do-symbols
       (s "DS1")
80
       (when (equalt (symbol-name s) "C") (go bar))
81
82
83
       (push s x)
       (go foo)
       bar
84
       (push t x)
85
86
87
88
89
       foo)
      (sort-symbols x)))
   (error (c) c))
  (NIL (DS1:A DS1:B DS1::D T)))

90
91
92
93
94
95
;;; Specialized sequences

(defmacro def-do-symbols-test (test-name name-form)
  `(deftest ,test-name
     (let ((name ,name-form))
       (assert (string= name "B"))
96
       (set-up-packages)
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
       (equalt
	(remove-duplicates
	 (sort-symbols (let ((all nil))
			 (do-symbols (x name all) (push x all)))))
	(list (find-symbol "BAR" "B")
	      (find-symbol "FOO" "A"))))
     t))

(def-do-symbols-test do-symbols.9
  (make-array 1 :element-type 'base-char :initial-contents "B"))

(def-do-symbols-test do-symbols.10
  (make-array 5 :element-type 'character
	      :fill-pointer 1
	      :initial-contents "BXXXX"))

(def-do-symbols-test do-symbols.11
  (make-array 5 :element-type 'base-char
	      :fill-pointer 1
	      :initial-contents "BXXXX"))

(def-do-symbols-test do-symbols.12
  (make-array 1 :element-type 'base-char
	      :adjustable t :initial-contents "B"))

(def-do-symbols-test do-symbols.13
  (make-array 1 :element-type 'character
	      :adjustable t :initial-contents "B"))

(def-do-symbols-test do-symbols.14
  (let* ((etype 'base-char)
	 (name0 (make-array 4 :element-type etype :initial-contents "XBYZ")))
    (make-array 1 :element-type etype
		:displaced-to name0 :displaced-index-offset 1)))

(def-do-symbols-test do-symbols.15
  (let* ((etype 'character)
	 (name0 (make-array 4 :element-type etype :initial-contents "XBYZ")))
    (make-array 1 :element-type etype
		:displaced-to name0 :displaced-index-offset 1)))

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
;;; Free declaration scope tests

(deftest do-symbols.16
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good))
	(do-symbols (s (return-from done x))
	  (declare (special x))))))
  :good)

(deftest do-symbols.17
  (let ((x :good))
    (declare (special x))
    (let ((x :bad))
      (do-symbols (s "CL-TEST" x)
	(declare (special x)))))
  :good)
156

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest do-symbols.18
  (macrolet
   ((%m (z) z))
   (do-symbols (s (expand-in-current-env (%m "CL-TEST")) :good)))
  :good)

(deftest do-symbols.19
  (macrolet
   ((%m (z) z))
   (do-symbols (s "CL-TEST" (expand-in-current-env (%m :good)))))
  :good)

172
173
(def-macro-test do-symbols.error.1
  (do-symbols (x "CL")))