1 ;;; semantic-utest.el --- Miscellaneous Semantic tests.
3 ;;; Copyright (C) 2003, 2004, 2007, 2008, 2009 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Originally, there are many test functions scattered among the
25 ;; Semantic source files. This file consolidates them.
29 ;;; From semantic-complete
31 (require 'semantic
/complete
)
33 (defun semantic-complete-test ()
34 "Test completion mechanisms."
37 (semantic-format-tag-prototype
38 (semantic-complete-read-tag-project "Symbol: "))))
40 ;;; From semanticdb-ebrowse
42 (require 'semantic
/db-ebrowse
)
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."
49 (when (y-or-n-p "Create a system database to test with? ")
50 (call-interactively 'semanticdb-create-ebrowse-database
)
52 ;; Should we load in caches
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..")))
63 (defun semanticdb-ebrowse-dump ()
64 "Find the first loaded ebrowse table, and dump out the contents."
66 (let ((db semanticdb-database-list
)
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
) "*" "")
76 ;;; From semanticdb-global:
78 (require 'semantic
/db-global
)
80 (defvar semanticdb-test-gnu-global-startfile
"~/src/global-5.7.3/global/global.c"
81 "File to use for testing.")
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")
93 (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile
))))
96 (semanticdb-enable-gnu-global-in-buffer)
97 (error (if standardfile
100 (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile
)))
101 (semanticdb-enable-gnu-global-in-buffer))))
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
))
107 (data-debug-new-buffer "*SemanticDB Gnu Global Result*")
108 (data-debug-insert-thing result
"?" ""))))
110 ;;; From semantic-find
112 (require 'semantic
/find
)
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."
127 (benchmark-run-compiled
128 1000 (semantic-find-first-tag-by-name "class3"
132 (benchmark-run-compiled
133 1000 (semantic-brute-find-first-tag-by-name "class3"
137 (benchmark-run-compiled
138 1000 (semantic-find-tags-for-completion "method"
142 (benchmark-run-compiled
143 1000 (semantic-brute-find-tag-by-name-regexp "^method"
147 (benchmark-run-compiled
148 1000 (semantic-find-tags-by-name-regexp "^method"
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
)
157 ;;; From semantic-format
159 (require 'semantic
/format
)
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."
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:")
176 (let ((s (funcall (car fns
) tag par
(not arg
))))
178 (set-buffer "*format-tag*")
179 (goto-char (point-max))
181 (setq fns
(cdr fns
))))
184 ;;; From semantic-fw:
186 (require 'semantic
/fw
)
188 (defun semantic-test-data-cache ()
189 "Test the data cache."
191 (let ((data '(a b c
)))
193 (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
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")))))
203 (defun semantic-test-throw-on-input ()
204 "Test that throw on input will work."
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
))
212 (message "Looping ... press a key to test")
213 (semantic-throw-on-input 'test-inner-loop
))
215 (when (input-pending-p)
216 (if (fboundp 'read-event
)
220 ;;; From semantic-idle:
222 (require 'semantic
/idle
)
224 (defun semantic-idle-pnf-test ()
225 "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
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
))))
232 ;;; From semantic-lex:
234 (require 'semantic
/lex
)
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."
241 (let* ((start (current-time))
242 (result (semantic-lex
243 (if arg
(point-min) (point))
246 (end (current-time)))
247 (message "Elapsed Time: %.2f seconds."
248 (semantic-elapsed-time start end
))
249 (pop-to-buffer "*Lexer Output*")
252 (insert (pp-to-string result
))
253 (goto-char (point-min))))
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."
259 (let ((result (semantic-lex beg end
)))
260 (pop-to-buffer "*Lexer Output*")
263 (insert (pp-to-string result
))
264 (goto-char (point-min))))
266 ;;; From semantic-lex-spp:
268 (require 'semantic
/lex-spp
)
270 (defun semantic-lex-spp-write-test ()
271 "Test the semantic tag writer against the current buffer."
273 (with-output-to-temp-buffer "*SPP Write Test*"
274 (semantic-lex-spp-table-write-slot-value
275 (semantic-lex-spp-save-table))))
277 (defun semantic-lex-spp-write-utest ()
278 "Unit test using the test spp file to test the slot write fcn."
280 (let* ((sem (locate-library "semantic-lex-spp.el"))
281 (dir (file-name-directory sem
)))
283 (set-buffer (find-file-noselect
284 (expand-file-name "tests/testsppreplace.c"
286 (semantic-lex-spp-write-test))))
288 ;;; From semantic-tag-write:
292 (require 'semantic
/tag-write
)
294 (defun semantic-tag-write-test ()
295 "Test the semantic tag writer against the tag under point."
297 (with-output-to-temp-buffer "*Tag Write Test*"
298 (semantic-tag-write-one-tag (semantic-current-tag))))
300 (defun semantic-tag-write-list-test ()
301 "Test the semantic tag writer against the tag under point."
303 (with-output-to-temp-buffer "*Tag Write Test*"
304 (semantic-tag-write-tag-list (semantic-fetch-tags))))
306 ;;; From semantic-symref-filter:
308 (require 'semantic
/symref
/filter
)
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."
315 (let* ((ctxt (semantic-analyze-current-context))
316 (target (car (reverse (oref ctxt prefix
))))
317 (tag (semantic-current-tag))
318 (start (current-time))
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))))
333 (require 'semantic
/bovine
/gcc
)
335 ;; Example output of "gcc -v"
336 (defvar semantic-gcc-test-strings
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
341 gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
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
347 gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
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
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
359 gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
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
365 gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
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
370 gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
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
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.
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
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
388 gcc version 4.2.1 20070719 [FreeBSD]"
390 "A bunch of sample gcc -v outputs from different machines.")
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)"
397 "A bunch of sample gcc -v outputs that fail to provide the info we want.")
399 (defun semantic-gcc-test-output-parser ()
400 "Test the output parser against some collected strings."
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
)))
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
))
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
)))
425 (message "Negative test failed on %S" S
)
428 (if (not fail
) (message "Tests passed."))
431 (defun semantic-gcc-test-output-parser-this-machine ()
432 "Test the output parser against the machine currently running Emacs."
434 (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
435 (semantic-gcc-test-output-parser))
438 ;; arch-tag: 91686489-4ab3-4392-8277-b3831269ddbb