From: Eric Ludlam Date: Mon, 28 Oct 2019 01:01:54 +0000 (-0400) Subject: * test/lisp/cedet/semantic-utest-ia.el: Update from upstream X-Git-Tag: emacs-27.0.90~793 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=cf59afb7e1403365a9cea4655e1c0c92fade2304;p=emacs.git * test/lisp/cedet/semantic-utest-ia.el: Update from upstream Merge content from CEDET on SF to bring in additional test points and support more types of languages. (semantic-utest-ia-struct.cpp, semantic-utest-ia-templates.cpp) (semantic-utest-ia-using.cpp, semantic-utest-ia-nsp.cpp) (semantic-utest-ia-localvars.cpp, semantic-utest-ia-varnamse.java) (semantic-utest-ia-wisent.wy, semantic-utest-ia-texi) (semantic-utest-ia-make, semantic-utest-ia-srecoder): New test points (semantic-ia-utest-buffer): Use comment-start-skip when looking for test point tokens. Capture errors ignoring debugger to enable test for empty results. Improve output from test diagnostics. (semantic-ia-utest-buffer-refs): Use comment-start-skip to find test point tokens. Author: Eric Ludlam --- diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el index f83a89a8683..61d7ea370e2 100644 --- a/test/lisp/cedet/semantic-utest-ia.el +++ b/test/lisp/cedet/semantic-utest-ia.el @@ -27,6 +27,7 @@ ;; Each file has cursor keys in them of the form: ;; // -#- ("ans1" "ans2" ) ;; where # is 1, 2, 3, etc, and some sort of answer list. +;; (Replace // with contents of comment-start for the language being tested.) ;;; Code: (require 'semantic) @@ -59,8 +60,38 @@ (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))) +(ert-deftest semantic-utest-ia-struct.cpp () + (let ((tst (expand-file-name "teststruct.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +;;(ert-deftest semantic-utest-ia-union.cpp () +;; (let ((tst (expand-file-name "testunion.cpp" semantic-utest-test-directory))) +;; (should (file-exists-p tst)) +;; (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-templates.cpp () + (let ((tst (expand-file-name "testtemplates.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-using.cpp () + (let ((tst (expand-file-name "testusing.cpp" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-nsp.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-localvars.cpp () + (let ((tst (expand-file-name "testlocalvars.cpp" semantic-utest-test-directory))) (should (file-exists-p tst)) (should-not (semantic-ia-utest tst)))) @@ -84,6 +115,36 @@ (should (file-exists-p tst)) (should-not (semantic-ia-utest tst)))) +(ert-deftest semantic-utest-ia-varnamse.java () + (let ((tst (expand-file-name "testvarnames.java" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +;;(ert-deftest semantic-utest-ia-f90.f90 () +;; (let ((tst (expand-file-name "testf90.f90" semantic-utest-test-directory))) +;; (should (file-exists-p tst)) +;; (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-wisent.wy () + (let ((tst (expand-file-name "testwisent.wy" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-texi () + (let ((tst (expand-file-name "test.texi" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-make () + (let ((tst (expand-file-name "test.mk" semantic-utest-test-directory))) + (should (file-exists-p tst)) + (should-not (semantic-ia-utest tst)))) + +(ert-deftest semantic-utest-ia-srecoder () + (let ((tst (expand-file-name "test.srt" 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." @@ -127,8 +188,10 @@ ;; 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) "#" )) + (setq regex-p (concat "\\(" comment-start-skip "\\)\\s-*-" + (number-to-string idx) "-" ) + regex-a (concat "\\(" comment-start-skip "\\)\\s-*#" + (number-to-string idx) "#" )) (goto-char (point-min)) (save-match-data (when (re-search-forward regex-p nil t) @@ -141,13 +204,18 @@ (save-excursion (goto-char p) + (skip-chars-backward " ") ;; some languages need a space. (let* ((ctxt (semantic-analyze-current-context)) + ;; TODO - fix the NOTFOUND case to be nil and not an error when finding + ;; completions, then remove the below debug-on-error setting. + (debug-on-error nil) (acomp - (condition-case nil + (condition-case err (semantic-analyze-possible-completions ctxt) - (error nil)))) - (setq actual (mapcar 'semantic-tag-name acomp))) + ((error user-error) nil)) + )) + (setq actual (mapcar 'semantic-format-tag-name acomp))) (goto-char a) @@ -157,8 +225,14 @@ (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)) + (prog1 + (setq pass (cons idx pass)) + ;;(message "PASS: %S" actual) + ) (setq fail (cons (list (format "Failed %d. Desired: %S Actual %S" @@ -171,7 +245,7 @@ ) (when fail - (cons "COMPLETION SUBTEST" fail)) + (cons "COMPLETION SUBTEST" (reverse fail))) )) (defun semantic-ia-utest-buffer-refs () @@ -189,7 +263,8 @@ ) ;; Keep looking for test points until we run out. (while (save-excursion - (setq regex-p (concat "//\\s-*\\^" (number-to-string idx) "^" ) + (setq regex-p (concat "\\(" comment-start-skip + "\\)\\s-*\\^" (number-to-string idx) "^" ) ) (goto-char (point-min)) (save-match-data @@ -295,7 +370,8 @@ ) ;; Keep looking for test points until we run out. (while (save-excursion - (setq regex-p (concat "//\\s-*\\%" (number-to-string idx) "%" ) + (setq regex-p (concat "\\(" comment-start-skip "\\)\\s-*\\%" + (number-to-string idx) "%" ) ) (goto-char (point-min)) (save-match-data @@ -307,7 +383,7 @@ tag) (setq actual-result (semantic-symref-find-references-by-name - (semantic-tag-name tag) 'target + (semantic-format-tag-name tag) 'target 'symref-tool-used)) (if (not actual-result) @@ -393,13 +469,14 @@ tag that contains point, and return that." ) ;; Keep looking for test points until we run out. (while (save-excursion - (setq regex-p (concat "//\\s-*@" + (setq regex-p (concat "\\(" comment-start-skip "\\)\\s-*@" (number-to-string idx) - "@\\s-+\\(\\w+\\)" )) + "@\\s-+\\w+" )) (goto-char (point-min)) (save-match-data (when (re-search-forward regex-p nil t) - (goto-char (match-beginning 1)) + (goto-char (match-end 0)) + (skip-syntax-backward "w") (setq desired (read (buffer-substring (point) (point-at-eol)))) (setq start (match-beginning 0)) (goto-char start)