From: Eric Ludlam Date: Tue, 15 Oct 2019 00:43:28 +0000 (-0400) Subject: Convert manual CEDET tests from test/manual/cedet to be X-Git-Tag: emacs-27.0.90~1050 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a99812ee0fb7245d4ee3a862f3139c0a53a8c5d7;p=emacs.git Convert manual CEDET tests from test/manual/cedet to be automated tests in test/lisp/cedet. Author: Eric Ludlam --- diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el new file mode 100644 index 00000000000..a6a5fd16257 --- /dev/null +++ b/test/lisp/cedet/semantic-utest-c.el @@ -0,0 +1,181 @@ +;;; semantic-utest-c.el --- C based parsing tests. + +;; Copyright (C) 2008-2019 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Run some C based parsing tests. + +(require 'ert) +(require 'semantic) + +(defvar semantic-utest-c-comparisons + '( ("testsppreplace.c" . "testsppreplaced.c") + ) + "List of files to parse and compare against each other.") + +(defvar cedet-utest-directory + (let* ((C (file-name-directory (locate-library "cedet"))) + (D (expand-file-name "../../test/manual/cedet/" C))) + D) + "Location of test files for this test suite.") + +(defvar semantic-utest-c-test-directory (expand-file-name "tests" cedet-utest-directory) + "Location of test files.") + +;;; Code: +;;;###autoload +(ert-deftest semantic-test-c-preprocessor-simulation () + "Run parsing test for C from the test directory." + (interactive) + (semantic-mode 1) + (dolist (fp semantic-utest-c-comparisons) + (let* ((semantic-lex-c-nested-namespace-ignore-second nil) + (tags-actual + (save-excursion + (set-buffer (find-file-noselect (expand-file-name (car fp) semantic-utest-c-test-directory))) + (semantic-clear-toplevel-cache) + (semantic-fetch-tags))) + (tags-expected + (save-excursion + (set-buffer (find-file-noselect (expand-file-name (cdr fp) semantic-utest-c-test-directory))) + (semantic-clear-toplevel-cache) + (semantic-fetch-tags)))) + (when (or (not tags-expected) (not tags-actual)) + (message "Tried to find test files in: %s" semantic-utest-c-test-directory) + (error "Failed: Disovered no tags in test files or test file not found.")) + + ;; Now that we have the tags, compare them for SPP accuracy. + (dolist (tag tags-actual) + (if (and (semantic-tag-of-class-p tag 'variable) + (semantic-tag-variable-constant-p tag)) + nil ; skip the macros. + + (if (semantic-tag-similar-with-subtags-p tag (car tags-expected)) + (setq tags-expected (cdr tags-expected)) + (with-mode-local c-mode + (should nil) ;; this is a fail condition + (message "Error: Found: >> %s << Expected: >> %s <<" + (semantic-format-tag-prototype tag nil t) + (semantic-format-tag-prototype (car tags-expected) nil t) + ))) + )) + ))) + +(require 'semantic/bovine/gcc) + +;; Example output of "gcc -v" +(defvar semantic-gcc-test-strings + '(;; My old box: + "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs +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 +Thread model: posix +gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)" + ;; Alex Ott: + "Using built-in specs. +Target: i486-linux-gnu +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 +Thread model: posix +gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)" + ;; My debian box: + "Using built-in specs. +Target: x86_64-unknown-linux-gnu +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 +Thread model: posix +gcc version 4.2.3" + ;; My mac: + "Using built-in specs. +Target: i686-apple-darwin8 +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 +Thread model: posix +gcc version 4.0.1 (Apple Computer, Inc. build 5341)" + ;; Ubuntu Intrepid + "Using built-in specs. +Target: x86_64-linux-gnu +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 +Thread model: posix +gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" + ;; Red Hat EL4 + "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs +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 +Thread model: posix +gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)" + ;; Red Hat EL5 + "Using built-in specs. +Target: x86_64-redhat-linux +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 +Thread model: posix +gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)" + ;; David Engster's german gcc on ubuntu 4.3 + "Es werden eingebaute Spezifikationen verwendet. +Ziel: i486-linux-gnu +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 +Thread-Modell: posix +gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" + ;; Damien Deville bsd + "Using built-in specs. +Target: i386-undermydesk-freebsd +Configured with: FreeBSD/i386 system compiler +Thread model: posix +gcc version 4.2.1 20070719 [FreeBSD]" + ) + "A bunch of sample gcc -v outputs from different machines.") + +(defvar semantic-gcc-test-strings-fail + '(;; A really old solaris box I found + "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs +gcc version 2.95.2 19991024 (release)" + ) + "A bunch of sample gcc -v outputs that fail to provide the info we want.") + +(ert-deftest semantic-test-gcc-output-parser () + "Test the output parser against some collected strings." + (let ((fail nil)) + (dolist (S semantic-gcc-test-strings) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc 'target fields)) + (cdr (assoc '--target fields)) + (cdr (assoc '--host fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; No longer test for prefixes. + (when (not (and v h)) + (let ((strs (split-string S "\n"))) + (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p) + )) + (should (and v h)) + )) + (dolist (S semantic-gcc-test-strings-fail) + (let* ((fields (semantic-gcc-fields S)) + (v (cdr (assoc 'version fields))) + (h (or (cdr (assoc '--host fields)) + (cdr (assoc 'target fields)))) + (p (cdr (assoc '--prefix fields))) + ) + ;; negative test + (should-not (and v h p)) + )) + )) + + +(provide 'semantic-utest-c) + +;;; semantic-utest-c.el ends here diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el new file mode 100644 index 00000000000..f83a89a8683 --- /dev/null +++ b/test/lisp/cedet/semantic-utest-ia.el @@ -0,0 +1,441 @@ +;;; semantic-utest-ia.el --- Analyzer unit tests + +;; Copyright (C) 2008-2019 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Use marked-up files in the test directory and run the analyzer +;; on them. Make sure the answers are correct. +;; +;; Each file has cursor keys in them of the form: +;; // -#- ("ans1" "ans2" ) +;; where # is 1, 2, 3, etc, and some sort of answer list. + +;;; Code: +(require 'semantic) +(require 'semantic/analyze) +(require 'semantic/analyze/refs) +(require 'semantic/symref) +(require 'semantic/symref/filter) + +(defvar cedet-utest-directory + (let* ((C (file-name-directory (locate-library "cedet"))) + (D (expand-file-name "../../test/manual/cedet/" C))) + D) + "Location of test files for this test suite.") + +(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) + "Location of test files.") + +(ert-deftest semantic-utest-ia-doublens.cpp () + (let ((tst (expand-file-name "testdoublens.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-subclass.cpp () + (let ((tst (expand-file-name "testsubclass.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-typedefs.cpp () + (let ((tst (expand-file-name "testtypedefs.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-friends.cpp () + (let ((tst (expand-file-name "testfriends.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-namespace.cpp () + (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-sppcomplete.c () + (let ((tst (expand-file-name "testsppcomplete.c" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-varnames.c () + (let ((tst (expand-file-name "testvarnames.c" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-javacomp.java () + (let ((tst (expand-file-name "testjavacomp.java" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +;;; Core testing utility +(defun semantic-ia-utest (testfile) + "Run the semantic ia unit test against stored sources." + (semantic-mode 1) + (let ((b (semantic-find-file-noselect testfile t))) + + ;; Run the test on it. + (with-current-buffer b + + ;; This line will also force the include, scope, and typecache. + (semantic-clear-toplevel-cache) + ;; Force tags to be parsed. + (semantic-fetch-tags) + + (prog1 + (or (semantic-ia-utest-buffer) + (semantic-ia-utest-buffer-refs) + (semantic-sr-utest-buffer-refs) + (semantic-src-utest-buffer-refs)) + + (kill-buffer b) + )))) + +(defun semantic-ia-utest-buffer () + "Run analyzer completion unit-test pass in the current buffer." + + (let* ((idx 1) + (regex-p nil) + (regex-a nil) + (p nil) + (a nil) + (pass nil) + (fail nil) + (actual nil) + (desired nil) + ;; Exclude unpredictable system files in the + ;; header include list. + (semanticdb-find-default-throttle + (remq 'system semanticdb-find-default-throttle)) + ) + + ;; Keep looking for test points until we run out. + (while (save-excursion + (setq regex-p (concat "//\\s-*-" (number-to-string idx) "-" ) + regex-a (concat "//\\s-*#" (number-to-string idx) "#" )) + (goto-char (point-min)) + (save-match-data + (when (re-search-forward regex-p nil t) + (setq p (match-beginning 0)))) + (save-match-data + (when (re-search-forward regex-a nil t) + (setq a (match-end 0)))) + (and p a)) + + (save-excursion + + (goto-char p) + + (let* ((ctxt (semantic-analyze-current-context)) + (acomp + (condition-case nil + (semantic-analyze-possible-completions ctxt) + (error nil)))) + (setq actual (mapcar 'semantic-tag-name acomp))) + + (goto-char a) + + (let ((bss (buffer-substring-no-properties (point) (point-at-eol)))) + (condition-case nil + (setq desired (read bss)) + (error (setq desired (format " FAILED TO PARSE: %S" + bss))))) + + (if (equal actual desired) + (setq pass (cons idx pass)) + (setq fail (cons + (list + (format "Failed %d. Desired: %S Actual %S" + idx desired actual) + ) + fail))) + + (setq p nil a nil) + (setq idx (1+ idx))) + ) + + (when fail + (cons "COMPLETION SUBTEST" fail)) + )) + +(defun semantic-ia-utest-buffer-refs () + "Run an analyze-refs unit-test pass in the current buffer." + + (let* ((idx 1) + (regex-p nil) + (p nil) + (pass nil) + (fail nil) + ;; Exclude unpredictable system files in the + ;; header include list. + (semanticdb-find-default-throttle + (remq 'system semanticdb-find-default-throttle)) + ) + ;; Keep looking for test points until we run out. + (while (save-excursion + (setq regex-p (concat "//\\s-*\\^" (number-to-string idx) "^" ) + ) + (goto-char (point-min)) + (save-match-data + (when (re-search-forward regex-p nil t) + (setq p (match-beginning 0)))) + p) + + (save-excursion + + (goto-char p) + (forward-char -1) + + (let* ((ct (semantic-current-tag)) + (refs (semantic-analyze-tag-references ct)) + (impl (semantic-analyze-refs-impl refs t)) + (proto (semantic-analyze-refs-proto refs t)) + (pf nil) + ) + (setq + pf + (catch 'failed + (if (and impl proto (car impl) (car proto)) + (let (ct2 ref2 impl2 proto2 + newstart) + (cond + ((semantic-equivalent-tag-p (car impl) ct) + ;; We are on an IMPL. Go To the proto, and find matches. + (semantic-go-to-tag (car proto)) + (setq newstart (car proto)) + ) + ((semantic-equivalent-tag-p (car proto) ct) + ;; We are on a PROTO. Go to the imple, and find matches + (semantic-go-to-tag (car impl)) + (setq newstart (car impl)) + ) + (t + ;; No matches is a fail. + (throw 'failed t) + )) + ;; Get the new tag, does it match? + (setq ct2 (semantic-current-tag)) + + ;; Does it match? + (when (not (semantic-equivalent-tag-p ct2 newstart)) + (throw 'failed t)) + + ;; Can we double-jump? + (setq ref2 (semantic-analyze-tag-references ct) + impl2 (semantic-analyze-refs-impl ref2 t) + proto2 (semantic-analyze-refs-proto ref2 t)) + + (when (or (not (and impl2 proto2)) + (not + (and (semantic-equivalent-tag-p + (car impl) (car impl2)) + (semantic-equivalent-tag-p + (car proto) (car proto2))))) + (throw 'failed t)) + ) + + ;; Else, no matches at all, so another fail. + (throw 'failed t) + ))) + + (if (not pf) + ;; We passed + (setq pass (cons idx pass)) + ;; We failed. + (setq fail (cons + (list + (message "Test id %d. For %s (Num impls %d) (Num protos %d)" + idx (if ct (semantic-tag-name ct) "") + (length impl) (length proto)) + ) + fail)) + )) + (setq p nil) + (setq idx (1+ idx)))) + (when fail + (cons "ANALYZER REF COUNTING SUBTEST" fail)))) + +(defun semantic-sr-utest-buffer-refs () + "Run a symref unit-test pass in the current buffer." + + ;; This line will also force the include, scope, and typecache. + (semantic-clear-toplevel-cache) + ;; Force tags to be parsed. + (semantic-fetch-tags) + + (let* ((idx 1) + (tag nil) + (regex-p nil) + (desired nil) + (actual-result nil) + (actual nil) + (pass nil) + (fail nil) + (symref-tool-used nil) + ;; Exclude unpredictable system files in the + ;; header include list. + (semanticdb-find-default-throttle + (remq 'system semanticdb-find-default-throttle)) + ) + ;; Keep looking for test points until we run out. + (while (save-excursion + (setq regex-p (concat "//\\s-*\\%" (number-to-string idx) "%" ) + ) + (goto-char (point-min)) + (save-match-data + (when (re-search-forward regex-p nil t) + (setq tag (semantic-current-tag)) + (goto-char (match-end 0)) + (setq desired (read (buffer-substring (point) (point-at-eol)))) + )) + tag) + + (setq actual-result (semantic-symref-find-references-by-name + (semantic-tag-name tag) 'target + 'symref-tool-used)) + + (if (not actual-result) + (progn + (setq fail (cons idx fail)) + (message "Failed Tool: %s" (eieio-object-name symref-tool-used)) + ) + + (setq actual (list (sort (mapcar + 'file-name-nondirectory + (semantic-symref-result-get-files actual-result)) + 'string<) + (sort + (mapcar + 'semantic-format-tag-canonical-name + (semantic-symref-result-get-tags actual-result)) + 'string<))) + + + (if (equal desired actual) + ;; We passed + (setq pass (cons idx pass)) + ;; We failed. + (setq fail + (cons (list + (when (not (equal (car actual) (car desired))) + (list + (format "Actual: %S Desired: %S" + (car actual) (car desired)) + (format "Failed Tool: %s" (eieio-object-name symref-tool-used)) + )) + (when (not (equal (car (cdr actual)) (car (cdr desired)))) + (list (format + "Actual: %S Desired: %S" + (car (cdr actual)) (car (cdr desired))) + (format + "Failed Tool: %s" (eieio-object-name symref-tool-used))))) + fail)) + )) + + (setq idx (1+ idx)) + (setq tag nil)) + + (when fail + (cons "SYMREF SUBTEST" fail)))) + +(defun semantic-symref-test-count-hits-in-tag () + "Lookup in the current tag the symbol under point. +Then count all the other references to the same symbol within the +tag that contains point, and return that." + (interactive) + (let* ((ctxt (semantic-analyze-current-context)) + (target (car (reverse (oref ctxt prefix)))) + (tag (semantic-current-tag)) + (start (current-time)) + (Lcount 0)) + (when (semantic-tag-p target) + (semantic-symref-hits-in-region + target (lambda (start end prefix) (setq Lcount (1+ Lcount))) + (semantic-tag-start tag) + (semantic-tag-end tag)) + Lcount))) + +(defun semantic-src-utest-buffer-refs () + "Run a sym-ref counting unit-test pass in the current buffer." + + ;; This line will also force the include, scope, and typecache. + (semantic-clear-toplevel-cache) + ;; Force tags to be parsed. + (semantic-fetch-tags) + + (let* ((idx 1) + (start nil) + (regex-p nil) + (desired nil) + (actual nil) + (pass nil) + (fail nil) + ;; Exclude unpredictable system files in the + ;; header include list. + (semanticdb-find-default-throttle + (remq 'system semanticdb-find-default-throttle)) + ) + ;; Keep looking for test points until we run out. + (while (save-excursion + (setq regex-p (concat "//\\s-*@" + (number-to-string idx) + "@\\s-+\\(\\w+\\)" )) + (goto-char (point-min)) + (save-match-data + (when (re-search-forward regex-p nil t) + (goto-char (match-beginning 1)) + (setq desired (read (buffer-substring (point) (point-at-eol)))) + (setq start (match-beginning 0)) + (goto-char start) + (setq actual (semantic-symref-test-count-hits-in-tag)) + start))) + + (if (not actual) + (progn + (setq fail (cons + (list + (format + "Symref id %d: No results." idx)) + fail)) + + ) + + (if (equal desired actual) + ;; We passed + (setq pass (cons idx pass)) + ;; We failed. + (setq fail (cons (list + (when (not (equal actual desired)) + (format + "Symref id %d: Actual: %S Desired: %S" + idx actual desired) + ) + ) + fail)) + )) + + (setq idx (1+ idx)) + ) + + (when fail + (cons "SYMREF COUNTING SUBTEST" fail)))) + +(provide 'semantic-ia-utest) + +;;; semantic-ia-utest.el ends here diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el new file mode 100644 index 00000000000..7303c0ef092 --- /dev/null +++ b/test/lisp/cedet/semantic-utest.el @@ -0,0 +1,793 @@ +;;; semantic-utest.el --- Tests for semantic's parsing system. + +;;; Copyright (C) 2003-2004, 2007-2019 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Semantic's parsing and partial parsing system is pretty complex. +;; These unit tests attempt to emulate semantic's partial reparsing +;; and full reparsing system, and anything else I may feel the urge +;; to write a test for. + +(require 'cedet) +(require 'semantic) + +(defvar cedet-utest-directory + (let* ((C (file-name-directory (locate-library "cedet"))) + (D (expand-file-name "../../test/manual/cedet/" C))) + D) + "Location of test files for this test suite.") + +(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory) + "Location of test files.") + +(defvar semantic-utest-temp-directory (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory) + "Temporary directory to use when creating files.") + +(defun semantic-utest-fname (name) + "Create a filename for NAME in /tmp." + (expand-file-name name semantic-utest-temp-directory)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for C tests + +(defvar semantic-utest-C-buffer-contents + "/* Test file for C language for Unit Tests */ + +#include +#include \"sutest.h\" + +struct mystruct1 { + int slot11; + char slot12; + float slot13; +}; + +int var1; + +float funp1(char arg11, char arg12); + +char fun2(int arg_21, int arg_22) /*1*/ +{ + struct mystruct1 *ms1 = malloc(sizeof(struct mystruct1)); + + char sv = calc_sv(var1); + + if (var1 == 0) { + sv = 1; + } else if (arg_21 == 0) { + sv = 2; + } else if (arg_22 == 0) { + sv = 3; + } else { + sv = 4; + } + + printf(\"SV = %d\\n\", sv); + + /* Memory Leak */ + ms1.slot1 = sv; + + return 'A' + sv; +} +" + "Contents of a C buffer initialized by this unit test. +Be sure to change `semantic-utest-C-name-contents' when you +change this variable.") + +(defvar semantic-utest-C-h-buffer-contents + "/* Test file for C language header file for Unit Tests */ + +int calc_sv(int); + +" + "Contents of a C header file buffer initialized by this unit test.") + +(defvar semantic-utest-C-filename (semantic-utest-fname "sutest.c") + "File to open and erase during this test for C.") + +(defvar semantic-utest-C-filename-h + (concat (file-name-sans-extension semantic-utest-C-filename) + ".h") + "Header file filename for C") + + +(defvar semantic-utest-C-name-contents + '(("stdio.h" include + (:system-flag t) + nil (overlay 48 66 "sutest.c")) + ("sutest.h" include nil nil (overlay 67 86 "sutest.c")) + ("mystruct1" type + (:members + (("slot11" variable + (:type "int") + (reparse-symbol classsubparts) + (overlay 109 120 "sutest.c")) + ("slot12" variable + (:type "char") + (reparse-symbol classsubparts) + (overlay 123 135 "sutest.c")) + ("slot13" variable + (:type "float") + (reparse-symbol classsubparts) + (overlay 138 151 "sutest.c"))) + :type "struct") + nil (overlay 88 154 "sutest.c")) + ("var1" variable + (:type "int") + nil (overlay 156 165 "sutest.c")) + ("funp1" function + (:prototype-flag t :arguments + (("arg11" variable + (:type "char") + (reparse-symbol arg-sub-list) + (overlay 179 190 "sutest.c")) + ("arg12" variable + (:type "char") + (reparse-symbol arg-sub-list) + (overlay 191 202 "sutest.c"))) + :type "float") + nil (overlay 167 203 "sutest.c")) + ("fun2" function + (:arguments + (("arg_21" variable + (:type "int") + (reparse-symbol arg-sub-list) + (overlay 215 226 "sutest.c")) + ("arg_22" variable + (:type "int") + (reparse-symbol arg-sub-list) + (overlay 227 238 "sutest.c"))) + :type "char") + nil (overlay 205 566 "sutest.c"))) + "List of expected tag names for C.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Python tests + +(defvar semantic-utest-Python-buffer-contents +" +def fun1(a,b,c): + return a + +def fun2(a,b,c): #1 + return b + +" + + +) +; "python test case. notice that python is indentation sensitive + + +(defvar semantic-utest-Python-name-contents + '(("fun1" function + (:arguments + (("a" variable nil + (reparse-symbol function_parameters) + (overlay 10 11 "tst.py")) + ("b" variable nil + (reparse-symbol function_parameters) + (overlay 12 13 "tst.py")) + ("c" variable nil + (reparse-symbol function_parameters) + (overlay 14 15 "tst.py")))) + nil (overlay 1 31 "tst.py")) + ("fun2" function + (:arguments + (("a" variable nil + (reparse-symbol function_parameters) + (overlay 41 42 "tst.py")) + ("b" variable nil + (reparse-symbol function_parameters) + (overlay 43 44 "tst.py")) + ("c" variable nil + (reparse-symbol function_parameters) + (overlay 45 46 "tst.py")))) + nil (overlay 32 65 "tst.py"))) + + "List of expected tag names for Python.") + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Java tests + +(defvar semantic-utest-Java-buffer-contents +" +class JavaTest{ + void fun1(int a,int b){ + return a; + } + + void fun2(int a,int b){ //1 + return b; + } + +} +" +) + +(defvar semantic-utest-Java-name-contents + '(("JavaTest" type + (:members + (("fun1" function + (:arguments + (("a" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 30 35 "JavaTest.java")) + ("b" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 36 41 "JavaTest.java"))) + :type "void") + (reparse-symbol class_member_declaration) + (overlay 20 61 "JavaTest.java")) + ("fun2" function + (:arguments + (("a" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 75 80 "JavaTest.java")) + ("b" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 81 86 "JavaTest.java"))) + :type "void") + (reparse-symbol class_member_declaration) + (overlay 65 110 "JavaTest.java"))) + :type "class") + nil (overlay 2 113 "JavaTest.java"))) + "List of expected tag names for Java." + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Javascript tests + +(defvar semantic-utest-Javascript-buffer-contents +" +function fun1(a, b){ + return a; + } + +function fun2(a,b){ //1 + return b; + } +" +) + + +(defvar semantic-utest-Javascript-name-contents + '(("fun1" function + (:arguments + (("a" variable nil + (reparse-symbol FormalParameterList) + (overlay 15 16 "tst.js")) + ("b" variable nil + (reparse-symbol FormalParameterList) + (overlay 18 19 "tst.js")))) + nil (overlay 1 39 "tst.js")) + ("fun2" function + (:arguments + (("a" variable nil + (reparse-symbol FormalParameterList) + (overlay 55 56 "tst.js")) + ("b" variable nil + (reparse-symbol FormalParameterList) + (overlay 57 58 "tst.js")))) + nil (overlay 41 82 "tst.js"))) + + "List of expected tag names for Javascript.") + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Makefile tests + +(defvar semantic-utest-Makefile-buffer-contents +" +t1: +\techo t1 + +t2:t1 #1 +\techo t2 + + +" +) + + +(defvar semantic-utest-Makefile-name-contents + '(("t1" function nil nil (overlay 1 9 "Makefile")) + ("t2" function + (:arguments + ("t1")) + nil (overlay 18 28 "Makefile"))) + "List of expected tag names for Makefile.") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Scheme tests + +(defvar semantic-utest-Scheme-buffer-contents + " + (define fun1 2) + + (define fun2 3) ;1 + +") + +(defvar semantic-utest-Scheme-name-contents + '(("fun1" variable + (:default-value ("2")) + nil (overlay 3 18 "tst.scm")) + ("fun2" variable + (:default-value ("3")) + nil (overlay 21 55 "tst.scm"))) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Html tests + +(defvar semantic-utest-Html-buffer-contents + " + + +

hello

+ + +" + ) + +(defvar semantic-utest-Html-name-contents + '(("hello" section + (:members + (("hello" section nil nil (overlay 21 24 "tst.html")))) + nil (overlay 10 15 "tst.html"))) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for PHP tests + +(defvar semantic-utest-PHP-buffer-contents + " " + ) + +(defvar semantic-utest-PHP-name-contents + '(("fun1" function nil + nil (overlay 9 45 "phptest.php")) + ("fun2" function + (:arguments (("$arg1" variable nil (reparse-symbol formal_parameters) (overlay 61 66 "phptest.php")))) + nil + (overlay 47 132 "phptest.php")) + ("aClass" type + (:members (("fun1" function + (:typemodifiers ("public") :arguments + (("$a" variable nil (reparse-symbol formal_parameters) (overlay 174 176 "phptest.php")) + ("$b" variable nil (reparse-symbol formal_parameters) (overlay 178 180 "phptest.php")))) + + nil + (overlay 153 204 "phptest.php")) + + ("fun2" function + (:typemodifiers ("public") :arguments + (("$a" variable nil (reparse-symbol formal_parameters) (overlay 230 232 "phptest.php")) + ("$b" variable nil (reparse-symbol formal_parameters) (overlay 234 236 "phptest.php")) + )) + nil + (overlay 209 260 "phptest.php"))) :type "class") + nil + (overlay 135 262 "phptest.php")) + ) + "Expected results from the PHP Unit test" + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Data for Csharp C# tests + +(defvar semantic-utest-Csharp-buffer-contents +" +class someClass { + int fun1(int a, int b) { + return a; } + int fun2(int a, int b) { + return b; } +} +") + +(defvar semantic-utest-Csharp-name-contents + '(("someClass" type + (:members + (("fun1" function + (:arguments + (("a" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 30 35 "tst.cs")) + ("b" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 37 42 "tst.cs"))) + :type "int") + (reparse-symbol class_member_declaration) + (overlay 21 61 "tst.cs")) + ("fun2" function + (:arguments + (("a" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 73 78 "tst.cs")) + ("b" variable + (:type "int") + (reparse-symbol formal_parameters) + (overlay 80 85 "tst.cs"))) + :type "int") + (reparse-symbol class_member_declaration) + (overlay 64 104 "tst.cs"))) + :type "class") + nil (overlay 1 106 "tst.cs"))) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +(defun semantic-utest-makebuffer (filename contents) + "Create a buffer for FILENAME for use in a unit test. +Pre-fill the buffer with CONTENTS." + (let ((buff (semantic-find-file-noselect filename))) + (set-buffer buff) + (setq buffer-offer-save nil) + (font-lock-mode -1) ;; Font lock has issues in Emacs 23 + (toggle-read-only -1) ;; In case /tmp doesn't exist. + (erase-buffer) + (insert contents) + ;(semantic-fetch-tags) ;JAVE could this go here? + (set-buffer-modified-p nil) + buff + ) + ) + +(ert-deftest semantic-utest-C () + "Run semantic's C unit test." + (semantic-mode 1) + (save-excursion + (let ((buff (semantic-utest-makebuffer semantic-utest-C-filename semantic-utest-C-buffer-contents)) + (buff2 (semantic-utest-makebuffer semantic-utest-C-filename-h semantic-utest-C-h-buffer-contents)) + ) + (semantic-fetch-tags) + (set-buffer buff) + + ;; Turn off a range of modes + (semantic-idle-scheduler-mode -1) + + ;; Turn on some modes + (semantic-highlight-edits-mode 1) + + ;; Update tags, and show it. + (semantic-fetch-tags) + + ;; Run the tests. + ;;(message "First parsing test.") + (should (semantic-utest-verify-names semantic-utest-C-name-contents)) + + ;;(message "Invalid tag test.") + (semantic-utest-last-invalid semantic-utest-C-name-contents '("fun2") "/\\*1\\*/" "/* Deleted this line */") + (should (semantic-utest-verify-names semantic-utest-C-name-contents)) + + (set-buffer-modified-p nil) + ;; Clean up + (kill-buffer buff) + (kill-buffer buff2) + ))) + + + + +(defun semantic-utest-generic (testname filename contents name-contents names-removed killme insertme) + "Generic unit test according to template. +Should work for languages without .h files, python javascript java. +TESTNAME is the name of the test. +FILENAME is the name of the file to create. +CONTENTS is the contents of the file to test. +NAME-CONTENTS is the list of names that should be in the contents. +NAMES-REMOVED is the list of names that gets removed in the removal step. +KILLME is the name of items to be killed. +INSERTME is the text to be inserted after the deletion." + (semantic-mode 1) + (save-excursion + (let ((buff (semantic-utest-makebuffer filename contents)) + ) + ;; Turn off a range of modes + (semantic-idle-scheduler-mode -1) + + ;; Turn on some modes + (semantic-highlight-edits-mode 1) + + ;; Update tags, and show it. + (semantic-clear-toplevel-cache) + (semantic-fetch-tags) + (switch-to-buffer buff) + (sit-for 0) + + ;; Run the tests. + ;;(message "First parsing test %s." testname) + (should (semantic-utest-verify-names name-contents)) + + ;;(message "Invalid tag test %s." testname) + (semantic-utest-last-invalid name-contents names-removed killme insertme) + (should (semantic-utest-verify-names name-contents)) + + (set-buffer-modified-p nil) + ;; Clean up + (kill-buffer buff) + ))) + +(ert-deftest semantic-utest-Python() + (skip-unless (featurep 'python-mode)) + (let ((python-indent-guess-indent-offset nil)) + (semantic-utest-generic "Python" (semantic-utest-fname "pytest.py") semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents '("fun2") "#1" "#deleted line") + )) + + +(ert-deftest semantic-utest-Javascript() + (if (fboundp 'javascript-mode) + (semantic-utest-generic "Javascript" (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line") + (message "Skipping JavaScript test: NO major mode.")) + ) + +(ert-deftest semantic-utest-Java() + ;; If JDE is installed, it might mess things up depending on the version + ;; that was installed. + (let ((auto-mode-alist '(("\\.java\\'" . java-mode)))) + (semantic-utest-generic "Java" (semantic-utest-fname "JavaTest.java") semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents '("fun2") "//1" "//deleted line") + )) + +(ert-deftest semantic-utest-Makefile() + (semantic-utest-generic "Makefile" (semantic-utest-fname "Makefile") semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents '("fun2") "#1" "#deleted line") + ) + +(ert-deftest semantic-utest-Scheme() + (skip-unless nil) ;; There is a bug w/ scheme parser. Skip this for now. + (semantic-utest-generic "Scheme" (semantic-utest-fname "tst.scm") semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents '("fun2") ";1" ";deleted line") + ) + + +(ert-deftest semantic-utest-Html() + ;; Disable html-helper auto-fill-in mode. + (let ((html-helper-build-new-buffer nil)) + (semantic-utest-generic "HTML" (semantic-utest-fname "tst.html") semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents '("fun2") "" "") + )) + +(ert-deftest semantic-utest-PHP() + (skip-unless (featurep 'php-mode)) + (semantic-utest-generic "PHP" (semantic-utest-fname "phptest.php") semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1") "fun2" "%^@") + ) + +;look at http://mfgames.com/linux/csharp-mode +(ert-deftest semantic-utest-Csharp() ;; hmm i don't even know how to edit a scharp file. need a csharp mode implementation i suppose + (skip-unless (featurep 'csharp-mode)) + (semantic-utest-generic "C#" (semantic-utest-fname "csharptest.cs") semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents '("fun2") "//1" "//deleted line") + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stubs + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; stuff for Erlang +;;-module(hello). +;-export([hello_world/0]). +; +;hello_world()-> +; io:format("Hello World ~n"). +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;(defun semantic-utest-Erlang() +; (interactive) +; (semantic-utest-generic "Erlang" (semantic-utest-fname "tst.erl") semantic-utest-Erlang-buffer-contents semantic-utest-Erlang-name-contents '("fun2") "//1" "//deleted line") +; ) +; +;;texi is also supported +;(defun semantic-utest-Texi() +; (interactive) +; (semantic-utest-generic "texi" (semantic-utest-fname "tst.texi") semantic-utest-Texi-buffer-contents semantic-utest-Texi-name-contents '("fun2") "//1" "//deleted line") +; ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; Buffer contents validation +;; +(defun semantic-utest-match-attributes (attr1 attr2 skipnames) + "Compare attribute lists ATTR1 and ATTR2. +Argument SKIPNAMES is a list of names that may be child nodes to skip." + (let ((res t)) + (while (and res attr1 attr2) + + ;; Compare + (setq res + (cond ((and (listp (car attr1)) + (semantic-tag-p (car (car attr1)))) + ;; Compare the list of tags... + (semantic-utest-taglists-equivalent-p + (car attr2) (car attr1) skipnames) + ) + (t + (equal (car attr1) (car attr2))))) + + (if (not res) + (error "TAG INTERNAL DIFF: %S %S" + (car attr1) (car attr2))) + + (setq attr1 (cdr attr1) + attr2 (cdr attr2))) + res)) + +(defun semantic-utest-equivalent-tag-p (tag1 tag2 skipnames) + "Determine if TAG1 and TAG2 are the same. +SKIPNAMES includes lists of possible child nodes that should be missing." + (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2)) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)) + (semantic-utest-match-attributes + (semantic-tag-attributes tag1) (semantic-tag-attributes tag2) + skipnames) + )) + +(defun semantic-utest-taglists-equivalent-p (table names skipnames) + "Compare TABLE and NAMES, where skipnames allow list1 to be different. +SKIPNAMES is a list of names that should be skipped in the NAMES list." + (let ((SN skipnames)) + (while SN + (setq names (remove (car SN) names)) + (setq SN (cdr SN)))) + (catch 'utest-err + (while (and names table) + (when (not (semantic-utest-equivalent-tag-p (car names) + (car table) + skipnames)) + (message "Semantic Parse Test Fail: Expected %s, found %s" + (semantic-format-tag-prototype (car names)) + (semantic-format-tag-prototype (car table))) + (throw 'utest-err nil) + ) + (setq names (cdr names) + table (cdr table))) + (when names + (message "Semantic Parse Test Fail: Items forgotten: %S" (mapcar 'semantic-tag-name names)) + (throw 'utest-err nil)) + (when table + (message "Semantic parse Test Fail: Items extra: %S" (mapcar 'semantic-tag-name table)) + (throw 'utest-err nil)) + t)) + +(defun semantic-utest-verify-names (name-contents &optional skipnames) + "Verify the names of the test buffer from NAME-CONTENTS. +Argument SKIPNAMES is a list of names that should be skipped +when analyzing the file. + +JAVE this thing would need to be recursive to handle java and csharp" + (let ((names name-contents) + (table (semantic-fetch-tags)) + ) + (semantic-utest-taglists-equivalent-p table names skipnames) + )) + +;;;;;;;;;;;;;;;;;;;;;;;; +; JAVE redefine a new validation function +; is not quite as good as the old one yet +(defun semantic-utest-verify-names-jave (name-contents &optional skipnames) + "JAVE version of `semantic-utest-verify-names'. +NAME-CONTENTS is a sample of the tags buffer to test against. +SKIPNAMES is a list of names to remove from NAME-CONTENTS" + (assert (semantic-utest-verify-names-2 name-contents (semantic-fetch-tags)) + nil "failed test") +) + +(defun semantic-utest-verify-names-2 (l1 l2) + (cond ( (and (consp l1) (equal (car l1) 'overlay)) + (overlayp l2)) + ((not (consp l1)) + (equal l1 l2)) + ((consp l1) + (and (semantic-utest-verify-names-2 (car l1) (car l2)) (semantic-utest-verify-names-2 (cdr l1) (cdr l2)))) + (t (error "internal error")))) + + + + + +;;; Kill indicator line +;; +;; Utilities to modify the buffer for reparse, making sure a specific tag is deleted +;; via the incremental parser. + +(defvar semantic-utest-last-kill-text nil + "The text from the last kill.") + +(defvar semantic-utest-last-kill-pos nil + "The position of the last kill.") + +(defun semantic-utest-kill-indicator ( killme insertme) + "Kill the line with KILLME on it and insert INSERTME in its place." + (goto-char (point-min)) +; (re-search-forward (concat "/\\*" indicator "\\*/")); JAVE this isn't generic enough for different languages + (re-search-forward killme) + (beginning-of-line) + (setq semantic-utest-last-kill-pos (point)) + (setq semantic-utest-last-kill-text + (buffer-substring (point) (point-at-eol))) + (delete-region (point) (point-at-eol)) + (insert insertme) + (sit-for 0) +) + +(defun semantic-utest-unkill-indicator () + "Unkill the last indicator." + (goto-char semantic-utest-last-kill-pos) + (delete-region (point) (point-at-eol)) + (insert semantic-utest-last-kill-text) + (sit-for 0) + ) + +(defun semantic-utest-last-invalid (name-contents names-removed killme insertme) + "Make the last fcn invalid." + (semantic-utest-kill-indicator killme insertme) +; (semantic-utest-verify-names name-contents names-removed); verify its gone ;new validator doesn't handle skipnames yet + (semantic-utest-unkill-indicator);put back killed stuff + ) + + + +;;; semantic-utest.el ends here diff --git a/test/manual/cedet/semantic-ia-utest.el b/test/manual/cedet/semantic-ia-utest.el deleted file mode 100644 index 10f02b3c34c..00000000000 --- a/test/manual/cedet/semantic-ia-utest.el +++ /dev/null @@ -1,528 +0,0 @@ -;;; semantic-ia-utest.el --- Analyzer unit tests - -;; Copyright (C) 2008-2019 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Use marked-up files in the test directory and run the analyzer -;; on them. Make sure the answers are correct. -;; -;; Each file has cursor keys in them of the form: -;; // -#- ("ans1" "ans2" ) -;; where # is 1, 2, 3, etc, and some sort of answer list. - -;;; Code: -(require 'semantic) -(require 'semantic/analyze) -(require 'semantic/analyze/refs) -(require 'semantic/symref) -(require 'semantic/symref/filter) - -(load-file "cedet-utests.el") - -(defvar semantic-ia-utest-file-list - '( - "tests/testdoublens.cpp" - "tests/testsubclass.cpp" - "tests/testtypedefs.cpp" - "tests/testfriends.cpp" - "tests/testnsp.cpp" - "tests/testsppcomplete.c" - "tests/testvarnames.c" - "tests/testjavacomp.java" - ) - "List of files with analyzer completion test points.") - -(defvar semantic-ia-utest-error-log-list nil - "List of errors occurring during a run.") - -;;;###autoload -(defun semantic-ia-utest (&optional arg) - "Run the semantic ia unit test against stored sources. -Argument ARG specifies which set of tests to run. - 1 - ia utests - 2 - regs utests - 3 - symrefs utests - 4 - symref count utests" - (interactive "P") - (save-excursion - - (let ((fl semantic-ia-utest-file-list) - (semantic-ia-utest-error-log-list nil) - ) - - (cedet-utest-log-setup "ANALYZER") - - (set-buffer (semantic-find-file-noselect - (or (locate-library "semantic-ia-utest.el") - "semantic-ia-utest.el"))) - - (while fl - - ;; Make sure we have the files we think we have. - (when (not (file-exists-p (car fl))) - (error "Cannot find unit test file: %s" (car fl))) - - ;; Run the tests. - (let ((fb (find-buffer-visiting (car fl))) - (b (semantic-find-file-noselect (car fl) t))) - - ;; Run the test on it. - (save-excursion - (set-buffer b) - - ;; This line will also force the include, scope, and typecache. - (semantic-clear-toplevel-cache) - ;; Force tags to be parsed. - (semantic-fetch-tags) - - (semantic-ia-utest-log " ** Starting tests in %s" - (buffer-name)) - - (when (or (not arg) (= arg 1)) - (semantic-ia-utest-buffer)) - - (when (or (not arg) (= arg 2)) - (set-buffer b) - (semantic-ia-utest-buffer-refs)) - - (when (or (not arg) (= arg 3)) - (set-buffer b) - (semantic-sr-utest-buffer-refs)) - - (when (or (not arg) (= arg 4)) - (set-buffer b) - (semantic-src-utest-buffer-refs)) - - (semantic-ia-utest-log " ** Completed tests in %s\n" - (buffer-name)) - ) - - ;; If it wasn't already in memory, whack it. - (when (not fb) - (kill-buffer b)) - ) - (setq fl (cdr fl))) - - (cedet-utest-log-shutdown - "ANALYZER" - (when semantic-ia-utest-error-log-list - (format "%s Failures found." - (length semantic-ia-utest-error-log-list)))) - (when semantic-ia-utest-error-log-list - (error "Failures found during analyzer unit tests")) - )) - ) - -(defun semantic-ia-utest-buffer () - "Run analyzer completion unit-test pass in the current buffer." - - (let* ((idx 1) - (regex-p nil) - (regex-a nil) - (p nil) - (a nil) - (pass nil) - (fail nil) - (actual nil) - (desired nil) - ;; Exclude unpredictable system files in the - ;; header include list. - (semanticdb-find-default-throttle - (remq 'system semanticdb-find-default-throttle)) - ) - ;; Keep looking for test points until we run out. - (while (save-excursion - (setq regex-p (concat "//\\s-*-" (number-to-string idx) "-" ) - regex-a (concat "//\\s-*#" (number-to-string idx) "#" )) - (goto-char (point-min)) - (save-match-data - (when (re-search-forward regex-p nil t) - (setq p (match-beginning 0)))) - (save-match-data - (when (re-search-forward regex-a nil t) - (setq a (match-end 0)))) - (and p a)) - - (save-excursion - - (goto-char p) - - (let* ((ctxt (semantic-analyze-current-context)) - (acomp - (condition-case nil - (semantic-analyze-possible-completions ctxt) - (error nil)))) - (setq actual (mapcar 'semantic-tag-name acomp))) - - (goto-char a) - - (let ((bss (buffer-substring-no-properties (point) (point-at-eol)))) - (condition-case nil - (setq desired (read bss)) - (error (setq desired (format " FAILED TO PARSE: %S" - bss))))) - - (if (equal actual desired) - (setq pass (cons idx pass)) - (setq fail (cons idx fail)) - (semantic-ia-utest-log - " Failed %d. Desired: %S Actual %S" - idx desired actual) - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx desired actual) - ) - - ) - ) - - (setq p nil a nil) - (setq idx (1+ idx))) - - (if fail - (progn - (semantic-ia-utest-log - " Unit tests (completions) failed tests %S" - (reverse fail)) - ) - (semantic-ia-utest-log " Unit tests (completions) passed (%d total)" - (- idx 1))) - - )) - -(defun semantic-ia-utest-buffer-refs () - "Run an analyze-refs unit-test pass in the current buffer." - - (let* ((idx 1) - (regex-p nil) - (p nil) - (pass nil) - (fail nil) - ;; Exclude unpredictable system files in the - ;; header include list. - (semanticdb-find-default-throttle - (remq 'system semanticdb-find-default-throttle)) - ) - ;; Keep looking for test points until we run out. - (while (save-excursion - (setq regex-p (concat "//\\s-*\\^" (number-to-string idx) "^" ) - ) - (goto-char (point-min)) - (save-match-data - (when (re-search-forward regex-p nil t) - (setq p (match-beginning 0)))) - p) - - (save-excursion - - (goto-char p) - (forward-char -1) - - (let* ((ct (semantic-current-tag)) - (refs (semantic-analyze-tag-references ct)) - (impl (semantic-analyze-refs-impl refs t)) - (proto (semantic-analyze-refs-proto refs t)) - (pf nil) - ) - (setq - pf - (catch 'failed - (if (and impl proto (car impl) (car proto)) - (let (ct2 ref2 impl2 proto2 - newstart) - (cond - ((semantic-equivalent-tag-p (car impl) ct) - ;; We are on an IMPL. Go To the proto, and find matches. - (semantic-go-to-tag (car proto)) - (setq newstart (car proto)) - ) - ((semantic-equivalent-tag-p (car proto) ct) - ;; We are on a PROTO. Go to the imple, and find matches - (semantic-go-to-tag (car impl)) - (setq newstart (car impl)) - ) - (t - ;; No matches is a fail. - (throw 'failed t) - )) - ;; Get the new tag, does it match? - (setq ct2 (semantic-current-tag)) - - ;; Does it match? - (when (not (semantic-equivalent-tag-p ct2 newstart)) - (throw 'failed t)) - - ;; Can we double-jump? - (setq ref2 (semantic-analyze-tag-references ct) - impl2 (semantic-analyze-refs-impl ref2 t) - proto2 (semantic-analyze-refs-proto ref2 t)) - - (when (or (not (and impl2 proto2)) - (not - (and (semantic-equivalent-tag-p - (car impl) (car impl2)) - (semantic-equivalent-tag-p - (car proto) (car proto2))))) - (throw 'failed t)) - ) - - ;; Else, no matches at all, so another fail. - (throw 'failed t) - ))) - - (if (not pf) - ;; We passed - (setq pass (cons idx pass)) - ;; We failed. - (setq fail (cons idx fail)) - (semantic-ia-utest-log - " Failed %d. For %s (Num impls %d) (Num protos %d)" - idx (if ct (semantic-tag-name ct) "") - (length impl) (length proto)) - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx) - ) - )) - - (setq p nil) - (setq idx (1+ idx)) - - )) - - (if fail - (progn - (semantic-ia-utest-log - " Unit tests (refs) failed tests") - ) - (semantic-ia-utest-log " Unit tests (refs) passed (%d total)" - (- idx 1))) - - )) - -(defun semantic-sr-utest-buffer-refs () - "Run a symref unit-test pass in the current buffer." - - ;; This line will also force the include, scope, and typecache. - (semantic-clear-toplevel-cache) - ;; Force tags to be parsed. - (semantic-fetch-tags) - - (let* ((idx 1) - (tag nil) - (regex-p nil) - (desired nil) - (actual-result nil) - (actual nil) - (pass nil) - (fail nil) - (symref-tool-used nil) - ;; Exclude unpredictable system files in the - ;; header include list. - (semanticdb-find-default-throttle - (remq 'system semanticdb-find-default-throttle)) - ) - ;; Keep looking for test points until we run out. - (while (save-excursion - (setq regex-p (concat "//\\s-*\\%" (number-to-string idx) "%" ) - ) - (goto-char (point-min)) - (save-match-data - (when (re-search-forward regex-p nil t) - (setq tag (semantic-current-tag)) - (goto-char (match-end 0)) - (setq desired (read (buffer-substring (point) (point-at-eol)))) - )) - tag) - - (setq actual-result (semantic-symref-find-references-by-name - (semantic-tag-name tag) 'target - 'symref-tool-used)) - - (if (not actual-result) - (progn - (setq fail (cons idx fail)) - (semantic-ia-utest-log - " Failed FNames %d: No results." idx) - (semantic-ia-utest-log - " Failed Tool: %s" (object-name symref-tool-used)) - - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx) - ) - ) - - (setq actual (list (sort (mapcar - 'file-name-nondirectory - (semantic-symref-result-get-files actual-result)) - 'string<) - (sort - (mapcar - 'semantic-format-tag-canonical-name - (semantic-symref-result-get-tags actual-result)) - 'string<))) - - - (if (equal desired actual) - ;; We passed - (setq pass (cons idx pass)) - ;; We failed. - (setq fail (cons idx fail)) - (when (not (equal (car actual) (car desired))) - (semantic-ia-utest-log - " Failed FNames %d: Actual: %S Desired: %S" - idx (car actual) (car desired)) - (semantic-ia-utest-log - " Failed Tool: %s" (object-name symref-tool-used)) - ) - (when (not (equal (car (cdr actual)) (car (cdr desired)))) - (semantic-ia-utest-log - " Failed TNames %d: Actual: %S Desired: %S" - idx (car (cdr actual)) (car (cdr desired))) - (semantic-ia-utest-log - " Failed Tool: %s" (object-name symref-tool-used)) - ) - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx) - ) - )) - - (setq idx (1+ idx)) - (setq tag nil)) - - (if fail - (progn - (semantic-ia-utest-log - " Unit tests (symrefs) failed tests") - ) - (semantic-ia-utest-log " Unit tests (symrefs) passed (%d total)" - (- idx 1))) - - )) - -(defun semantic-symref-test-count-hits-in-tag () - "Lookup in the current tag the symbol under point. -Then count all the other references to the same symbol within the -tag that contains point, and return that." - (interactive) - (let* ((ctxt (semantic-analyze-current-context)) - (target (car (reverse (oref ctxt prefix)))) - (tag (semantic-current-tag)) - (start (current-time)) - (Lcount 0)) - (when (semantic-tag-p target) - (semantic-symref-hits-in-region - target (lambda (start end prefix) (setq Lcount (1+ Lcount))) - (semantic-tag-start tag) - (semantic-tag-end tag)) - (when (interactive-p) - (message "Found %d occurrences of %s in %.2f seconds" - Lcount (semantic-tag-name target) - (semantic-elapsed-time start nil))) - Lcount))) - -(defun semantic-src-utest-buffer-refs () - "Run a sym-ref counting unit-test pass in the current buffer." - - ;; This line will also force the include, scope, and typecache. - (semantic-clear-toplevel-cache) - ;; Force tags to be parsed. - (semantic-fetch-tags) - - (let* ((idx 1) - (start nil) - (regex-p nil) - (desired nil) - (actual nil) - (pass nil) - (fail nil) - ;; Exclude unpredictable system files in the - ;; header include list. - (semanticdb-find-default-throttle - (remq 'system semanticdb-find-default-throttle)) - ) - ;; Keep looking for test points until we run out. - (while (save-excursion - (setq regex-p (concat "//\\s-*@" - (number-to-string idx) - "@\\s-+\\(\\w+\\)" )) - (goto-char (point-min)) - (save-match-data - (when (re-search-forward regex-p nil t) - (goto-char (match-beginning 1)) - (setq desired (read (buffer-substring (point) (point-at-eol)))) - (setq start (match-beginning 0)) - (goto-char start) - (setq actual (semantic-symref-test-count-hits-in-tag)) - start))) - - (if (not actual) - (progn - (setq fail (cons idx fail)) - (semantic-ia-utest-log - " Failed symref count %d: No results." idx) - - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx) - ) - ) - - (if (equal desired actual) - ;; We passed - (setq pass (cons idx pass)) - ;; We failed. - (setq fail (cons idx fail)) - (when (not (equal actual desired)) - (semantic-ia-utest-log - " Failed symref count %d: Actual: %S Desired: %S" - idx actual desired) - ) - - (add-to-list 'semantic-ia-utest-error-log-list - (list (buffer-name) idx) - ) - )) - - (setq idx (1+ idx)) - ) - - (if fail - (progn - (semantic-ia-utest-log - " Unit tests (symrefs counter) failed tests") - ) - (semantic-ia-utest-log " Unit tests (symrefs counter) passed (%d total)" - (- idx 1))) - - )) - -(defun semantic-ia-utest-start-log () - "Start up a testlog for a run." - ;; Redo w/ CEDET utest framework. - (cedet-utest-log-start "semantic: analyzer tests")) - -(defun semantic-ia-utest-log (&rest args) - "Log some test results. -Pass ARGS to format to create the log message." - ;; Forward to CEDET utest framework. - (apply 'cedet-utest-log args)) - -(provide 'semantic-ia-utest) - -;;; semantic-ia-utest.el ends here diff --git a/test/manual/cedet/semantic-utest-c.el b/test/manual/cedet/semantic-utest-c.el deleted file mode 100644 index a79c7c8822a..00000000000 --- a/test/manual/cedet/semantic-utest-c.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; semantic-utest-c.el --- C based parsing tests. - -;; Copyright (C) 2008-2019 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Run some C based parsing tests. - -(require 'semantic) - -(defvar semantic-utest-c-comparisons - '( ("testsppreplace.c" . "testsppreplaced.c") - ) - "List of files to parse and compare against each other.") - -;;; Code: -;;;###autoload -(defun semantic-utest-c () - "Run parsing test for C from the test directory." - (interactive) - (dolist (fp semantic-utest-c-comparisons) - (let* ((sem (locate-library "semantic")) - (sdir (file-name-directory sem)) - (semantic-lex-c-nested-namespace-ignore-second nil) - (tags-actual - (save-excursion - (set-buffer (find-file-noselect (expand-file-name (concat "tests/" (car fp)) sdir))) - (semantic-clear-toplevel-cache) - (semantic-fetch-tags))) - (tags-expected - (save-excursion - (set-buffer (find-file-noselect (expand-file-name (concat "tests/" (cdr fp)) sdir))) - (semantic-clear-toplevel-cache) - (semantic-fetch-tags)))) - ;; Now that we have the tags, compare them for SPP accuracy. - (dolist (tag tags-actual) - (if (and (semantic-tag-of-class-p tag 'variable) - (semantic-tag-variable-constant-p tag)) - nil ; skip the macros. - (if (semantic-tag-similar-with-subtags-p tag (car tags-expected)) - (setq tags-expected (cdr tags-expected)) - (with-mode-local c-mode - (error "Found: >> %s << Expected: >> %s <<" - (semantic-format-tag-prototype tag nil t) - (semantic-format-tag-prototype (car tags-expected) nil t) - ))) - )) - ;; Passed? - (message "PASSED!") - ))) - - -(provide 'semantic-utest-c) - -;;; semantic-utest-c.el ends here diff --git a/test/manual/cedet/semantic-utest.el b/test/manual/cedet/semantic-utest.el deleted file mode 100644 index 102c1283558..00000000000 --- a/test/manual/cedet/semantic-utest.el +++ /dev/null @@ -1,867 +0,0 @@ -;;; semantic-utest.el --- Tests for semantic's parsing system. - -;;; Copyright (C) 2003-2004, 2007-2019 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; Semantic's parsing and partial parsing system is pretty complex. -;; These unit tests attempt to emulate semantic's partial reparsing -;; and full reparsing system, and anything else I may feel the urge -;; to write a test for. - -(require 'semantic) - -(load-file "cedet-utests.el") - -(defvar semantic-utest-temp-directory (if (fboundp 'temp-directory) - (temp-directory) - temporary-file-directory) - "Temporary directory to use when creating files.") - -(defun semantic-utest-fname (name) - "Create a filename for NAME in /tmp." - (expand-file-name name semantic-utest-temp-directory)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for C tests - -(defvar semantic-utest-C-buffer-contents - "/* Test file for C language for Unit Tests */ - -#include -#include \"sutest.h\" - -struct mystruct1 { - int slot11; - char slot12; - float slot13; -}; - -int var1; - -float funp1(char arg11, char arg12); - -char fun2(int arg_21, int arg_22) /*1*/ -{ - struct mystruct1 *ms1 = malloc(sizeof(struct mystruct1)); - - char sv = calc_sv(var1); - - if (var1 == 0) { - sv = 1; - } else if (arg_21 == 0) { - sv = 2; - } else if (arg_22 == 0) { - sv = 3; - } else { - sv = 4; - } - - printf(\"SV = %d\\n\", sv); - - /* Memory Leak */ - ms1.slot1 = sv; - - return 'A' + sv; -} -" - "Contents of a C buffer initialized by this unit test. -Be sure to change `semantic-utest-C-name-contents' when you -change this variable.") - -(defvar semantic-utest-C-h-buffer-contents - "/* Test file for C language header file for Unit Tests */ - -int calc_sv(int); - -" - "Contents of a C header file buffer initialized by this unit test.") - -(defvar semantic-utest-C-filename (semantic-utest-fname "sutest.c") - "File to open and erase during this test for C.") - -(defvar semantic-utest-C-filename-h - (concat (file-name-sans-extension semantic-utest-C-filename) - ".h") - "Header file filename for C") - - -(defvar semantic-utest-C-name-contents - '(("stdio.h" include - (:system-flag t) - nil (overlay 48 66 "sutest.c")) - ("sutest.h" include nil nil (overlay 67 86 "sutest.c")) - ("mystruct1" type - (:members - (("slot11" variable - (:type "int") - (reparse-symbol classsubparts) - (overlay 109 120 "sutest.c")) - ("slot12" variable - (:type "char") - (reparse-symbol classsubparts) - (overlay 123 135 "sutest.c")) - ("slot13" variable - (:type "float") - (reparse-symbol classsubparts) - (overlay 138 151 "sutest.c"))) - :type "struct") - nil (overlay 88 154 "sutest.c")) - ("var1" variable - (:type "int") - nil (overlay 156 165 "sutest.c")) - ("funp1" function - (:prototype-flag t :arguments - (("arg11" variable - (:type "char") - (reparse-symbol arg-sub-list) - (overlay 179 190 "sutest.c")) - ("arg12" variable - (:type "char") - (reparse-symbol arg-sub-list) - (overlay 191 202 "sutest.c"))) - :type "float") - nil (overlay 167 203 "sutest.c")) - ("fun2" function - (:arguments - (("arg_21" variable - (:type "int") - (reparse-symbol arg-sub-list) - (overlay 215 226 "sutest.c")) - ("arg_22" variable - (:type "int") - (reparse-symbol arg-sub-list) - (overlay 227 238 "sutest.c"))) - :type "char") - nil (overlay 205 566 "sutest.c"))) - "List of expected tag names for C.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Python tests - -(defvar semantic-utest-Python-buffer-contents -" -def fun1(a,b,c): - return a - -def fun2(a,b,c): #1 - return b - -" - - -) -; "python test case. notice that python is indentation sensitive - - -(defvar semantic-utest-Python-name-contents - '(("fun1" function - (:arguments - (("a" variable nil - (reparse-symbol function_parameters) - (overlay 10 11 "tst.py")) - ("b" variable nil - (reparse-symbol function_parameters) - (overlay 12 13 "tst.py")) - ("c" variable nil - (reparse-symbol function_parameters) - (overlay 14 15 "tst.py")))) - nil (overlay 1 31 "tst.py")) - ("fun2" function - (:arguments - (("a" variable nil - (reparse-symbol function_parameters) - (overlay 41 42 "tst.py")) - ("b" variable nil - (reparse-symbol function_parameters) - (overlay 43 44 "tst.py")) - ("c" variable nil - (reparse-symbol function_parameters) - (overlay 45 46 "tst.py")))) - nil (overlay 32 65 "tst.py"))) - - "List of expected tag names for Python.") - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Java tests - -(defvar semantic-utest-Java-buffer-contents -" -class JavaTest{ - void fun1(int a,int b){ - return a; - } - - void fun2(int a,int b){ //1 - return b; - } - -} -" -) - -(defvar semantic-utest-Java-name-contents - '(("JavaTest" type - (:members - (("fun1" function - (:arguments - (("a" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 30 35 "JavaTest.java")) - ("b" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 36 41 "JavaTest.java"))) - :type "void") - (reparse-symbol class_member_declaration) - (overlay 20 61 "JavaTest.java")) - ("fun2" function - (:arguments - (("a" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 75 80 "JavaTest.java")) - ("b" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 81 86 "JavaTest.java"))) - :type "void") - (reparse-symbol class_member_declaration) - (overlay 65 110 "JavaTest.java"))) - :type "class") - nil (overlay 2 113 "JavaTest.java"))) - "List of expected tag names for Java." - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Javascript tests - -(defvar semantic-utest-Javascript-buffer-contents -" -function fun1(a, b){ - return a; - } - -function fun2(a,b){ //1 - return b; - } -" -) - - -(defvar semantic-utest-Javascript-name-contents - '(("fun1" function - (:arguments - (("a" variable nil - (reparse-symbol FormalParameterList) - (overlay 15 16 "tst.js")) - ("b" variable nil - (reparse-symbol FormalParameterList) - (overlay 18 19 "tst.js")))) - nil (overlay 1 39 "tst.js")) - ("fun2" function - (:arguments - (("a" variable nil - (reparse-symbol FormalParameterList) - (overlay 55 56 "tst.js")) - ("b" variable nil - (reparse-symbol FormalParameterList) - (overlay 57 58 "tst.js")))) - nil (overlay 41 82 "tst.js"))) - - "List of expected tag names for Javascript.") - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Makefile tests - -(defvar semantic-utest-Makefile-buffer-contents -" -t1: -\techo t1 - -t2:t1 #1 -\techo t2 - - -" -) - - -(defvar semantic-utest-Makefile-name-contents - '(("t1" function nil nil (overlay 1 9 "Makefile")) - ("t2" function - (:arguments - ("t1")) - nil (overlay 18 28 "Makefile"))) - "List of expected tag names for Makefile.") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Scheme tests - -(defvar semantic-utest-Scheme-buffer-contents - " - (define fun1 2) - - (define fun2 3 ;1 - ) -") - -(defvar semantic-utest-Scheme-name-contents - '(("fun1" variable - (:default-value ("2")) - nil (overlay 3 18 "tst.scm")) - ("fun2" variable - (:default-value ("3")) - nil (overlay 21 55 "tst.scm"))) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Html tests - -(defvar semantic-utest-Html-buffer-contents - " - - -

hello

- - -" - ) - -(defvar semantic-utest-Html-name-contents - '(("hello" section - (:members - (("hello" section nil nil (overlay 21 24 "tst.html")))) - nil (overlay 10 15 "tst.html"))) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for PHP tests - -(defvar semantic-utest-PHP-buffer-contents - " " - ) - -(defvar semantic-utest-PHP-name-contents - '(("fun1" function nil - nil (overlay 9 45 "phptest.php")) - ("fun2" function - (:arguments (("$arg1" variable nil (reparse-symbol formal_parameters) (overlay 61 66 "phptest.php")))) - nil - (overlay 47 132 "phptest.php")) - ("aClass" type - (:members (("fun1" function - (:typemodifiers ("public") :arguments - (("$a" variable nil (reparse-symbol formal_parameters) (overlay 174 176 "phptest.php")) - ("$b" variable nil (reparse-symbol formal_parameters) (overlay 178 180 "phptest.php")))) - - nil - (overlay 153 204 "phptest.php")) - - ("fun2" function - (:typemodifiers ("public") :arguments - (("$a" variable nil (reparse-symbol formal_parameters) (overlay 230 232 "phptest.php")) - ("$b" variable nil (reparse-symbol formal_parameters) (overlay 234 236 "phptest.php")) - )) - nil - (overlay 209 260 "phptest.php"))) :type "class") - nil - (overlay 135 262 "phptest.php")) - ) - "Expected results from the PHP Unit test" - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Data for Csharp C# tests - -(defvar semantic-utest-Csharp-buffer-contents -" -class someClass { - int fun1(int a, int b) { - return a; } - int fun2(int a, int b) { - return b; } -} -") - -(defvar semantic-utest-Csharp-name-contents - '(("someClass" type - (:members - (("fun1" function - (:arguments - (("a" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 30 35 "tst.cs")) - ("b" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 37 42 "tst.cs"))) - :type "int") - (reparse-symbol class_member_declaration) - (overlay 21 61 "tst.cs")) - ("fun2" function - (:arguments - (("a" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 73 78 "tst.cs")) - ("b" variable - (:type "int") - (reparse-symbol formal_parameters) - (overlay 80 85 "tst.cs"))) - :type "int") - (reparse-symbol class_member_declaration) - (overlay 64 104 "tst.cs"))) - :type "class") - nil (overlay 1 106 "tst.cs"))) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - -(defun semantic-utest-makebuffer (filename contents) - "Create a buffer for FILENAME for use in a unit test. -Pre-fill the buffer with CONTENTS." - (let ((buff (semantic-find-file-noselect filename))) - (set-buffer buff) - (setq buffer-offer-save nil) - (font-lock-mode -1) ;; Font lock has issues in Emacs 23 - (toggle-read-only -1) ;; In case /tmp doesn't exist. - (erase-buffer) - (insert contents) - ;(semantic-fetch-tags) ;JAVE could this go here? - (set-buffer-modified-p nil) - buff - ) - ) - -(defun semantic-utest-C () - "Run semantic's C unit test." - (interactive) - (save-excursion - (let ((buff (semantic-utest-makebuffer semantic-utest-C-filename semantic-utest-C-buffer-contents)) - (buff2 (semantic-utest-makebuffer semantic-utest-C-filename-h semantic-utest-C-h-buffer-contents)) - ) - (semantic-fetch-tags) - (set-buffer buff) - - ;; Turn off a range of modes - (semantic-idle-scheduler-mode -1) - - ;; Turn on some modes - (semantic-highlight-edits-mode 1) - - ;; Update tags, and show it. - (semantic-fetch-tags) - - (switch-to-buffer buff) - (sit-for 0) - - ;; Run the tests. - ;;(message "First parsing test.") - (semantic-utest-verify-names semantic-utest-C-name-contents) - - ;;(message "Invalid tag test.") - (semantic-utest-last-invalid semantic-utest-C-name-contents '("fun2") "/\\*1\\*/" "/* Deleted this line */") - (semantic-utest-verify-names semantic-utest-C-name-contents) - - (set-buffer-modified-p nil) - ;; Clean up - ;; (kill-buffer buff) - ;; (kill-buffer buff2) - )) - (message "All C tests passed.") - ) - - - - -(defun semantic-utest-generic (testname filename contents name-contents names-removed killme insertme) - "Generic unit test according to template. -Should work for languages without .h files, python javascript java. -TESTNAME is the name of the test. -FILENAME is the name of the file to create. -CONTENTS is the contents of the file to test. -NAME-CONTENTS is the list of names that should be in the contents. -NAMES-REMOVED is the list of names that gets removed in the removal step. -KILLME is the name of items to be killed. -INSERTME is the text to be inserted after the deletion." - (save-excursion - (let ((buff (semantic-utest-makebuffer filename contents)) - ) - ;; Turn off a range of modes - (semantic-idle-scheduler-mode -1) - - ;; Turn on some modes - (semantic-highlight-edits-mode 1) - - ;; Update tags, and show it. - (semantic-fetch-tags) - (switch-to-buffer buff) - (sit-for 0) - - ;; Run the tests. - ;;(message "First parsing test %s." testname) - (semantic-utest-verify-names name-contents) - - ;;(message "Invalid tag test %s." testname) - (semantic-utest-last-invalid name-contents names-removed killme insertme) - (semantic-utest-verify-names name-contents) - - (set-buffer-modified-p nil) - ;; Clean up - ;; (kill-buffer buff) - )) - (message "All %s tests passed." testname) - ) - -(defun semantic-utest-Python() - (interactive) - (if (fboundp 'python-mode) - (semantic-utest-generic "Python" (semantic-utest-fname "pytest.py") semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents '("fun2") "#1" "#deleted line") - (message "Skilling Python test: NO major mode.")) - ) - - -(defun semantic-utest-Javascript() - (interactive) - (if (fboundp 'javascript-mode) - (semantic-utest-generic "Javascript" (semantic-utest-fname "javascripttest.js") semantic-utest-Javascript-buffer-contents semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line") - (message "Skipping JavaScript test: NO major mode.")) - ) - -(defun semantic-utest-Java() - (interactive) - ;; If JDE is installed, it might mess things up depending on the version - ;; that was installed. - (let ((auto-mode-alist '(("\\.java\\'" . java-mode)))) - (semantic-utest-generic "Java" (semantic-utest-fname "JavaTest.java") semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents '("fun2") "//1" "//deleted line") - )) - -(defun semantic-utest-Makefile() - (interactive) - (semantic-utest-generic "Makefile" (semantic-utest-fname "Makefile") semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents '("fun2") "#1" "#deleted line") - ) - -(defun semantic-utest-Scheme() - (interactive) - (semantic-utest-generic "Scheme" (semantic-utest-fname "tst.scm") semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents '("fun2") ";1" ";deleted line") - ) - - -(defun semantic-utest-Html() - (interactive) - ;; Disable html-helper auto-fill-in mode. - (let ((html-helper-build-new-buffer nil)) - (semantic-utest-generic "HTML" (semantic-utest-fname "tst.html") semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents '("fun2") "" "") - )) - -(defun semantic-utest-PHP() - (interactive) - (if (fboundp 'php-mode) - (semantic-utest-generic "PHP" (semantic-utest-fname "phptest.php") semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1") "fun2" "%^@") - (message "Skipping PHP Test. No php-mode loaded.")) - ) - -;look at http://mfgames.com/linux/csharp-mode -(defun semantic-utest-Csharp() ;; hmm i don't even know how to edit a scharp file. need a csharp mode implementation i suppose - (interactive) - (if (fboundp 'csharp-mode) - (semantic-utest-generic "C#" (semantic-utest-fname "csharptest.cs") semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents '("fun2") "//1" "//deleted line") - (message "Skipping C# test. No csharp-mode loaded.")) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; stubs - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; stuff for Erlang -;;-module(hello). -;-export([hello_world/0]). -; -;hello_world()-> -; io:format("Hello World ~n"). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;(defun semantic-utest-Erlang() -; (interactive) -; (semantic-utest-generic "Erlang" (semantic-utest-fname "tst.erl") semantic-utest-Erlang-buffer-contents semantic-utest-Erlang-name-contents '("fun2") "//1" "//deleted line") -; ) -; -;;texi is also supported -;(defun semantic-utest-Texi() -; (interactive) -; (semantic-utest-generic "texi" (semantic-utest-fname "tst.texi") semantic-utest-Texi-buffer-contents semantic-utest-Texi-name-contents '("fun2") "//1" "//deleted line") -; ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;###autoload -(defun semantic-utest-main() - (interactive) - "call all utests" - (cedet-utest-log-start "multi-lang parsing") - (cedet-utest-log " * C tests...") - (semantic-utest-C) - (cedet-utest-log " * Python tests...") - (semantic-utest-Python) - (cedet-utest-log " * Java tests...") - (semantic-utest-Java) - (cedet-utest-log " * Javascript tests...") - (semantic-utest-Javascript) - (cedet-utest-log " * Makefile tests...") - (semantic-utest-Makefile) - (cedet-utest-log " * Scheme tests...") - (semantic-utest-Scheme) - (cedet-utest-log " * Html tests...") - (semantic-utest-Html) - (cedet-utest-log " * PHP tests...") - (semantic-utest-PHP) - (cedet-utest-log " * Csharp tests...") - (semantic-utest-Csharp) - - (cedet-utest-log-shutdown "multi-lang parsing") - ) - -;;; Buffer contents validation -;; -(defun semantic-utest-match-attributes (attr1 attr2 skipnames) - "Compare attribute lists ATTR1 and ATTR2. -Argument SKIPNAMES is a list of names that may be child nodes to skip." - (let ((res t)) - (while (and res attr1 attr2) - - ;; Compare - (setq res - (cond ((and (listp (car attr1)) - (semantic-tag-p (car (car attr1)))) - ;; Compare the list of tags... - (semantic-utest-taglists-equivalent-p - (car attr2) (car attr1) skipnames) - ) - (t - (equal (car attr1) (car attr2))))) - - (if (not res) - (error "TAG INTERNAL DIFF: %S %S" - (car attr1) (car attr2))) - - (setq attr1 (cdr attr1) - attr2 (cdr attr2))) - res)) - -(defun semantic-utest-equivalent-tag-p (tag1 tag2 skipnames) - "Determine if TAG1 and TAG2 are the same. -SKIPNAMES includes lists of possible child nodes that should be missing." - (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2)) - (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)) - (semantic-utest-match-attributes - (semantic-tag-attributes tag1) (semantic-tag-attributes tag2) - skipnames) - )) - -(defun semantic-utest-taglists-equivalent-p (table names skipnames) - "Compare TABLE and NAMES, where skipnames allow list1 to be different. -SKIPNAMES is a list of names that should be skipped in the NAMES list." - (let ((SN skipnames)) - (while SN - (setq names (remove (car SN) names)) - (setq SN (cdr SN)))) - (while (and names table) - (if (not (semantic-utest-equivalent-tag-p (car names) - (car table) - skipnames)) - (error "Expected %s, found %s" - (semantic-format-tag-prototype (car names)) - (semantic-format-tag-prototype (car table)))) - (setq names (cdr names) - table (cdr table))) - (when names (error "Items forgotten: %S" - (mapcar 'semantic-tag-name names) - )) - (when table (error "Items extra: %S" - (mapcar 'semantic-tag-name table))) - t) - -(defun semantic-utest-verify-names (name-contents &optional skipnames) - "Verify the names of the test buffer from NAME-CONTENTS. -Argument SKIPNAMES is a list of names that should be skipped -when analyzing the file. - -JAVE this thing would need to be recursive to handle java and csharp" - (let ((names name-contents) - (table (semantic-fetch-tags)) - ) - (semantic-utest-taglists-equivalent-p table names skipnames) - )) - -;;;;;;;;;;;;;;;;;;;;;;;; -; JAVE redefine a new validation function -; is not quite as good as the old one yet -(defun semantic-utest-verify-names-jave (name-contents &optional skipnames) - "JAVE version of `semantic-utest-verify-names'. -NAME-CONTENTS is a sample of the tags buffer to test against. -SKIPNAMES is a list of names to remove from NAME-CONTENTS" - (assert (semantic-utest-verify-names-2 name-contents (semantic-fetch-tags)) - nil "failed test") -) - -(defun semantic-utest-verify-names-2 (l1 l2) - (cond ( (and (consp l1) (equal (car l1) 'overlay)) - (overlayp l2)) - ((not (consp l1)) - (equal l1 l2)) - ((consp l1) - (and (semantic-utest-verify-names-2 (car l1) (car l2)) (semantic-utest-verify-names-2 (cdr l1) (cdr l2)))) - (t (error "internal error")))) - - - - - -;;; Kill indicator line -;; -(defvar semantic-utest-last-kill-text nil - "The text from the last kill.") - -(defvar semantic-utest-last-kill-pos nil - "The position of the last kill.") - -(defun semantic-utest-kill-indicator ( killme insertme) - "Kill the line with KILLME on it and insert INSERTME in its place." - (goto-char (point-min)) -; (re-search-forward (concat "/\\*" indicator "\\*/")); JAVE this isn't generic enough for different languages - (re-search-forward killme) - (beginning-of-line) - (setq semantic-utest-last-kill-pos (point)) - (setq semantic-utest-last-kill-text - (buffer-substring (point) (point-at-eol))) - (delete-region (point) (point-at-eol)) - (insert insertme) - (sit-for 0) -) - -(defun semantic-utest-unkill-indicator () - "Unkill the last indicator." - (goto-char semantic-utest-last-kill-pos) - (delete-region (point) (point-at-eol)) - (insert semantic-utest-last-kill-text) - (sit-for 0) - ) - -;;; EDITING TESTS -;; - -(defun semantic-utest-last-invalid (name-contents names-removed killme insertme) - "Make the last fcn invalid." - (semantic-utest-kill-indicator killme insertme) -; (semantic-utest-verify-names name-contents names-removed); verify its gone ;new validator doesn't handle skipnames yet - (semantic-utest-unkill-indicator);put back killed stuff - ) - - - - -;"#]*\\)>" -;#]*\)> -;(overlay \1 \2 "\3") - - -;; JAVE -;; these are some unit tests for cedet that I got from Eric and modified a bit for: -;; python -;; javascript -;; java -;; I tried to generalize the structure of the tests a bit to make it easier to add languages - -;; Mail from Eric: -;; Many items in the checklist look like: - -;; M-x global-semantic-highlight-edits-mode RET -;; - Edit a file. See the highlight of newly inserted text. -;; - Customize `semantic-edits-verbose-flag' to be non-nil. -;; - Wait for the idle scheduler, it should clean up the edits. -;; - observe messages from incremental parser. Do they relate -;; to the edits? -;; - M-x bovinate RET - verify your changes are reflected. - -;; It's all about watching the behavior. Timers go off, things get -;; cleaned up, you type in new changes, etc. An example I tried to -;; do is below, but covers only 1 language, and not very well at that. -;; I seem to remember seeing a unit test framework going by one of the -;; lists. I'm not sure if that would help. - -;; Another that might be automatable: - -;; M-x semantic-analyze-current-context RET -;; - Do this in different contexts in your language -;; files. Verify that reasonable results are returned -;; such as identification of assignments, function arguments, etc. - -;; Anyway, those are some ideas. Any effort you put it will be helpful! - -;; Thanks -;; Eric - -;; ----------- - - - -;;; semantic-utest.el ends here