Commit | Line | Data |
---|---|---|
74ea13c1 CY |
1 | ;;; semantic-utest.el --- Miscellaneous Semantic tests. |
2 | ||
3 | ;;; Copyright (C) 2003, 2004, 2007, 2008, 2009 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
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 | ;; Originally, there are many test functions scattered among the | |
25 | ;; Semantic source files. This file consolidates them. | |
26 | ||
27 | (require 'data-debug) | |
28 | ||
29 | ;;; From semantic-complete | |
30 | ||
31 | (require 'semantic/complete) | |
32 | ||
33 | (defun semantic-complete-test () | |
34 | "Test completion mechanisms." | |
35 | (interactive) | |
36 | (message "%S" | |
37 | (semantic-format-tag-prototype | |
38 | (semantic-complete-read-tag-project "Symbol: ")))) | |
39 | ||
40 | ;;; From semanticdb-ebrowse | |
41 | ||
42 | (require 'semantic/db-ebrowse) | |
43 | ||
44 | (defun semanticdb-ebrowse-run-tests () | |
45 | "Run some tests of the semanticdb-ebrowse system. | |
46 | All systems are different. Ask questions along the way." | |
47 | (interactive) | |
48 | (let ((doload nil)) | |
49 | (when (y-or-n-p "Create a system database to test with? ") | |
50 | (call-interactively 'semanticdb-create-ebrowse-database) | |
51 | (setq doload t)) | |
52 | ;; Should we load in caches | |
53 | (when (if doload | |
54 | (y-or-n-p "New database created. Reload system databases? ") | |
55 | (y-or-n-p "Load in all system databases? ")) | |
56 | (semanticdb-load-ebrowse-caches))) | |
57 | ;; Ok, databases were creatd. Lets try some searching. | |
58 | (when (not (or (eq major-mode 'c-mode) | |
59 | (eq major-mode 'c++-mode))) | |
60 | (error "Please make your default buffer be a C or C++ file, then | |
61 | run the test again.."))) | |
62 | ||
63 | (defun semanticdb-ebrowse-dump () | |
64 | "Find the first loaded ebrowse table, and dump out the contents." | |
65 | (interactive) | |
66 | (let ((db semanticdb-database-list) | |
67 | (ab nil)) | |
68 | (while db | |
69 | (when (semanticdb-project-database-ebrowse-p (car db)) | |
70 | (setq ab (data-debug-new-buffer "*EBROWSE Database*")) | |
71 | (data-debug-insert-thing (car db) "*" "") | |
72 | (setq db nil) | |
73 | ) | |
74 | (setq db (cdr db))))) | |
75 | ||
76 | ;;; From semanticdb-global: | |
77 | ||
78 | (require 'semantic/db-global) | |
79 | ||
80 | (defvar semanticdb-test-gnu-global-startfile "~/src/global-5.7.3/global/global.c" | |
81 | "File to use for testing.") | |
82 | ||
83 | (defun semanticdb-test-gnu-global (searchfor &optional standardfile) | |
84 | "Test the GNU Global semanticdb. | |
85 | Argument SEARCHFOR is the text to search for. | |
86 | If optional arg STANDARDFILE is non nil, use a standard file w/ global enabled." | |
87 | (interactive "sSearch For Tag: \nP") | |
88 | ||
89 | (require 'data-debug) | |
90 | (save-excursion | |
91 | (when standardfile | |
92 | (save-match-data | |
93 | (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile)))) | |
94 | ||
95 | (condition-case err | |
96 | (semanticdb-enable-gnu-global-in-buffer) | |
97 | (error (if standardfile | |
98 | (error err) | |
99 | (save-match-data | |
100 | (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile))) | |
101 | (semanticdb-enable-gnu-global-in-buffer)))) | |
102 | ||
103 | (let* ((db (semanticdb-project-database-global "global")) | |
104 | (tab (semanticdb-file-table db (buffer-file-name))) | |
105 | (result (semanticdb-deep-find-tags-for-completion-method tab searchfor)) | |
106 | ) | |
107 | (data-debug-new-buffer "*SemanticDB Gnu Global Result*") | |
108 | (data-debug-insert-thing result "?" "")))) | |
109 | ||
110 | ;;; From semantic-find | |
111 | ||
112 | (require 'semantic/find) | |
113 | ||
114 | (defun semantic-find-benchmark () | |
115 | "Run some simple benchmarks to see how we are doing. | |
116 | Optional argument ARG is the number of iterations to run." | |
117 | (interactive) | |
118 | (require 'benchmark) | |
119 | (let ((f-name nil) | |
120 | (b-name nil) | |
121 | (f-comp) | |
122 | (b-comp) | |
123 | (f-regex) | |
124 | ) | |
125 | (garbage-collect) | |
126 | (setq f-name | |
127 | (benchmark-run-compiled | |
128 | 1000 (semantic-find-first-tag-by-name "class3" | |
129 | "test/test.cpp"))) | |
130 | (garbage-collect) | |
131 | (setq b-name | |
132 | (benchmark-run-compiled | |
133 | 1000 (semantic-brute-find-first-tag-by-name "class3" | |
134 | "test/test.cpp"))) | |
135 | (garbage-collect) | |
136 | (setq f-comp | |
137 | (benchmark-run-compiled | |
138 | 1000 (semantic-find-tags-for-completion "method" | |
139 | "test/test.cpp"))) | |
140 | (garbage-collect) | |
141 | (setq b-comp | |
142 | (benchmark-run-compiled | |
143 | 1000 (semantic-brute-find-tag-by-name-regexp "^method" | |
144 | "test/test.cpp"))) | |
145 | (garbage-collect) | |
146 | (setq f-regex | |
147 | (benchmark-run-compiled | |
148 | 1000 (semantic-find-tags-by-name-regexp "^method" | |
149 | "test/test.cpp"))) | |
150 | ||
151 | (message "Name [new old] [ %.3f %.3f ] Complete [newc/new old] [ %.3f/%.3f %.3f ]" | |
152 | (car f-name) (car b-name) | |
153 | (car f-comp) (car f-regex) | |
154 | (car b-comp)) | |
155 | )) | |
156 | ||
157 | ;;; From semantic-format | |
158 | ||
159 | (require 'semantic/format) | |
160 | ||
161 | (defun semantic-test-all-format-tag-functions (&optional arg) | |
162 | "Test all outputs from `semantic-format-tag-functions'. | |
163 | Output is generated from the function under `point'. | |
164 | Optional argument ARG specifies not to use color." | |
165 | (interactive "P") | |
166 | (semantic-fetch-tags) | |
167 | (let* ((tag (semantic-current-tag)) | |
168 | (par (semantic-current-tag-parent)) | |
169 | (fns semantic-format-tag-functions)) | |
170 | (with-output-to-temp-buffer "*format-tag*" | |
171 | (princ "Tag->format function tests:") | |
172 | (while fns | |
173 | (princ "\n") | |
174 | (princ (car fns)) | |
175 | (princ ":\n ") | |
176 | (let ((s (funcall (car fns) tag par (not arg)))) | |
177 | (save-excursion | |
178 | (set-buffer "*format-tag*") | |
179 | (goto-char (point-max)) | |
180 | (insert s))) | |
181 | (setq fns (cdr fns)))) | |
182 | )) | |
183 | ||
184 | ;;; From semantic-fw: | |
185 | ||
186 | (require 'semantic/fw) | |
187 | ||
188 | (defun semantic-test-data-cache () | |
189 | "Test the data cache." | |
190 | (interactive) | |
191 | (let ((data '(a b c))) | |
192 | (save-excursion | |
193 | (set-buffer (get-buffer-create " *semantic-test-data-cache*")) | |
194 | (erase-buffer) | |
195 | (insert "The Moose is Loose") | |
196 | (goto-char (point-min)) | |
197 | (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) | |
198 | data 'moose 'exit-cache-zone) | |
199 | (if (equal (semantic-get-cache-data 'moose) data) | |
200 | (message "Successfully retrieved cached data.") | |
201 | (error "Failed to retrieve cached data"))))) | |
202 | ||
203 | (defun semantic-test-throw-on-input () | |
204 | "Test that throw on input will work." | |
205 | (interactive) | |
206 | (semantic-throw-on-input 'done-die) | |
207 | (message "Exit Code: %s" | |
208 | (semantic-exit-on-input 'testing | |
209 | (let ((inhibit-quit nil) | |
210 | (message-log-max nil)) | |
211 | (while t | |
212 | (message "Looping ... press a key to test") | |
213 | (semantic-throw-on-input 'test-inner-loop)) | |
214 | 'exit))) | |
215 | (when (input-pending-p) | |
216 | (if (fboundp 'read-event) | |
217 | (read-event) | |
218 | (read-char)))) | |
219 | ||
220 | ;;; From semantic-idle: | |
221 | ||
222 | (require 'semantic/idle) | |
223 | ||
224 | (defun semantic-idle-pnf-test () | |
225 | "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it." | |
226 | (interactive) | |
227 | (let ((start (current-time)) | |
228 | (junk (semantic-idle-scheduler-work-parse-neighboring-files)) | |
229 | (end (current-time))) | |
230 | (message "Work took %.2f seconds." (semantic-elapsed-time start end)))) | |
231 | ||
232 | ;;; From semantic-lex: | |
233 | ||
234 | (require 'semantic/lex) | |
235 | ||
236 | (defun semantic-lex-test-full-depth (arg) | |
237 | "Test the semantic lexer in the current buffer parsing through lists. | |
238 | Usually the lexer parses | |
239 | If universal argument ARG, then try the whole buffer." | |
240 | (interactive "P") | |
241 | (let* ((start (current-time)) | |
242 | (result (semantic-lex | |
243 | (if arg (point-min) (point)) | |
244 | (point-max) | |
245 | 100)) | |
246 | (end (current-time))) | |
247 | (message "Elapsed Time: %.2f seconds." | |
248 | (semantic-elapsed-time start end)) | |
249 | (pop-to-buffer "*Lexer Output*") | |
250 | (require 'pp) | |
251 | (erase-buffer) | |
252 | (insert (pp-to-string result)) | |
253 | (goto-char (point-min)))) | |
254 | ||
255 | (defun semantic-lex-test-region (beg end) | |
256 | "Test the semantic lexer in the current buffer. | |
257 | Analyze the area between BEG and END." | |
258 | (interactive "r") | |
259 | (let ((result (semantic-lex beg end))) | |
260 | (pop-to-buffer "*Lexer Output*") | |
261 | (require 'pp) | |
262 | (erase-buffer) | |
263 | (insert (pp-to-string result)) | |
264 | (goto-char (point-min)))) | |
265 | ||
266 | ;;; From semantic-lex-spp: | |
267 | ||
268 | (require 'semantic/lex-spp) | |
269 | ||
270 | (defun semantic-lex-spp-write-test () | |
271 | "Test the semantic tag writer against the current buffer." | |
272 | (interactive) | |
273 | (with-output-to-temp-buffer "*SPP Write Test*" | |
274 | (semantic-lex-spp-table-write-slot-value | |
275 | (semantic-lex-spp-save-table)))) | |
276 | ||
277 | (defun semantic-lex-spp-write-utest () | |
278 | "Unit test using the test spp file to test the slot write fcn." | |
279 | (interactive) | |
280 | (let* ((sem (locate-library "semantic-lex-spp.el")) | |
281 | (dir (file-name-directory sem))) | |
282 | (save-excursion | |
283 | (set-buffer (find-file-noselect | |
284 | (expand-file-name "tests/testsppreplace.c" | |
285 | dir))) | |
286 | (semantic-lex-spp-write-test)))) | |
287 | ||
288 | ;;; From semantic-tag-write: | |
289 | ||
290 | ;;; TESTING. | |
291 | ||
292 | (require 'semantic/tag-write) | |
293 | ||
294 | (defun semantic-tag-write-test () | |
295 | "Test the semantic tag writer against the tag under point." | |
296 | (interactive) | |
297 | (with-output-to-temp-buffer "*Tag Write Test*" | |
298 | (semantic-tag-write-one-tag (semantic-current-tag)))) | |
299 | ||
300 | (defun semantic-tag-write-list-test () | |
301 | "Test the semantic tag writer against the tag under point." | |
302 | (interactive) | |
303 | (with-output-to-temp-buffer "*Tag Write Test*" | |
304 | (semantic-tag-write-tag-list (semantic-fetch-tags)))) | |
305 | ||
306 | ;;; From semantic-symref-filter: | |
307 | ||
308 | (require 'semantic/symref/filter) | |
309 | ||
310 | (defun semantic-symref-test-count-hits-in-tag () | |
311 | "Lookup in the current tag the symbol under point. | |
312 | the count all the other references to the same symbol within the | |
313 | tag that contains point, and return that." | |
314 | (interactive) | |
315 | (let* ((ctxt (semantic-analyze-current-context)) | |
316 | (target (car (reverse (oref ctxt prefix)))) | |
317 | (tag (semantic-current-tag)) | |
318 | (start (current-time)) | |
319 | (Lcount 0)) | |
320 | (when (semantic-tag-p target) | |
321 | (semantic-symref-hits-in-region | |
322 | target (lambda (start end prefix) (setq Lcount (1+ Lcount))) | |
323 | (semantic-tag-start tag) | |
324 | (semantic-tag-end tag)) | |
325 | (when (interactive-p) | |
326 | (message "Found %d occurances of %s in %.2f seconds" | |
327 | Lcount (semantic-tag-name target) | |
328 | (semantic-elapsed-time start (current-time)))) | |
329 | Lcount))) | |
330 | ||
331 | ;;; From bovine-gcc: | |
332 | ||
333 | (require 'semantic/bovine/gcc) | |
334 | ||
335 | ;; Example output of "gcc -v" | |
336 | (defvar semantic-gcc-test-strings | |
337 | '(;; My old box: | |
338 | "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs | |
339 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux | |
340 | Thread model: posix | |
341 | gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)" | |
342 | ;; Alex Ott: | |
343 | "Using built-in specs. | |
344 | Target: i486-linux-gnu | |
345 | Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu | |
346 | Thread model: posix | |
347 | gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)" | |
348 | ;; My debian box: | |
349 | "Using built-in specs. | |
350 | Target: x86_64-unknown-linux-gnu | |
351 | Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib | |
352 | Thread model: posix | |
353 | gcc version 4.2.3" | |
354 | ;; My mac: | |
355 | "Using built-in specs. | |
356 | Target: i686-apple-darwin8 | |
357 | Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8 | |
358 | Thread model: posix | |
359 | gcc version 4.0.1 (Apple Computer, Inc. build 5341)" | |
360 | ;; Ubuntu Intrepid | |
361 | "Using built-in specs. | |
362 | Target: x86_64-linux-gnu | |
363 | Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu | |
364 | Thread model: posix | |
365 | gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" | |
366 | ;; Red Hat EL4 | |
367 | "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs | |
368 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux | |
369 | Thread model: posix | |
370 | gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)" | |
371 | ;; Red Hat EL5 | |
372 | "Using built-in specs. | |
373 | Target: x86_64-redhat-linux | |
374 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux | |
375 | Thread model: posix | |
376 | gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)" | |
377 | ;; David Engster's german gcc on ubuntu 4.3 | |
378 | "Es werden eingebaute Spezifikationen verwendet. | |
379 | Ziel: i486-linux-gnu | |
380 | Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu | |
381 | Thread-Modell: posix | |
382 | gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" | |
383 | ;; Damien Deville bsd | |
384 | "Using built-in specs. | |
385 | Target: i386-undermydesk-freebsd | |
386 | Configured with: FreeBSD/i386 system compiler | |
387 | Thread model: posix | |
388 | gcc version 4.2.1 20070719 [FreeBSD]" | |
389 | ) | |
390 | "A bunch of sample gcc -v outputs from different machines.") | |
391 | ||
392 | (defvar semantic-gcc-test-strings-fail | |
393 | '(;; A really old solaris box I found | |
394 | "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs | |
395 | gcc version 2.95.2 19991024 (release)" | |
396 | ) | |
397 | "A bunch of sample gcc -v outputs that fail to provide the info we want.") | |
398 | ||
399 | (defun semantic-gcc-test-output-parser () | |
400 | "Test the output parser against some collected strings." | |
401 | (interactive) | |
402 | (let ((fail nil)) | |
403 | (dolist (S semantic-gcc-test-strings) | |
404 | (let* ((fields (semantic-gcc-fields S)) | |
405 | (v (cdr (assoc 'version fields))) | |
406 | (h (or (cdr (assoc 'target fields)) | |
407 | (cdr (assoc '--target fields)) | |
408 | (cdr (assoc '--host fields)))) | |
409 | (p (cdr (assoc '--prefix fields))) | |
410 | ) | |
411 | ;; No longer test for prefixes. | |
412 | (when (not (and v h)) | |
413 | (let ((strs (split-string S "\n"))) | |
414 | (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)) | |
415 | (setq fail t)) | |
416 | )) | |
417 | (dolist (S semantic-gcc-test-strings-fail) | |
418 | (let* ((fields (semantic-gcc-fields S)) | |
419 | (v (cdr (assoc 'version fields))) | |
420 | (h (or (cdr (assoc '--host fields)) | |
421 | (cdr (assoc 'target fields)))) | |
422 | (p (cdr (assoc '--prefix fields))) | |
423 | ) | |
424 | (when (and v h p) | |
425 | (message "Negative test failed on %S" S) | |
426 | (setq fail t)) | |
427 | )) | |
428 | (if (not fail) (message "Tests passed.")) | |
429 | )) | |
430 | ||
431 | (defun semantic-gcc-test-output-parser-this-machine () | |
432 | "Test the output parser against the machine currently running Emacs." | |
433 | (interactive) | |
434 | (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) | |
435 | (semantic-gcc-test-output-parser)) | |
436 | ) |