test/cedet/semantic-tests.el

   1 ;;; semantic-utest.el --- Miscellaneous Semantic tests.
   2
   3 ;;; Copyright (C) 2003-2004, 2007-2013 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 created.  Let's 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-format
 111
 112 (require 'semantic/format)
 113
 114 (defun semantic-test-all-format-tag-functions (&optional arg)
 115   "Test all outputs from `semantic-format-tag-functions'.
 116 Output is generated from the function under `point'.
 117 Optional argument ARG specifies not to use color."
 118   (interactive "P")
 119   (semantic-fetch-tags)
 120   (let* ((tag (semantic-current-tag))
 121          (par (semantic-current-tag-parent))
 122          (fns semantic-format-tag-functions))
 123     (with-output-to-temp-buffer "*format-tag*"
 124       (princ "Tag->format function tests:")
 125       (while fns
 126         (princ "\n")
 127         (princ (car fns))
 128         (princ ":\n ")
 129         (let ((s (funcall (car fns) tag par (not arg))))
 130           (save-excursion
 131             (set-buffer "*format-tag*")
 132             (goto-char (point-max))
 133             (insert s)))
 134         (setq fns (cdr fns))))
 135       ))
 136
 137 ;;; From semantic-fw:
 138
 139 (require 'semantic/fw)
 140
 141 (defun semantic-test-data-cache ()
 142   "Test the data cache."
 143   (interactive)
 144   (let ((data '(a b c)))
 145     (save-excursion
 146       (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
 147       (erase-buffer)
 148       (insert "The Moose is Loose")
 149       (goto-char (point-min))
 150       (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
 151                                      data 'moose 'exit-cache-zone)
 152       (if (equal (semantic-get-cache-data 'moose) data)
 153           (message "Successfully retrieved cached data.")
 154         (error "Failed to retrieve cached data")))))
 155
 156 (defun semantic-test-throw-on-input ()
 157   "Test that throw on input will work."
 158   (interactive)
 159   (semantic-throw-on-input 'done-die)
 160   (message "Exit Code: %s"
 161            (semantic-exit-on-input 'testing
 162              (let ((inhibit-quit nil)
 163                    (message-log-max nil))
 164                (while t
 165                  (message "Looping ... press a key to test")
 166                  (semantic-throw-on-input 'test-inner-loop))
 167                'exit)))
 168   (when (input-pending-p)
 169     (if (fboundp 'read-event)
 170         (read-event)
 171       (read-char))))
 172
 173 ;;; From semantic-idle:
 174
 175 (require 'semantic/idle)
 176
 177 (defun semantic-idle-pnf-test ()
 178   "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
 179   (interactive)
 180   (let ((start (current-time))
 181         (junk (semantic-idle-scheduler-work-parse-neighboring-files))
 182         (end (current-time)))
 183     (message "Work took %.2f seconds." (semantic-elapsed-time start end))))
 184
 185 ;;; From semantic-lex:
 186
 187 (require 'semantic/lex)
 188
 189 (defun semantic-lex-test-full-depth (arg)
 190   "Test the semantic lexer in the current buffer parsing through lists.
 191 Usually the lexer parses.
 192 If universal argument ARG, then try the whole buffer."
 193   (interactive "P")
 194   (let* ((start (current-time))
 195          (result (semantic-lex
 196                   (if arg (point-min) (point))
 197                   (point-max)
 198                   100))
 199          (end (current-time)))
 200     (message "Elapsed Time: %.2f seconds."
 201              (semantic-elapsed-time start end))
 202     (pop-to-buffer "*Lexer Output*")
 203     (require 'pp)
 204     (erase-buffer)
 205     (insert (pp-to-string result))
 206     (goto-char (point-min))))
 207
 208 (defun semantic-lex-test-region (beg end)
 209   "Test the semantic lexer in the current buffer.
 210 Analyze the area between BEG and END."
 211   (interactive "r")
 212   (let ((result (semantic-lex beg end)))
 213     (pop-to-buffer "*Lexer Output*")
 214     (require 'pp)
 215     (erase-buffer)
 216     (insert (pp-to-string result))
 217     (goto-char (point-min))))
 218
 219 ;;; From semantic-lex-spp:
 220
 221 (require 'semantic/lex-spp)
 222
 223 (defun semantic-lex-spp-write-test ()
 224   "Test the semantic tag writer against the current buffer."
 225   (interactive)
 226   (with-output-to-temp-buffer "*SPP Write Test*"
 227     (semantic-lex-spp-table-write-slot-value
 228      (semantic-lex-spp-save-table))))
 229
 230 (defun semantic-lex-spp-write-utest ()
 231   "Unit test using the test spp file to test the slot write fcn."
 232   (interactive)
 233   (let* ((sem (locate-library "semantic-lex-spp.el"))
 234          (dir (file-name-directory sem)))
 235     (save-excursion
 236       (set-buffer (find-file-noselect
 237                    (expand-file-name "tests/testsppreplace.c"
 238                                      dir)))
 239       (semantic-lex-spp-write-test))))
 240
 241 ;;; From semantic-tag-write:
 242
 243 ;;; TESTING.
 244
 245 (require 'semantic/tag-write)
 246
 247 (defun semantic-tag-write-test ()
 248   "Test the semantic tag writer against the tag under point."
 249   (interactive)
 250   (with-output-to-temp-buffer "*Tag Write Test*"
 251     (semantic-tag-write-one-tag (semantic-current-tag))))
 252
 253 (defun semantic-tag-write-list-test ()
 254   "Test the semantic tag writer against the tag under point."
 255   (interactive)
 256   (with-output-to-temp-buffer "*Tag Write Test*"
 257     (semantic-tag-write-tag-list (semantic-fetch-tags))))
 258
 259 ;;; From semantic-symref-filter:
 260
 261 (require 'semantic/symref/filter)
 262
 263 (defun semantic-symref-test-count-hits-in-tag ()
 264   "Lookup in the current tag the symbol under point.
 265 Then count all the other references to the same symbol within the
 266 tag that contains point, and return that."
 267   (interactive)
 268   (let* ((ctxt (semantic-analyze-current-context))
 269          (target (car (reverse (oref ctxt prefix))))
 270          (tag (semantic-current-tag))
 271          (start (current-time))
 272          (Lcount 0))
 273     (when (semantic-tag-p target)
 274       (semantic-symref-hits-in-region
 275        target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
 276        (semantic-tag-start tag)
 277        (semantic-tag-end tag))
 278       (when (interactive-p)
 279         (message "Found %d occurrences of %s in %.2f seconds"
 280                  Lcount (semantic-tag-name target)
 281                  (semantic-elapsed-time start (current-time))))
 282       Lcount)))
 283
 284 ;;; From bovine-gcc:
 285
 286 (require 'semantic/bovine/gcc)
 287
 288 ;; Example output of "gcc -v"
 289 (defvar semantic-gcc-test-strings
 290   '(;; My old box:
 291     "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
 292 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
 293 Thread model: posix
 294 gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
 295     ;; Alex Ott:
 296     "Using built-in specs.
 297 Target: i486-linux-gnu
 298 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
 299 Thread model: posix
 300 gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
 301     ;; My debian box:
 302     "Using built-in specs.
 303 Target: x86_64-unknown-linux-gnu
 304 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
 305 Thread model: posix
 306 gcc version 4.2.3"
 307     ;; My mac:
 308     "Using built-in specs.
 309 Target: i686-apple-darwin8
 310 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
 311 Thread model: posix
 312 gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
 313     ;; Ubuntu Intrepid
 314     "Using built-in specs.
 315 Target: x86_64-linux-gnu
 316 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
 317 Thread model: posix
 318 gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
 319     ;; Red Hat EL4
 320     "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
 321 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
 322 Thread model: posix
 323 gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
 324     ;; Red Hat EL5
 325     "Using built-in specs.
 326 Target: x86_64-redhat-linux
 327 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
 328 Thread model: posix
 329 gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
 330     ;; David Engster's german gcc on ubuntu 4.3
 331     "Es werden eingebaute Spezifikationen verwendet.
 332 Ziel: i486-linux-gnu
 333 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
 334 Thread-Modell: posix
 335 gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
 336     ;; Damien Deville bsd
 337     "Using built-in specs.
 338 Target: i386-undermydesk-freebsd
 339 Configured with: FreeBSD/i386 system compiler
 340 Thread model: posix
 341 gcc version 4.2.1 20070719  [FreeBSD]"
 342     )
 343   "A bunch of sample gcc -v outputs from different machines.")
 344
 345 (defvar semantic-gcc-test-strings-fail
 346   '(;; A really old solaris box I found
 347     "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
 348 gcc version 2.95.2 19991024 (release)"
 349     )
 350   "A bunch of sample gcc -v outputs that fail to provide the info we want.")
 351
 352 (defun semantic-gcc-test-output-parser ()
 353   "Test the output parser against some collected strings."
 354   (interactive)
 355   (let ((fail nil))
 356     (dolist (S semantic-gcc-test-strings)
 357       (let* ((fields (semantic-gcc-fields S))
 358              (v (cdr (assoc 'version fields)))
 359              (h (or (cdr (assoc 'target fields))
 360                     (cdr (assoc '--target fields))
 361                     (cdr (assoc '--host fields))))
 362              (p (cdr (assoc '--prefix fields)))
 363              )
 364         ;; No longer test for prefixes.
 365         (when (not (and v h))
 366           (let ((strs (split-string S "\n")))
 367             (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
 368           (setq fail t))
 369         ))
 370     (dolist (S semantic-gcc-test-strings-fail)
 371       (let* ((fields (semantic-gcc-fields S))
 372              (v (cdr (assoc 'version fields)))
 373              (h (or (cdr (assoc '--host fields))
 374                     (cdr (assoc 'target fields))))
 375              (p (cdr (assoc '--prefix fields)))
 376              )
 377         (when (and v h p)
 378           (message "Negative test failed on %S" S)
 379           (setq fail t))
 380         ))
 381     (if (not fail) (message "Tests passed."))
 382     ))
 383
 384 (defun semantic-gcc-test-output-parser-this-machine ()
 385   "Test the output parser against the machine currently running Emacs."
 386   (interactive)
 387   (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
 388     (semantic-gcc-test-output-parser))
 389   )