emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master a99812e 1/7: Convert manual CEDET tests from test/m


From: Stefan Monnier
Subject: [Emacs-diffs] master a99812e 1/7: Convert manual CEDET tests from test/manual/cedet to be
Date: Tue, 15 Oct 2019 11:08:24 -0400 (EDT)

branch: master
commit a99812ee0fb7245d4ee3a862f3139c0a53a8c5d7
Author: Eric Ludlam <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Convert manual CEDET tests from test/manual/cedet to be
    
    automated tests in test/lisp/cedet.
    Author: Eric Ludlam <address@hidden>
---
 test/lisp/cedet/semantic-utest-c.el                | 181 +++++++++++
 .../cedet/semantic-utest-ia.el}                    | 339 ++++++++-------------
 test/{manual => lisp}/cedet/semantic-utest.el      | 200 ++++--------
 test/manual/cedet/semantic-utest-c.el              |  72 -----
 4 files changed, 370 insertions(+), 422 deletions(-)

diff --git a/test/lisp/cedet/semantic-utest-c.el 
b/test/lisp/cedet/semantic-utest-c.el
new file mode 100644
index 0000000..a6a5fd1
--- /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 <address@hidden>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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-chec [...]
+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 [...]
+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-ch [...]
+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/manual/cedet/semantic-ia-utest.el 
b/test/lisp/cedet/semantic-utest-ia.el
similarity index 59%
rename from test/manual/cedet/semantic-ia-utest.el
rename to test/lisp/cedet/semantic-utest-ia.el
index 10f02b3..f83a89a 100644
--- a/test/manual/cedet/semantic-ia-utest.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -1,4 +1,4 @@
-;;; semantic-ia-utest.el --- Analyzer unit tests
+;;; semantic-utest-ia.el --- Analyzer unit tests
 
 ;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
 
@@ -35,101 +35,77 @@
 (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"))
-      ))
-  )
+(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."
@@ -148,6 +124,7 @@ Argument ARG specifies which set of tests to run.
         (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) "-" )
@@ -182,29 +159,19 @@ Argument ARG specifies which set of tests to run.
 
        (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 fail (cons
+                      (list
+                       (format "Failed %d.  Desired: %S Actual %S"
+                              idx desired actual)
+                       )
+                      fail)))
 
       (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)))
-
+    (when fail
+      (cons "COMPLETION SUBTEST" fail))
     ))
 
 (defun semantic-ia-utest-buffer-refs ()
@@ -287,34 +254,22 @@ Argument ARG specifies which set of tests to run.
               (throw 'failed t)
               )))
 
-          (if (not pf)
+         (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) "<No tag found>")
-            (length impl) (length proto))
-           (add-to-list 'semantic-ia-utest-error-log-list
-                        (list (buffer-name) idx)
-                        )
+           (setq fail (cons
+                        (list
+                        (message "Test id %d.  For %s (Num impls %d) (Num 
protos %d)"
+                                 idx (if ct (semantic-tag-name ct) "<No tag 
found>")
+                                 (length impl) (length proto))
+                         )
+                        fail))
            ))
-
        (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)))
-
-    ))
+       (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."
@@ -358,14 +313,7 @@ Argument ARG specifies which set of tests to run.
       (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)
-                        )
+           (message "Failed Tool: %s" (eieio-object-name symref-tool-used))
            )
 
        (setq actual (list (sort (mapcar
@@ -383,38 +331,28 @@ Argument ARG specifies which set of tests to run.
            ;; 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 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))
 
-    (if fail
-       (progn
-         (semantic-ia-utest-log
-          "    Unit tests (symrefs) failed tests")
-         )
-      (semantic-ia-utest-log "    Unit tests (symrefs) passed (%d total)"
-                            (- idx 1)))
-
-    ))
+    (when fail
+      (cons "SYMREF SUBTEST" fail))))
 
 (defun semantic-symref-test-count-hits-in-tag ()
   "Lookup in the current tag the symbol under point.
@@ -431,10 +369,6 @@ tag that contains point, and return that."
        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 ()
@@ -474,54 +408,33 @@ tag that contains point, and return that."
 
       (if (not actual)
          (progn
-           (setq fail (cons idx fail))
-           (semantic-ia-utest-log
-            "  Failed symref count %d: No results." idx)
+           (setq fail (cons
+                        (list
+                        (format
+                         "Symref id %d: No results." idx))
+                         fail))
 
-           (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 fail (cons (list
+                           (when (not (equal actual desired))
+                             (format
+                              "Symref id %d: Actual: %S Desired: %S"
+                              idx actual desired)
+                             )
+                            )
+                           fail))
          ))
 
       (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))
