Mercurial > emacs
annotate test/cedet/srecode-tests.el @ 107818:c7670de45d8a
Don't abort try_window with fonts change when showing tooltip (Bug#2423).
* dispextern.h (TRY_WINDOW_CHECK_MARGINS)
(TRY_WINDOW_IGNORE_FONTS_CHANGE): New defines.
* xdisp.c (try_window): Change arg from CHECK_MARGINS to FLAGS.
Don't abort with fonts change if TRY_WINDOW_IGNORE_FONTS_CHANGE is
set in FLAGS. Callers with non-zero CHECK_MARGINS changed to use
TRY_WINDOW_CHECK_MARGINS.
* xfns.c (Fx_show_tip): Call try_window with TRY_WINDOW_IGNORE_FONTS_CHANGE.
author | YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> |
---|---|
date | Sat, 10 Apr 2010 19:52:30 +0900 |
parents | 51227b0f95e1 |
children | 376148b31b5e |
rev | line source |
---|---|
107339
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
1 ;;; srecode-tests.el --- Some tests for CEDET's srecode |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
2 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
4 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com> |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
6 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
7 ;; This file is part of GNU Emacs. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
8 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
9 ;; GNU Emacs is free software: you can redistribute it and/or modify |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
10 ;; it under the terms of the GNU General Public License as published by |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
11 ;; the Free Software Foundation, either version 3 of the License, or |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
12 ;; (at your option) any later version. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
13 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
14 ;; GNU Emacs is distributed in the hope that it will be useful, |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
17 ;; GNU General Public License for more details. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
18 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
19 ;; You should have received a copy of the GNU General Public License |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
21 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
22 ;;; Commentary: |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
23 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
24 ;; Extracted from srecode-fields.el and srecode-document.el in the |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
25 ;; CEDET distribution. |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
26 |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
27 ;;; Code: |
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
28 |
104498 | 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) | |
180 (error "Overlay did not clear off of of field %s" | |
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)))))) | |
105377 | 295 |
296 ;; arch-tag: 7a467849-b415-4bdc-ba2a-284ace156a65 | |
107339
51227b0f95e1
Add license information for ede-test.el and srecode-test.el.
Glenn Morris <rgm@gnu.org>
parents:
105377
diff
changeset
|
297 ;;; srecode-tests.el ends here |