Commit | Line | Data |
---|---|---|
2c21a6e2 GM |
1 | ;;; srecode-tests.el --- Some tests for CEDET's srecode |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2008-2014 Free Software Foundation, Inc. |
2c21a6e2 GM |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ||
24 | ;; Extracted from srecode-fields.el and srecode-document.el in the | |
25 | ;; CEDET distribution. | |
26 | ||
27 | ;;; Code: | |
28 | ||
74ea13c1 CY |
29 | ;;; From srecode-fields: |
30 | ||
31 | (require 'srecode/fields) | |
32 | ||
33 | (defvar srecode-field-utest-text | |
34 | "This is a test buffer. | |
35 | ||
36 | It is filled with some text." | |
37 | "Text for tests.") | |
38 | ||
39 | (defun srecode-field-utest () | |
40 | "Test the srecode field manager." | |
41 | (interactive) | |
42 | (if (featurep 'xemacs) | |
43 | (message "There is no XEmacs support for SRecode Fields.") | |
44 | (srecode-field-utest-impl))) | |
45 | ||
46 | (defun srecode-field-utest-impl () | |
47 | "Implementation of the SRecode field utest." | |
48 | (save-excursion | |
49 | (find-file "/tmp/srecode-field-test.txt") | |
50 | ||
51 | (erase-buffer) | |
52 | (goto-char (point-min)) | |
53 | (insert srecode-field-utest-text) | |
54 | (set-buffer-modified-p nil) | |
55 | ||
56 | ;; Test basic field generation. | |
57 | (let ((srecode-field-archive nil) | |
58 | (f nil)) | |
59 | ||
60 | (end-of-line) | |
61 | (forward-word -1) | |
62 | ||
63 | (setq f (srecode-field "Test" | |
64 | :name "TEST" | |
65 | :start 6 | |
66 | :end 8)) | |
67 | ||
68 | (when (or (not (slot-boundp f 'overlay)) (not (oref f overlay))) | |
69 | (error "Field test: Overlay info not created for field")) | |
70 | ||
71 | (when (and (overlay-p (oref f overlay)) | |
72 | (not (overlay-get (oref f overlay) 'srecode-init-only))) | |
73 | (error "Field creation overlay is not tagged w/ init flag")) | |
74 | ||
75 | (srecode-overlaid-activate f) | |
76 | ||
77 | (when (or (not (overlay-p (oref f overlay))) | |
78 | (overlay-get (oref f overlay) 'srecode-init-only)) | |
79 | (error "New field overlay not created during activation")) | |
80 | ||
81 | (when (not (= (length srecode-field-archive) 1)) | |
82 | (error "Field test: Incorrect number of elements in the field archive")) | |
83 | (when (not (eq f (car srecode-field-archive))) | |
84 | (error "Field test: Field did not auto-add itself to the field archive")) | |
85 | ||
86 | (when (not (overlay-get (oref f overlay) 'keymap)) | |
87 | (error "Field test: Overlay keymap not set")) | |
88 | ||
89 | (when (not (string= "is" (srecode-overlaid-text f))) | |
90 | (error "Field test: Expected field text 'is', not %s" | |
91 | (srecode-overlaid-text f))) | |
92 | ||
93 | ;; Test deletion. | |
94 | (srecode-delete f) | |
95 | ||
96 | (when (slot-boundp f 'overlay) | |
97 | (error "Field test: Overlay not deleted after object delete")) | |
98 | ) | |
99 | ||
100 | ;; Test basic region construction. | |
101 | (let* ((srecode-field-archive nil) | |
102 | (reg nil) | |
103 | (fields | |
104 | (list | |
105 | (srecode-field "Test1" :name "TEST-1" :start 5 :end 10) | |
106 | (srecode-field "Test2" :name "TEST-2" :start 15 :end 20) | |
107 | (srecode-field "Test3" :name "TEST-3" :start 25 :end 30) | |
108 | ||
109 | (srecode-field "Test4" :name "TEST-4" :start 35 :end 35)) | |
110 | )) | |
111 | ||
112 | (when (not (= (length srecode-field-archive) 4)) | |
113 | (error "Region Test: Found %d fields. Expected 4" | |
114 | (length srecode-field-archive))) | |
115 | ||
116 | (setq reg (srecode-template-inserted-region "REG" | |
117 | :start 4 | |
118 | :end 40)) | |
119 | ||
120 | (srecode-overlaid-activate reg) | |
121 | ||
122 | ;; Make sure it was cleared. | |
123 | (when srecode-field-archive | |
124 | (error "Region Test: Did not clear field archive")) | |
125 | ||
126 | ;; Auto-positioning. | |
127 | (when (not (eq (point) 5)) | |
128 | (error "Region Test: Did not reposition on first field")) | |
129 | ||
130 | ;; Active region | |
131 | (when (not (eq (srecode-active-template-region) reg)) | |
132 | (error "Region Test: Active region not set")) | |
133 | ||
134 | ;; Various sizes | |
135 | (mapc (lambda (T) | |
136 | (if (string= (object-name-string T) "Test4") | |
137 | (progn | |
138 | (when (not (srecode-empty-region-p T)) | |
139 | (error "Field %s is not empty" | |
140 | (object-name T))) | |
141 | ) | |
142 | (when (not (= (srecode-region-size T) 5)) | |
143 | (error "Calculated size of %s was not 5" | |
144 | (object-name T))))) | |
145 | fields) | |
146 | ||
147 | ;; Make sure things stay up after a 'command'. | |
148 | (srecode-field-post-command) | |
149 | (when (not (eq (srecode-active-template-region) reg)) | |
150 | (error "Region Test: Active region did not stay up")) | |
151 | ||
152 | ;; Test field movement. | |
153 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
154 | (nth 0 fields))) | |
155 | (error "Region Test: Field %s not under point" | |
156 | (object-name (nth 0 fields)))) | |
157 | ||
158 | (srecode-field-next) | |
159 | ||
160 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
161 | (nth 1 fields))) | |
162 | (error "Region Test: Field %s not under point" | |
163 | (object-name (nth 1 fields)))) | |
164 | ||
165 | (srecode-field-prev) | |
166 | ||
167 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | |
168 | (nth 0 fields))) | |
169 | (error "Region Test: Field %s not under point" | |
170 | (object-name (nth 0 fields)))) | |
171 | ||
172 | ;; Move cursor out of the region and have everything cleaned up. | |
173 | (goto-char 42) | |
174 | (srecode-field-post-command) | |
175 | (when (srecode-active-template-region) | |
176 | (error "Region Test: Active region did not clear on move out")) | |
177 | ||
178 | (mapc (lambda (T) | |
179 | (when (slot-boundp T 'overlay) | |
58179cce | 180 | (error "Overlay did not clear off of field %s" |
74ea13c1 CY |
181 | (object-name T)))) |
182 | fields) | |
183 | ||
184 | ;; End of LET | |
185 | ) | |
186 | ||
187 | ;; Test variable linkage. | |
188 | (let* ((srecode-field-archive nil) | |
189 | (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8)) | |
190 | (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30)) | |
191 | (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40)) | |
192 | (reg (srecode-template-inserted-region "REG" :start 4 :end 40)) | |
193 | ) | |
194 | (srecode-overlaid-activate reg) | |
195 | ||
196 | (when (not (string= (srecode-overlaid-text f1) | |
197 | (srecode-overlaid-text f2))) | |
198 | (error "Linkage Test: Init strings are not =")) | |
199 | (when (string= (srecode-overlaid-text f1) | |
200 | (srecode-overlaid-text f3)) | |
201 | (error "Linkage Test: Init string on dissimilar fields is now the same")) | |
202 | ||
203 | (goto-char 7) | |
204 | (insert "a") | |
205 | ||
206 | (when (not (string= (srecode-overlaid-text f1) | |
207 | (srecode-overlaid-text f2))) | |
208 | (error "Linkage Test: mid-insert strings are not =")) | |
209 | (when (string= (srecode-overlaid-text f1) | |
210 | (srecode-overlaid-text f3)) | |
211 | (error "Linkage Test: mid-insert string on dissimilar fields is now the same")) | |
212 | ||
213 | (goto-char 9) | |
214 | (insert "t") | |
215 | ||
216 | (when (not (string= (srecode-overlaid-text f1) "iast")) | |
217 | (error "Linkage Test: tail-insert failed to captured added char")) | |
218 | (when (not (string= (srecode-overlaid-text f1) | |
219 | (srecode-overlaid-text f2))) | |
220 | (error "Linkage Test: tail-insert strings are not =")) | |
221 | (when (string= (srecode-overlaid-text f1) | |
222 | (srecode-overlaid-text f3)) | |
223 | (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | |
224 | ||
225 | (goto-char 6) | |
226 | (insert "b") | |
227 | ||
228 | (when (not (string= (srecode-overlaid-text f1) "biast")) | |
229 | (error "Linkage Test: tail-insert failed to captured added char")) | |
230 | (when (not (string= (srecode-overlaid-text f1) | |
231 | (srecode-overlaid-text f2))) | |
232 | (error "Linkage Test: tail-insert strings are not =")) | |
233 | (when (string= (srecode-overlaid-text f1) | |
234 | (srecode-overlaid-text f3)) | |
235 | (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | |
236 | ||
237 | ;; Cleanup | |
238 | (srecode-delete reg) | |
239 | ) | |
240 | ||
241 | (set-buffer-modified-p nil) | |
242 | ||
243 | (message " All field tests passed.") | |
244 | )) | |
245 | ||
246 | ;;; From srecode-document: | |
247 | ||
248 | (require 'srecode/doc) | |
249 | ||
250 | (defun srecode-document-function-comment-extract-test () | |
251 | "Test old comment extraction. | |
252 | Dump out the extracted dictionary." | |
253 | (interactive) | |
254 | ||
255 | (srecode-load-tables-for-mode major-mode) | |
256 | (srecode-load-tables-for-mode major-mode 'document) | |
257 | ||
258 | (if (not (srecode-table)) | |
259 | (error "No template table found for mode %s" major-mode)) | |
260 | ||
261 | (let* ((temp (srecode-template-get-table (srecode-table) | |
262 | "function-comment" | |
263 | "declaration" | |
264 | 'document)) | |
265 | (fcn-in (semantic-current-tag))) | |
266 | ||
267 | (if (not temp) | |
268 | (error "No templates for function comments")) | |
269 | ||
270 | ;; Try to figure out the tag we want to use. | |
271 | (when (or (not fcn-in) | |
272 | (not (semantic-tag-of-class-p fcn-in 'function))) | |
273 | (error "No tag of class 'function to insert comment for")) | |
274 | ||
275 | (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex)) | |
276 | ) | |
277 | ||
278 | (when (not lextok) | |
279 | (error "No comment to attempt an extraction")) | |
280 | ||
281 | (let ((s (semantic-lex-token-start lextok)) | |
282 | (e (semantic-lex-token-end lextok)) | |
283 | (extract nil)) | |
284 | ||
285 | (pulse-momentary-highlight-region s e) | |
286 | ||
287 | ;; Extract text from the existing comment. | |
288 | (setq extract (srecode-extract temp s e)) | |
289 | ||
290 | (with-output-to-temp-buffer "*SRECODE DUMP*" | |
291 | (princ "EXTRACTED DICTIONARY FOR ") | |
292 | (princ (semantic-tag-name fcn-in)) | |
293 | (princ "\n--------------------------------------------\n") | |
294 | (srecode-dump extract)))))) | |
3999968a | 295 | |
2c21a6e2 | 296 | ;;; srecode-tests.el ends here |