+    (when fail
+      (cons "SYMREF COUNTING SUBTEST" fail))))
 
 (provide 'semantic-ia-utest)
 
diff --git a/test/manual/cedet/semantic-utest.el 
b/test/lisp/cedet/semantic-utest.el
similarity index 81%
rename from test/manual/cedet/semantic-utest.el
rename to test/lisp/cedet/semantic-utest.el
index 102c128..7303c0e 100644
--- a/test/manual/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -26,9 +26,17 @@
 ;; and full reparsing system, and anything else I may feel the urge
 ;; to write a test for.
 
+(require 'cedet)
 (require 'semantic)
 
-(load-file "cedet-utests.el")
+(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)
@@ -332,8 +340,8 @@ t2:t1 #1
   "
  (define fun1 2)
 
- (define fun2 3  ;1
-              )
+ (define fun2 3)  ;1
+
 ")
 
 (defvar semantic-utest-Scheme-name-contents
@@ -493,9 +501,9 @@ Pre-fill the buffer with CONTENTS."
     )
   )
 
-(defun semantic-utest-C ()
+(ert-deftest semantic-utest-C ()
   "Run semantic's C unit test."
-  (interactive)
+  (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))
@@ -512,24 +520,19 @@ Pre-fill the buffer with CONTENTS."
       ;; 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)
+      (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 */")
-      (semantic-utest-verify-names semantic-utest-C-name-contents)
+      (should (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.")
-  )
+      (kill-buffer buff)
+      (kill-buffer buff2)
+      )))
 
 
 
@@ -544,6 +547,7 @@ 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))
          )
@@ -554,79 +558,69 @@ INSERTME is the text to be inserted after the deletion."
       (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)
-      (semantic-utest-verify-names name-contents)
+      (should (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)
+      (should (semantic-utest-verify-names name-contents))
 
       (set-buffer-modified-p nil)
       ;; Clean up
-      ;; (kill-buffer buff)
-      ))
-  (message "All %s tests passed." testname)
-  )
+      (kill-buffer buff)
+      )))
 
-(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."))
-  )
+(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")
+    ))
 
 
-(defun semantic-utest-Javascript()
-  (interactive)
+(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."))
   )
 
-(defun semantic-utest-Java()
-  (interactive)
+(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")
     ))
 
-(defun semantic-utest-Makefile()
-  (interactive)
+(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")
   )
 
-(defun semantic-utest-Scheme()
-  (interactive)
+(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")
   )
 
 
-(defun semantic-utest-Html()
-  (interactive)
+(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") "<!--1-->" "<!--deleted line-->")
     ))
 
-(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."))
+(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
-(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."))
+(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")
   )
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -653,32 +647,6 @@ INSERTME is the text to be inserted after the deletion."
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;;;###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
 ;;
@@ -724,21 +692,25 @@ SKIPNAMES is a list of names that should be skipped in 
the NAMES list."
     (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)
+  (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.
@@ -778,6 +750,9 @@ SKIPNAMES is a list of names to remove from NAME-CONTENTS"
 
 ;;; 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.")
 
@@ -806,9 +781,6 @@ SKIPNAMES is a list of names to remove from NAME-CONTENTS"
   (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)
@@ -818,50 +790,4 @@ SKIPNAMES is a list of names to remove from NAME-CONTENTS"
 
 
 
-
-;"#<overlay from \\([0-9]+\\) to \\([0-9]+\\) in \\([^>]*\\)>"
-;#<overlay from \([0-9]+\) to \([0-9]+\) in \([^>]*\)>
-;(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
diff --git a/test/manual/cedet/semantic-utest-c.el 
b/test/manual/cedet/semantic-utest-c.el
deleted file mode 100644
index a79c7c8..0000000
--- 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 <address@hidden>
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]