[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/merge-cedet-tests 743c553 294/316: Move tests in c
From: |
Edward John Steere |
Subject: |
[Emacs-diffs] scratch/merge-cedet-tests 743c553 294/316: Move tests in cedet/semantic |
Date: |
Sat, 28 Jan 2017 09:10:12 +0000 (UTC) |
branch: scratch/merge-cedet-tests
commit 743c553c541a850683aa7fd65fc720f24f88d291
Author: xscript <address@hidden>
Commit: Edward John Steere <address@hidden>
Move tests in cedet/semantic
---
test/manual/cedet/cedet/semantic/ia-utest.el | 542 ++++++++++++++++++++++++++
1 file changed, 542 insertions(+)
diff --git a/test/manual/cedet/cedet/semantic/ia-utest.el
b/test/manual/cedet/cedet/semantic/ia-utest.el
new file mode 100644
index 0000000..b11cf5f
--- /dev/null
+++ b/test/manual/cedet/cedet/semantic/ia-utest.el
@@ -0,0 +1,542 @@
+;;; semantic/ia-utest.el --- Analyzer unit tests
+
+;; Copyright (C) 2008, 2009, 2010 Eric M. Ludlam
+
+;; Author: Eric M. Ludlam <address@hidden>
+
+;; This program 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 2, or (at
+;; your option) any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; 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 'cedet-utests)
+(require 'semantic)
+(require 'semantic/analyze)
+(require 'semantic/analyze/refs)
+(require 'semantic/symref)
+(require 'semantic/symref/filter)
+
+(defvar semantic-ia-utest-file-list
+ '(
+ "tests/testdoublens.cpp"
+ "tests/testsubclass.cpp"
+ "tests/testtypedefs.cpp"
+ "tests/teststruct.cpp"
+ "tests/testtemplates.cpp"
+ "tests/testfriends.cpp"
+ "tests/testusing.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 occuring 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
+ (locate-library "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-ia-utest-ffns (car fl))))
+
+ (when b
+ ;; 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 (and b (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-ffns (file)
+ "Call `semantic-find-file-noselect' on FILE safely.
+Be robust to non CC modes throwing errors.
+Return a buffer if successful, or nil if error.
+If the error occurs w/ a C or C++ file, rethrow the error."
+ (condition-case e
+ (let ((buff (semantic-find-file-noselect file t)))
+ ;; Make current for tests...
+ (save-excursion
+ (set-buffer buff)
+ ;; Was semantic initialized?
+ (if (semantic-active-p)
+ buff
+ ;; No support?
+ (error "No semantic support."))
+ ))
+ (error
+ (let ((fe (file-name-extension file)))
+ (cond ((or (string= fe ".c") (string= fe ".cpp"))
+ ;; Rethrow for C, no tolerance for error.
+ (error e))
+ (t
+ (message
+ "Skipping tests for %s due to missing underlying mode support."
+ file)
+ nil))))
+ ))
+
+(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-format-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)))))
+
+ (setq actual (sort actual 'string<))
+ (setq desired (sort desired 'string<))
+
+ (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 a 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 (Impls %S) (Protos %S)"
+ idx
+ (if ct (semantic-format-tag-name ct) "<No tag found>")
+ (mapcar 'semantic-format-tag-name impl)
+ (mapcar 'semantic-format-tag-name 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-format-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-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
- [Emacs-diffs] scratch/merge-cedet-tests 9d2c338 251/316: New test file., (continued)
- [Emacs-diffs] scratch/merge-cedet-tests 9d2c338 251/316: New test file., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests a60b900 267/316: Fix provide., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests fba6409 297/316: Add test for parsing local variables, Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 27001fd 271/316: Accept the make-tipe argument to control tests, Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 28e2c81 239/316: (cit-remove-and-do-shared-lib): New., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 6f76589 250/316: Synchronize cedet/semantic with Emacs., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 802df00 246/316: Enable global to find hh and hpp files, Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 3651195 269/316: Added test functions, Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 1e14f6f 226/316: New setup testing., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 59e7c3e 237/316: Patch from David Engster, Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 743c553 294/316: Move tests in cedet/semantic,
Edward John Steere <=
- [Emacs-diffs] scratch/merge-cedet-tests 2ce4443 307/316: (cit-globalref-test): Note where the test is occuring., Edward John Steere, 2017/01/28
- [Emacs-diffs] scratch/merge-cedet-tests 5b8af47 283/316: * tests/cit-externaldb.el: Fix requires., Edward John Steere, 2017/01/28