do-symbols.lsp 3.67 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
  (equalt
   (remove-duplicates
    (sort-symbols (let ((all nil))
		    (do-symbols (x "B" all) (push x all)))))
17
18
   (list (find-symbol "BAR" "B")
	 (find-symbol "FOO" "A")))
19
20
21
22
23
24
25
  t)

;;
;; Test up some test packages
;;

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

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

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

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

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


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

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

59
;; Test that do-symbols works without a package being specified
60

61
(deftest do-symbols.7
62
63
64
65
66
67
68
69
70
71
  (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

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

88
89
90
91
92
93
94
95
96
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
;;; Specialized sequences

(defmacro def-do-symbols-test (test-name name-form)
  `(deftest ,test-name
     (let ((name ,name-form))
       (assert (string= name "B"))
       (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)))

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
;;; 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)
153

154
155
(def-macro-test do-symbols.error.1
  (do-symbols (x "CL")))