Mercurial > emacs
comparison test/cedet/srecode-tests.el @ 105267:c99cf31de3f2
Add CEDET tests.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 28 Sep 2009 23:23:31 +0000 |
parents | 41dc39934483 |
children | 7f4c7f5c0eba |
comparison
equal
deleted
inserted
replaced
105266:c02e98221afe | 105267:c99cf31de3f2 |
---|---|
1 ;;; From srecode-fields: | |
2 | |
3 (require 'srecode/fields) | |
4 | |
5 (defvar srecode-field-utest-text | |
6 "This is a test buffer. | |
7 | |
8 It is filled with some text." | |
9 "Text for tests.") | |
10 | |
11 (defun srecode-field-utest () | |
12 "Test the srecode field manager." | |
13 (interactive) | |
14 (if (featurep 'xemacs) | |
15 (message "There is no XEmacs support for SRecode Fields.") | |
16 (srecode-field-utest-impl))) | |
17 | |
18 (defun srecode-field-utest-impl () | |
19 "Implementation of the SRecode field utest." | |
20 (save-excursion | |
21 (find-file "/tmp/srecode-field-test.txt") | |
22 | |
23 (erase-buffer) | |
24 (goto-char (point-min)) | |
25 (insert srecode-field-utest-text) | |
26 (set-buffer-modified-p nil) | |
27 | |
28 ;; Test basic field generation. | |
29 (let ((srecode-field-archive nil) | |
30 (f nil)) | |
31 | |
32 (end-of-line) | |
33 (forward-word -1) | |
34 | |
35 (setq f (srecode-field "Test" | |
36 :name "TEST" | |
37 :start 6 | |
38 :end 8)) | |
39 | |
40 (when (or (not (slot-boundp f 'overlay)) (not (oref f overlay))) | |
41 (error "Field test: Overlay info not created for field")) | |
42 | |
43 (when (and (overlay-p (oref f overlay)) | |
44 (not (overlay-get (oref f overlay) 'srecode-init-only))) | |
45 (error "Field creation overlay is not tagged w/ init flag")) | |
46 | |
47 (srecode-overlaid-activate f) | |
48 | |
49 (when (or (not (overlay-p (oref f overlay))) | |
50 (overlay-get (oref f overlay) 'srecode-init-only)) | |
51 (error "New field overlay not created during activation")) | |
52 | |
53 (when (not (= (length srecode-field-archive) 1)) | |
54 (error "Field test: Incorrect number of elements in the field archive")) | |
55 (when (not (eq f (car srecode-field-archive))) | |
56 (error "Field test: Field did not auto-add itself to the field archive")) | |
57 | |
58 (when (not (overlay-get (oref f overlay) 'keymap)) | |
59 (error "Field test: Overlay keymap not set")) | |
60 | |
61 (when (not (string= "is" (srecode-overlaid-text f))) | |
62 (error "Field test: Expected field text 'is', not %s" | |
63 (srecode-overlaid-text f))) | |
64 | |
65 ;; Test deletion. | |
66 (srecode-delete f) | |
67 | |
68 (when (slot-boundp f 'overlay) | |
69 (error "Field test: Overlay not deleted after object delete")) | |
70 ) | |
71 | |
72 ;; Test basic region construction. | |
73 (let* ((srecode-field-archive nil) | |
74 (reg nil) | |
75 (fields | |
76 (list | |
77 (srecode-field "Test1" :name "TEST-1" :start 5 :end 10) | |
78 (srecode-field "Test2" :name "TEST-2" :start 15 :end 20) | |
79 (srecode-field "Test3" :name "TEST-3" :start 25 :end 30) | |
80 | |
81 (srecode-field "Test4" :name "TEST-4" :start 35 :end 35)) | |
82 )) | |
83 | |
84 (when (not (= (length srecode-field-archive) 4)) | |
85 (error "Region Test: Found %d fields. Expected 4" | |
86 (length srecode-field-archive))) | |
87 | |
88 (setq reg (srecode-template-inserted-region "REG" | |
89 :start 4 | |
90 :end 40)) | |
91 | |
92 (srecode-overlaid-activate reg) | |
93 | |
94 ;; Make sure it was cleared. | |
95 (when srecode-field-archive | |
96 (error "Region Test: Did not clear field archive")) | |
97 | |
98 ;; Auto-positioning. | |
99 (when (not (eq (point) 5)) | |
100 (error "Region Test: Did not reposition on first field")) | |
101 | |
102 ;; Active region | |
103 (when (not (eq (srecode-active-template-region) reg)) | |
104 (error "Region Test: Active region not set")) | |
105 | |
106 ;; Various sizes | |
107 (mapc (lambda (T) | |
108 (if (string= (object-name-string T) "Test4") | |
109 (progn | |
110 (when (not (srecode-empty-region-p T)) | |
111 (error "Field %s is not empty" | |
112 (object-name T))) | |
113 ) | |
114 (when (not (= (srecode-region-size T) 5)) | |
115 (error "Calculated size of %s was not 5" | |
116 (object-name T))))) | |
117 fields) | |
118 | |
119 ;; Make sure things stay up after a 'command'. | |
120 (srecode-field-post-command) | |
121 (when (not (eq (srecode-active-template-region) reg)) | |
122 (error "Region Test: Active region did not stay up")) | |
123 | |
124 ;; Test field movement. | |
125 (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
126 (nth 0 fields))) | |
127 (error "Region Test: Field %s not under point" | |
128 (object-name (nth 0 fields)))) | |
129 | |
130 (srecode-field-next) | |
131 | |
132 (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
133 (nth 1 fields))) | |
134 (error "Region Test: Field %s not under point" | |
135 (object-name (nth 1 fields)))) | |
136 | |
137 (srecode-field-prev) | |
138 | |
139 (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
140 (nth 0 fields))) | |
141 (error "Region Test: Field %s not under point" | |
142 (object-name (nth 0 fields)))) | |
143 | |
144 ;; Move cursor out of the region and have everything cleaned up. | |
145 (goto-char 42) | |
146 (srecode-field-post-command) | |
147 (when (srecode-active-template-region) | |
148 (error "Region Test: Active region did not clear on move out")) | |
149 | |
150 (mapc (lambda (T) | |
151 (when (slot-boundp T 'overlay) | |
152 (error "Overlay did not clear off of of field %s" | |
153 (object-name T)))) | |
154 fields) | |
155 | |
156 ;; End of LET | |
157 ) | |
158 | |
159 ;; Test variable linkage. | |
160 (let* ((srecode-field-archive nil) | |
161 (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8)) | |
162 (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30)) | |
163 (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40)) | |
164 (reg (srecode-template-inserted-region "REG" :start 4 :end 40)) | |
165 ) | |
166 (srecode-overlaid-activate reg) | |
167 | |
168 (when (not (string= (srecode-overlaid-text f1) | |
169 (srecode-overlaid-text f2))) | |
170 (error "Linkage Test: Init strings are not =")) | |
171 (when (string= (srecode-overlaid-text f1) | |
172 (srecode-overlaid-text f3)) | |
173 (error "Linkage Test: Init string on dissimilar fields is now the same")) | |
174 | |
175 (goto-char 7) | |
176 (insert "a") | |
177 | |
178 (when (not (string= (srecode-overlaid-text f1) | |
179 (srecode-overlaid-text f2))) | |
180 (error "Linkage Test: mid-insert strings are not =")) | |
181 (when (string= (srecode-overlaid-text f1) | |
182 (srecode-overlaid-text f3)) | |
183 (error "Linkage Test: mid-insert string on dissimilar fields is now the same")) | |
184 | |
185 (goto-char 9) | |
186 (insert "t") | |
187 | |
188 (when (not (string= (srecode-overlaid-text f1) "iast")) | |
189 (error "Linkage Test: tail-insert failed to captured added char")) | |
190 (when (not (string= (srecode-overlaid-text f1) | |
191 (srecode-overlaid-text f2))) | |
192 (error "Linkage Test: tail-insert strings are not =")) | |
193 (when (string= (srecode-overlaid-text f1) | |
194 (srecode-overlaid-text f3)) | |
195 (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | |
196 | |
197 (goto-char 6) | |
198 (insert "b") | |
199 | |
200 (when (not (string= (srecode-overlaid-text f1) "biast")) | |
201 (error "Linkage Test: tail-insert failed to captured added char")) | |
202 (when (not (string= (srecode-overlaid-text f1) | |
203 (srecode-overlaid-text f2))) | |
204 (error "Linkage Test: tail-insert strings are not =")) | |
205 (when (string= (srecode-overlaid-text f1) | |
206 (srecode-overlaid-text f3)) | |
207 (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | |
208 | |
209 ;; Cleanup | |
210 (srecode-delete reg) | |
211 ) | |
212 | |
213 (set-buffer-modified-p nil) | |
214 | |
215 (message " All field tests passed.") | |
216 )) | |
217 | |
218 ;;; From srecode-document: | |
219 | |
220 (require 'srecode/doc) | |
221 | |
222 (defun srecode-document-function-comment-extract-test () | |
223 "Test old comment extraction. | |
224 Dump out the extracted dictionary." | |
225 (interactive) | |
226 | |
227 (srecode-load-tables-for-mode major-mode) | |
228 (srecode-load-tables-for-mode major-mode 'document) | |
229 | |
230 (if (not (srecode-table)) | |
231 (error "No template table found for mode %s" major-mode)) | |
232 | |
233 (let* ((temp (srecode-template-get-table (srecode-table) | |
234 "function-comment" | |
235 "declaration" | |
236 'document)) | |
237 (fcn-in (semantic-current-tag))) | |
238 | |
239 (if (not temp) | |
240 (error "No templates for function comments")) | |
241 | |
242 ;; Try to figure out the tag we want to use. | |
243 (when (or (not fcn-in) | |
244 (not (semantic-tag-of-class-p fcn-in 'function))) | |
245 (error "No tag of class 'function to insert comment for")) | |
246 | |
247 (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex)) | |
248 ) | |
249 | |
250 (when (not lextok) | |
251 (error "No comment to attempt an extraction")) | |
252 | |
253 (let ((s (semantic-lex-token-start lextok)) | |
254 (e (semantic-lex-token-end lextok)) | |
255 (extract nil)) | |
256 | |
257 (pulse-momentary-highlight-region s e) | |
258 | |
259 ;; Extract text from the existing comment. | |
260 (setq extract (srecode-extract temp s e)) | |
261 | |
262 (with-output-to-temp-buffer "*SRECODE DUMP*" | |
263 (princ "EXTRACTED DICTIONARY FOR ") | |
264 (princ (semantic-tag-name fcn-in)) | |
265 (princ "\n--------------------------------------------\n") | |
266 (srecode-dump extract)))))) |