diff options
Diffstat (limited to 'test/manual/cedet')
24 files changed, 156 insertions, 3118 deletions
diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index 19a144f2abb..b365908c639 100644 --- a/test/manual/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el @@ -1,8 +1,8 @@ -;;; cedet-utests.el --- Run all unit tests in the CEDET suite. +;;; cedet-utests.el --- Run all unit tests in the CEDET suite. -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2017 Free Software Foundation, Inc. +;; Copyright (C) 2008-2022 Free Software Foundation, Inc. -;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Author: Eric M. Ludlam <zappo@gnu.org> ;; This file is part of GNU Emacs. @@ -26,6 +26,18 @@ ;; into one command. (require 'cedet) + +(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 cedet-utest-libs '("ede-tests" + "semantic-tests" + ) + "List of test srcs that need to be loaded.") + ;;; Code: (defvar cedet-utest-test-alist '( @@ -34,30 +46,35 @@ ;; ;; Test inversion - ("inversion" . inversion-unit-test) + ;; ("inversion" . inversion-unit-test) ; moved to automated suite ;; EZ Image dumping. ("ezimage associations" . ezimage-image-association-dump) - ("ezimage images" . ezimage-image-dump) + ("ezimage images" . (lambda () + (ezimage-image-dump) + (kill-buffer "*Ezimage Images*"))) ;; Pulse ("pulse interactive test" . (lambda () (pulse-test t))) ;; Files - ("cedet file conversion" . cedet-files-utest) + ;; ("cedet file conversion" . cedet-files-utest) ; moved to automated suite ;; ;; EIEIO ;; - ("eieio" . (lambda () (let ((lib (locate-library "eieio-tests.el" - t))) - (load-file lib)))) - ("eieio: browser" . eieio-browse) + + ("eieio: browser" . (lambda () + (eieio-browse) + (kill-buffer "*EIEIO OBJECT BROWSE*"))) ("eieio: custom" . (lambda () (require 'eieio-custom) - (customize-variable 'eieio-widget-test))) + (customize-variable 'eieio-widget-test) + (kill-buffer "*Customize Option: Eieio Widget Test*") + )) ("eieio: chart" . (lambda () - (if (cedet-utest-noninteractive) + (require 'chart) + (if noninteractive (message " ** Skipping test in noninteractive mode.") (chart-test-it-all)))) ;; @@ -71,24 +88,27 @@ ;; SEMANTIC ;; ("semantic: lex spp table write" . semantic-lex-spp-write-utest) - ("semantic: multi-lang parsing" . semantic-utest-main) - ("semantic: C preprocessor" . semantic-utest-c) - ("semantic: analyzer tests" . semantic-ia-utest) + ;;("semantic: multi-lang parsing" . semantic-utest-main) + ;;("semantic: C preprocessor" . semantic-utest-c) - Now in automated suite + ;;("semantic: analyzer tests" . semantic-ia-utest) ("semanticdb: data cache" . semantic-test-data-cache) ("semantic: throw-on-input" . (lambda () - (if (cedet-utest-noninteractive) + (if noninteractive (message " ** Skipping test in noninteractive mode.") (semantic-test-throw-on-input)))) - ("semantic: gcc: output parse test" . semantic-gcc-test-output-parser) + ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser) ; moved to automated suite + ;; ;; SRECODE ;; - ("srecode: fields" . srecode-field-utest) - ("srecode: templates" . srecode-utest-template-output) + + ;; TODO - fix the fields test + ;;("srecode: fields" . srecode-field-utest) ; moved to automated suite + ;;("srecode: templates" . srecode-utest-template-output) ("srecode: show maps" . srecode-get-maps) - ("srecode: getset" . srecode-utest-getset-output) + ;;("srecode: getset" . srecode-utest-getset-output) ) "Alist of all the tests in CEDET we should run.") @@ -100,9 +120,11 @@ EXIT-ON-ERROR causes the test suite to exit on an error, instead of just logging the error." (interactive) - (if (or (not (featurep 'semanticdb-mode)) - (not (semanticdb-minor-mode-p))) - (error "CEDET Tests require: M-x semantic-load-enable-minimum-features")) + (unless (and (fboundp 'semanticdb-minor-mode-p) + (semanticdb-minor-mode-p)) + (error "CEDET Tests require semantic-mode to be enabled")) + (dolist (L cedet-utest-libs) + (load-file (expand-file-name (concat L ".el") cedet-utest-directory))) (cedet-utest-log-setup "ALL TESTS") (let ((tl cedet-utest-test-alist) (notes nil) @@ -126,7 +148,7 @@ of just logging the error." ;; Cleanup stray input and events that are in the way. ;; Not doing this causes sit-for to not refresh the screen. ;; Doing this causes the user to need to press keys more frequently. - (when (and (interactive-p) (input-pending-p)) + (when (and (called-interactively-p 'interactive) (input-pending-p)) (if (fboundp 'read-event) (read-event) (read-char))) @@ -145,18 +167,20 @@ of just logging the error." (defun cedet-utest-noninteractive () "Return non-nil if running non-interactively." - (if (featurep 'xemacs) - (noninteractive) - noninteractive)) + (declare (obsolete nil "27.1")) + noninteractive) + +(defvar srecode-map-save-file) ;;;###autoload (defun cedet-utest-batch () "Run the CEDET unit test in BATCH mode." - (unless (cedet-utest-noninteractive) + (unless noninteractive (error "`cedet-utest-batch' is to be used only with -batch")) (condition-case err (when (catch 'cedet-utest-exit-on-error ;; Get basic semantic features up. + ;; FIXME: I can't see any such function in our code! (semantic-load-enable-minimum-features) ;; Disables all caches related to semantic DB so all ;; tests run as if we have bootstrapped CEDET for the @@ -200,7 +224,7 @@ of just logging the error." "Setup a frame and buffer for unit testing. Optional argument TITLE is the title of this testing session." (setq cedet-utest-log-timer (current-time)) - (if (cedet-utest-noninteractive) + (if noninteractive (message "\n>> Setting up %s tests to run @ %s\n" (or title "") (current-time-string)) @@ -210,8 +234,7 @@ Optional argument TITLE is the title of this testing session." (setq cedet-utest-frame (make-frame cedet-utest-frame-parameters))) (when (or (not cedet-utest-buffer) (not (buffer-live-p cedet-utest-buffer))) (setq cedet-utest-buffer (get-buffer-create "*CEDET utest log*"))) - (save-excursion - (set-buffer cedet-utest-buffer) + (with-current-buffer cedet-utest-buffer (setq cedet-utest-last-log-item nil) (when (not cedet-running-master-tests) (erase-buffer)) @@ -229,11 +252,9 @@ Optional argument TITLE is the title of this testing session." (defun cedet-utest-elapsed-time (start end) "Copied from elp.el. Was elp-elapsed-time. Argument START and END bound the time being calculated." - (+ (* (- (car end) (car start)) 65536.0) - (- (car (cdr end)) (car (cdr start))) - (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) + (float-time (time-subtract start end))) -(defun cedet-utest-log-shutdown (title &optional errorcondition) +(defun cedet-utest-log-shutdown (title &optional _errorcondition) "Shut-down a larger test suite. TITLE is the section that is done. ERRORCONDITION is some error that may have occurred during testing." @@ -245,7 +266,7 @@ ERRORCONDITION is some error that may have occurred during testing." (defun cedet-utest-log-shutdown-msg (title startime endtime) "Show a shutdown message with TITLE, STARTIME, and ENDTIME." - (if (cedet-utest-noninteractive) + (if noninteractive (progn (message "\n>> Test Suite %s ended at @ %s" title @@ -253,8 +274,7 @@ ERRORCONDITION is some error that may have occurred during testing." (message " Elapsed Time %.2f Seconds\n" (cedet-utest-elapsed-time startime endtime))) - (save-excursion - (set-buffer cedet-utest-buffer) + (with-current-buffer cedet-utest-buffer (goto-char (point-max)) (insert "\n>> Test Suite " title " ended at @ " (format-time-string "%c" endtime) "\n" @@ -266,7 +286,7 @@ ERRORCONDITION is some error that may have occurred during testing." (defun cedet-utest-show-log-end () "Show the end of the current unit test log." - (unless (cedet-utest-noninteractive) + (unless noninteractive (let* ((cb (current-buffer)) (cf (selected-frame)) (bw (or (get-buffer-window cedet-utest-buffer t) @@ -282,14 +302,13 @@ ERRORCONDITION is some error that may have occurred during testing." (defun cedet-utest-post-command-hook () "Hook run after the current log command was run." - (if (cedet-utest-noninteractive) + (if noninteractive (message "") - (save-excursion - (set-buffer cedet-utest-buffer) + (with-current-buffer cedet-utest-buffer (goto-char (point-max)) (insert "\n\n"))) (setq cedet-utest-last-log-item nil) - (remove-hook 'post-command-hook 'cedet-utest-post-command-hook) + (remove-hook 'post-command-hook #'cedet-utest-post-command-hook) ) (defun cedet-utest-add-log-item-start (item) @@ -297,12 +316,11 @@ ERRORCONDITION is some error that may have occurred during testing." (unless (equal item cedet-utest-last-log-item) (setq cedet-utest-last-log-item item) ;; This next line makes sure we clear out status during logging. - (add-hook 'post-command-hook 'cedet-utest-post-command-hook) + (add-hook 'post-command-hook #'cedet-utest-post-command-hook) - (if (cedet-utest-noninteractive) + (if noninteractive (message " - Running %s ..." item) - (save-excursion - (set-buffer cedet-utest-buffer) + (with-current-buffer cedet-utest-buffer (goto-char (point-max)) (when (not (bolp)) (insert "\n")) (insert "Running " item " ... ") @@ -316,14 +334,13 @@ ERRORCONDITION is some error that may have occurred during testing." Apply NOTES to the doneness of the log. Apply ERR if there was an error in previous item. Optional argument PRECR indicates to prefix the done msg w/ a newline." - (if (cedet-utest-noninteractive) + (if noninteractive ;; Non-interactive-mode - show a message. (if notes (message " * %s {%s}" (or err "done") notes) (message " * %s" (or err "done"))) ;; Interactive-mode - insert into the buffer. - (save-excursion - (set-buffer cedet-utest-buffer) + (with-current-buffer cedet-utest-buffer (goto-char (point-max)) (when precr (insert "\n")) (if err @@ -353,132 +370,42 @@ Optional argument PRECR indicates to prefix the done msg w/ a newline." (cedet-utest-add-log-item-start testname) )) -(defun cedet-utest-log(format &rest args) +(defun cedet-utest-log (format &rest args) "Log the text string FORMAT. The rest of the ARGS are used to fill in FORMAT with `format'." - (if (cedet-utest-noninteractive) - (apply 'message format args) - (save-excursion - (set-buffer cedet-utest-buffer) + (if noninteractive + (apply #'message format args) + (with-current-buffer cedet-utest-buffer (goto-char (point-max)) (when (not (bolp)) (insert "\n")) - (insert (apply 'format format args)) + (insert (apply #'format format args)) (insert "\n") (sit-for 0) )) (cedet-utest-show-log-end) ) -;;; Inversion tests - -(defun inversion-unit-test () - "Test inversion to make sure it can identify different version strings." - (interactive) - (let ((c1 (inversion-package-version 'inversion)) - (c1i (inversion-package-incompatibility-version 'inversion)) - (c2 (inversion-decode-version "1.3alpha2")) - (c3 (inversion-decode-version "1.3beta4")) - (c4 (inversion-decode-version "1.3 beta5")) - (c5 (inversion-decode-version "1.3.4")) - (c6 (inversion-decode-version "2.3alpha")) - (c7 (inversion-decode-version "1.3")) - (c8 (inversion-decode-version "1.3pre1")) - (c9 (inversion-decode-version "2.4 (patch 2)")) - (c10 (inversion-decode-version "2.4 (patch 3)")) - (c11 (inversion-decode-version "2.4.2.1")) - (c12 (inversion-decode-version "2.4.2.2")) - ) - (if (not (and - (inversion-= c1 c1) - (inversion-< c1i c1) - (inversion-< c2 c3) - (inversion-< c3 c4) - (inversion-< c4 c5) - (inversion-< c5 c6) - (inversion-< c2 c4) - (inversion-< c2 c5) - (inversion-< c2 c6) - (inversion-< c3 c5) - (inversion-< c3 c6) - (inversion-< c7 c6) - (inversion-< c4 c7) - (inversion-< c2 c7) - (inversion-< c8 c6) - (inversion-< c8 c7) - (inversion-< c4 c8) - (inversion-< c2 c8) - (inversion-< c9 c10) - (inversion-< c10 c11) - (inversion-< c11 c12) - ;; Negatives - (not (inversion-< c3 c2)) - (not (inversion-< c4 c3)) - (not (inversion-< c5 c4)) - (not (inversion-< c6 c5)) - (not (inversion-< c7 c2)) - (not (inversion-< c7 c8)) - (not (inversion-< c12 c11)) - ;; Test the tester on inversion - (not (inversion-test 'inversion inversion-version)) - ;; Test that we throw an error - (inversion-test 'inversion "0.0.0") - (inversion-test 'inversion "1000.0") - )) - (error "Inversion tests failed") - (message "Inversion tests passed.")))) - -;;; cedet-files unit test - -(defvar cedet-files-utest-list - '( - ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" ) - ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" ) - ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" ) - ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" ) - ) - "List of different file names to test. -Each entry is a cons cell of ( FNAME . CONVERTED ) -where FNAME is some file name, and CONVERTED is what it should be -converted into.") - -(defun cedet-files-utest () - "Test out some file name conversions." - (interactive) - (let ((idx 0)) - (dolist (FT cedet-files-utest-list) - - (setq idx (+ idx 1)) - - (let ((dir->file (cedet-directory-name-to-file-name (car FT) t)) - (file->dir (cedet-file-name-to-directory-name (cdr FT) t)) - ) - - (unless (string= (cdr FT) dir->file) - (error "Failed: %d. Found: %S Wanted: %S" - idx dir->file (cdr FT)) - ) - - (unless (string= file->dir (car FT)) - (error "Failed: %d. Found: %S Wanted: %S" - idx file->dir (car FT))))))) - ;;; pulse test (defun pulse-test (&optional no-error) "Test the lightening function for pulsing a line. When optional NO-ERROR don't throw an error if we can't run tests." (interactive) - (if (or (not pulse-flag) (not (pulse-available-p))) + (if (not (and (bound-and-true-p pulse-flag) + (fboundp 'pulse-available-p) + (pulse-available-p))) (if no-error nil (error (concat "Pulse test only works on versions of Emacs" " that support pulsing"))) + (declare-function pulse-momentary-highlight-overlay + "pulse.el" (o &optional face)) ;; Run the tests - (when (interactive-p) + (when (called-interactively-p 'interactive) (message "<Press a key> Pulse one line.") (read-char)) (pulse-momentary-highlight-one-line (point)) - (when (interactive-p) + (when (called-interactively-p 'interactive) (message "<Press a key> Pulse a region.") (read-char)) (pulse-momentary-highlight-region (point) @@ -487,11 +414,11 @@ When optional NO-ERROR don't throw an error if we can't run tests." (forward-char 30) (error nil)) (point))) - (when (interactive-p) + (when (called-interactively-p 'interactive) (message "<Press a key> Pulse line a specific color.") (read-char)) - (pulse-momentary-highlight-one-line (point) 'modeline) - (when (interactive-p) + (pulse-momentary-highlight-one-line (point) 'mode-line) + (when (called-interactively-p 'interactive) (message "<Press a key> Pulse a pre-existing overlay.") (read-char)) (let* ((start (point-at-bol)) @@ -507,7 +434,7 @@ When optional NO-ERROR don't throw an error if we can't run tests." (delete-overlay o) (error "Non-temporary overlay was deleted!")) ) - (when (interactive-p) + (when (called-interactively-p 'interactive) (message "Done!")))) (provide 'cedet-utests) diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el index e24bdf7f9f0..c23e0984816 100644 --- a/test/manual/cedet/ede-tests.el +++ b/test/manual/cedet/ede-tests.el @@ -1,8 +1,8 @@ -;;; ede-tests.el --- Some tests for the Emacs Development Environment +;;; ede-tests.el --- Some tests for the Emacs Development Environment -*- lexical-binding: t -*- -;; Copyright (C) 2008-2017 Free Software Foundation, Inc. +;; Copyright (C) 2008-2022 Free Software Foundation, Inc. -;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Author: Eric M. Ludlam <zappo@gnu.org> ;; This file is part of GNU Emacs. @@ -42,8 +42,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-global (file) "Test EDE Locate on FILE using GNU Global type. @@ -55,8 +54,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-idutils (file) "Test EDE Locate on FILE using ID Utils type. @@ -68,8 +66,7 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) (defun ede-locate-test-cscope (file) "Test EDE Locate on FILE using CScope type. @@ -81,7 +78,6 @@ The search is done with the current EDE root." (ede-toplevel))))) (data-debug-new-buffer "*EDE Locate ADEBUG*") (ede-locate-file-in-project loc file) - (data-debug-insert-object-slots loc "]")) - ) + (data-debug-insert-object-slots loc "]"))) -;;; ede-test.el ends here +;;; ede-tests.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 7861fd73949..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-2017 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <eric@siege-engine.com> - -;; 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: -;; -;; 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) "<No tag found>") - (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 (current-time)))) - 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-tests.el b/test/manual/cedet/semantic-tests.el index 3a19328ac79..dcdeb45b0a3 100644 --- a/test/manual/cedet/semantic-tests.el +++ b/test/manual/cedet/semantic-tests.el @@ -1,6 +1,6 @@ -;;; semantic-utest.el --- Miscellaneous Semantic tests. +;;; semantic-tests.el --- Miscellaneous Semantic tests. -*- lexical-binding: t; -*- -;;; Copyright (C) 2003-2004, 2007-2017 Free Software Foundation, Inc. +;; Copyright (C) 2003-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -24,6 +24,8 @@ ;; Originally, there are many test functions scattered among the ;; Semantic source files. This file consolidates them. +;;; Code: + (require 'data-debug) ;;; From semantic-complete @@ -46,7 +48,7 @@ All systems are different. Ask questions along the way." (interactive) (let ((doload nil)) - (when (y-or-n-p "Create a system database to test with? ") + (when (y-or-n-p "Create a system database to test with?") (call-interactively 'semanticdb-create-ebrowse-database) (setq doload t)) ;; Should we load in caches @@ -64,10 +66,12 @@ run the test again"))) "Find the first loaded ebrowse table, and dump out the contents." (interactive) (let ((db semanticdb-database-list) - (ab nil)) + ;; (ab nil) + ) (while db (when (semanticdb-project-database-ebrowse-p (car db)) - (setq ab (data-debug-new-buffer "*EBROWSE Database*")) + ;; (setq ab + (data-debug-new-buffer "*EBROWSE Database*") ;;) (data-debug-insert-thing (car db) "*" "") (setq db nil) ) @@ -100,7 +104,7 @@ If optional arg STANDARDFILE is non-nil, use a standard file w/ global enabled." (set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile))) (semanticdb-enable-gnu-global-in-buffer)))) - (let* ((db (semanticdb-project-database-global "global")) + (let* ((db (semanticdb-project-database-global)) ;; "global" (tab (semanticdb-file-table db (buffer-file-name))) (result (semanticdb-deep-find-tags-for-completion-method tab searchfor)) ) @@ -127,8 +131,7 @@ Optional argument ARG specifies not to use color." (princ (car fns)) (princ ":\n ") (let ((s (funcall (car fns) tag par (not arg)))) - (save-excursion - (set-buffer "*format-tag*") + (with-current-buffer "*format-tag*" (goto-char (point-max)) (insert s))) (setq fns (cdr fns)))) @@ -138,21 +141,6 @@ Optional argument ARG specifies not to use color." (require 'semantic/fw) -(defun semantic-test-data-cache () - "Test the data cache." - (interactive) - (let ((data '(a b c))) - (save-excursion - (set-buffer (get-buffer-create " *semantic-test-data-cache*")) - (erase-buffer) - (insert "The Moose is Loose") - (goto-char (point-min)) - (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) - data 'moose 'exit-cache-zone) - (if (equal (semantic-get-cache-data 'moose) data) - (message "Successfully retrieved cached data.") - (error "Failed to retrieve cached data"))))) - (defun semantic-test-throw-on-input () "Test that throw on input will work." (interactive) @@ -178,9 +166,8 @@ Optional argument ARG specifies not to use color." "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it." (interactive) (let ((start (current-time)) - (junk (semantic-idle-scheduler-work-parse-neighboring-files)) - (end (current-time))) - (message "Work took %.2f seconds." (semantic-elapsed-time start end)))) + (_junk (semantic-idle-scheduler-work-parse-neighboring-files))) + (message "Work took %.2f seconds." (semantic-elapsed-time start nil)))) ;;; From semantic-lex: @@ -195,10 +182,9 @@ If universal argument ARG, then try the whole buffer." (result (semantic-lex (if arg (point-min) (point)) (point-max) - 100)) - (end (current-time))) + 100))) (message "Elapsed Time: %.2f seconds." - (semantic-elapsed-time start end)) + (semantic-elapsed-time start nil)) (pop-to-buffer "*Lexer Output*") (require 'pp) (erase-buffer) @@ -227,16 +213,21 @@ Analyze the area between BEG and END." (semantic-lex-spp-table-write-slot-value (semantic-lex-spp-save-table)))) +(defvar cedet-utest-directory) ;From test/manual/cedet/cedet-utests.el? + (defun semantic-lex-spp-write-utest () "Unit test using the test spp file to test the slot write fcn." (interactive) - (let* ((sem (locate-library "semantic-lex-spp.el")) - (dir (file-name-directory sem))) - (save-excursion - (set-buffer (find-file-noselect - (expand-file-name "tests/testsppreplace.c" - dir))) - (semantic-lex-spp-write-test)))) + (save-excursion + (let ((buff (find-file-noselect + (expand-file-name "tests/testsppreplace.c" + cedet-utest-directory)))) + (set-buffer buff) + (semantic-lex-spp-write-test) + (kill-buffer buff) + (when (not (called-interactively-p 'interactive)) + (kill-buffer "*SPP Write Test*")) + ))) ;;; From semantic-tag-write: @@ -272,118 +263,13 @@ tag that contains point, and return that." (Lcount 0)) (when (semantic-tag-p target) (semantic-symref-hits-in-region - target (lambda (start end prefix) (setq Lcount (1+ Lcount))) + target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount))) (semantic-tag-start tag) (semantic-tag-end tag)) - (when (interactive-p) + (when (called-interactively-p 'interactive) (message "Found %d occurrences of %s in %.2f seconds" Lcount (semantic-tag-name target) - (semantic-elapsed-time start (current-time)))) + (semantic-elapsed-time start nil))) Lcount))) -;;; From bovine-gcc: - -(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.") - -(defun semantic-gcc-test-output-parser () - "Test the output parser against some collected strings." - (interactive) - (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)) - (setq fail t)) - )) - (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))) - ) - (when (and v h p) - (message "Negative test failed on %S" S) - (setq fail t)) - )) - (if (not fail) (message "Tests passed.")) - )) - -(defun semantic-gcc-test-output-parser-this-machine () - "Test the output parser against the machine currently running Emacs." - (interactive) - (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) - (semantic-gcc-test-output-parser)) - ) +;;; semantic-tests.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 6adfb1f2144..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-2017 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <eric@siege-engine.com> - -;; 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 diff --git a/test/manual/cedet/semantic-utest.el b/test/manual/cedet/semantic-utest.el deleted file mode 100644 index 6d499eeba44..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-2017 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> - -;; 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: -;; -;; 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 <stdio.h> -#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 - " -<html> - <body> - <h1>hello</h1> - </body><!--1--> -</html> -" - ) - -(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 - "<?php - -function fun1(){ - return \"fun1\"; -} - -function fun2($arg1){ - $output = \"argument to fun2: \" . $arg1; - return $output; -} - -class aClass { - public function fun1($a, $b){ - return $a; - } - - public function fun2($a, $b){ - return $b; - } -} -?> " - ) - -(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") "<!--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.")) - ) - -;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 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/srecode-tests.el b/test/manual/cedet/srecode-tests.el deleted file mode 100644 index 5d387a2d0c7..00000000000 --- a/test/manual/cedet/srecode-tests.el +++ /dev/null @@ -1,296 +0,0 @@ -;;; srecode-tests.el --- Some tests for CEDET's srecode - -;; Copyright (C) 2008-2017 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <eric@siege-engine.com> - -;; 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: - -;; Extracted from srecode-fields.el and srecode-document.el in the -;; CEDET distribution. - -;;; Code: - -;;; From srecode-fields: - -(require 'srecode/fields) - -(defvar srecode-field-utest-text - "This is a test buffer. - -It is filled with some text." - "Text for tests.") - -(defun srecode-field-utest () - "Test the srecode field manager." - (interactive) - (if (featurep 'xemacs) - (message "There is no XEmacs support for SRecode Fields.") - (srecode-field-utest-impl))) - -(defun srecode-field-utest-impl () - "Implementation of the SRecode field utest." - (save-excursion - (find-file "/tmp/srecode-field-test.txt") - - (erase-buffer) - (goto-char (point-min)) - (insert srecode-field-utest-text) - (set-buffer-modified-p nil) - - ;; Test basic field generation. - (let ((srecode-field-archive nil) - (f nil)) - - (end-of-line) - (forward-word -1) - - (setq f (srecode-field "Test" - :name "TEST" - :start 6 - :end 8)) - - (when (or (not (slot-boundp f 'overlay)) (not (oref f overlay))) - (error "Field test: Overlay info not created for field")) - - (when (and (overlay-p (oref f overlay)) - (not (overlay-get (oref f overlay) 'srecode-init-only))) - (error "Field creation overlay is not tagged w/ init flag")) - - (srecode-overlaid-activate f) - - (when (or (not (overlay-p (oref f overlay))) - (overlay-get (oref f overlay) 'srecode-init-only)) - (error "New field overlay not created during activation")) - - (when (not (= (length srecode-field-archive) 1)) - (error "Field test: Incorrect number of elements in the field archive")) - (when (not (eq f (car srecode-field-archive))) - (error "Field test: Field did not auto-add itself to the field archive")) - - (when (not (overlay-get (oref f overlay) 'keymap)) - (error "Field test: Overlay keymap not set")) - - (when (not (string= "is" (srecode-overlaid-text f))) - (error "Field test: Expected field text 'is', not %s" - (srecode-overlaid-text f))) - - ;; Test deletion. - (srecode-delete f) - - (when (slot-boundp f 'overlay) - (error "Field test: Overlay not deleted after object delete")) - ) - - ;; Test basic region construction. - (let* ((srecode-field-archive nil) - (reg nil) - (fields - (list - (srecode-field "Test1" :name "TEST-1" :start 5 :end 10) - (srecode-field "Test2" :name "TEST-2" :start 15 :end 20) - (srecode-field "Test3" :name "TEST-3" :start 25 :end 30) - - (srecode-field "Test4" :name "TEST-4" :start 35 :end 35)) - )) - - (when (not (= (length srecode-field-archive) 4)) - (error "Region Test: Found %d fields. Expected 4" - (length srecode-field-archive))) - - (setq reg (srecode-template-inserted-region "REG" - :start 4 - :end 40)) - - (srecode-overlaid-activate reg) - - ;; Make sure it was cleared. - (when srecode-field-archive - (error "Region Test: Did not clear field archive")) - - ;; Auto-positioning. - (when (not (eq (point) 5)) - (error "Region Test: Did not reposition on first field")) - - ;; Active region - (when (not (eq (srecode-active-template-region) reg)) - (error "Region Test: Active region not set")) - - ;; Various sizes - (mapc (lambda (T) - (if (string= (object-name-string T) "Test4") - (progn - (when (not (srecode-empty-region-p T)) - (error "Field %s is not empty" - (object-name T))) - ) - (when (not (= (srecode-region-size T) 5)) - (error "Calculated size of %s was not 5" - (object-name T))))) - fields) - - ;; Make sure things stay up after a 'command'. - (srecode-field-post-command) - (when (not (eq (srecode-active-template-region) reg)) - (error "Region Test: Active region did not stay up")) - - ;; Test field movement. - (when (not (eq (srecode-overlaid-at-point 'srecode-field) - (nth 0 fields))) - (error "Region Test: Field %s not under point" - (object-name (nth 0 fields)))) - - (srecode-field-next) - - (when (not (eq (srecode-overlaid-at-point 'srecode-field) - (nth 1 fields))) - (error "Region Test: Field %s not under point" - (object-name (nth 1 fields)))) - - (srecode-field-prev) - - (when (not (eq (srecode-overlaid-at-point 'srecode-field) - (nth 0 fields))) - (error "Region Test: Field %s not under point" - (object-name (nth 0 fields)))) - - ;; Move cursor out of the region and have everything cleaned up. - (goto-char 42) - (srecode-field-post-command) - (when (srecode-active-template-region) - (error "Region Test: Active region did not clear on move out")) - - (mapc (lambda (T) - (when (slot-boundp T 'overlay) - (error "Overlay did not clear off of field %s" - (object-name T)))) - fields) - - ;; End of LET - ) - - ;; Test variable linkage. - (let* ((srecode-field-archive nil) - (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8)) - (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30)) - (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40)) - (reg (srecode-template-inserted-region "REG" :start 4 :end 40)) - ) - (srecode-overlaid-activate reg) - - (when (not (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f2))) - (error "Linkage Test: Init strings are not =")) - (when (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f3)) - (error "Linkage Test: Init string on dissimilar fields is now the same")) - - (goto-char 7) - (insert "a") - - (when (not (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f2))) - (error "Linkage Test: mid-insert strings are not =")) - (when (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f3)) - (error "Linkage Test: mid-insert string on dissimilar fields is now the same")) - - (goto-char 9) - (insert "t") - - (when (not (string= (srecode-overlaid-text f1) "iast")) - (error "Linkage Test: tail-insert failed to captured added char")) - (when (not (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f2))) - (error "Linkage Test: tail-insert strings are not =")) - (when (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f3)) - (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) - - (goto-char 6) - (insert "b") - - (when (not (string= (srecode-overlaid-text f1) "biast")) - (error "Linkage Test: tail-insert failed to captured added char")) - (when (not (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f2))) - (error "Linkage Test: tail-insert strings are not =")) - (when (string= (srecode-overlaid-text f1) - (srecode-overlaid-text f3)) - (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) - - ;; Cleanup - (srecode-delete reg) - ) - - (set-buffer-modified-p nil) - - (message " All field tests passed.") - )) - -;;; From srecode-document: - -(require 'srecode/doc) - -(defun srecode-document-function-comment-extract-test () - "Test old comment extraction. -Dump out the extracted dictionary." - (interactive) - - (srecode-load-tables-for-mode major-mode) - (srecode-load-tables-for-mode major-mode 'document) - - (if (not (srecode-table)) - (error "No template table found for mode %s" major-mode)) - - (let* ((temp (srecode-template-get-table (srecode-table) - "function-comment" - "declaration" - 'document)) - (fcn-in (semantic-current-tag))) - - (if (not temp) - (error "No templates for function comments")) - - ;; Try to figure out the tag we want to use. - (when (or (not fcn-in) - (not (semantic-tag-of-class-p fcn-in 'function))) - (error "No tag of class 'function to insert comment for")) - - (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex)) - ) - - (when (not lextok) - (error "No comment to attempt an extraction")) - - (let ((s (semantic-lex-token-start lextok)) - (e (semantic-lex-token-end lextok)) - (extract nil)) - - (pulse-momentary-highlight-region s e) - - ;; Extract text from the existing comment. - (setq extract (srecode-extract temp s e)) - - (with-output-to-temp-buffer "*SRECODE DUMP*" - (princ "EXTRACTED DICTIONARY FOR ") - (princ (semantic-tag-name fcn-in)) - (princ "\n--------------------------------------------\n") - (srecode-dump extract)))))) - -;;; srecode-tests.el ends here diff --git a/test/manual/cedet/tests/test.c b/test/manual/cedet/tests/test.c index c5958c4cbac..6efaa8a75eb 100644 --- a/test/manual/cedet/tests/test.c +++ b/test/manual/cedet/tests/test.c @@ -1,8 +1,8 @@ /* test.c --- Semantic unit test for C. - Copyright (C) 2001-2017 Free Software Foundation, Inc. + Copyright (C) 2001-2022 Free Software Foundation, Inc. - Author: Eric M. Ludlam <eric@siege-engine.com> + Author: Eric M. Ludlam <zappo@gnu.org> This file is part of GNU Emacs. diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el index 299bea0bd5d..a523438f68f 100644 --- a/test/manual/cedet/tests/test.el +++ b/test/manual/cedet/tests/test.el @@ -1,8 +1,8 @@ -;;; test.el --- Unit test file for Semantic Emacs Lisp support. +;;; test.el --- Unit test file for Semantic Emacs Lisp support. -*- lexical-binding: t -*- -;; Copyright (C) 2005-2017 Free Software Foundation, Inc. +;; Copyright (C) 2005-2022 Free Software Foundation, Inc. -;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Author: Eric M. Ludlam <zappo@gnu.org> ;; This file is part of GNU Emacs. @@ -19,31 +19,29 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;; Require -;; +;;; Code: + (require 'semantic) (require 'eieio "../eieio") ;; tags encapsulated in eval-when-compile and eval-and-compile ;; should be expanded out into the outer environment. (eval-when-compile - (require 'semantic-imenu) - ) + (require 'semantic-imenu)) (eval-and-compile (defconst const-1 nil) (defun function-1 (arg) - nil) - ) + nil)) ;;; Functions ;; (defun a-defun (arg1 arg2 &optional arg3) - "doc a" + "Doc a." nil) (defun a-defun-interactive (arg1 arg2 &optional arg3) - "doc a that is a command" + "Doc a that is a command." (interactive "R") nil) @@ -52,24 +50,24 @@ nil) (defsubst a-defsubst (arg1 arg2 &optional arg3) - "doc a-subst" + "Doc a-subst." nil) (defmacro a-defmacro (arg1 arg2 &optional arg3) - "doc a-macro" + "Doc a-macro." nil) (define-overload a-overload (arg) - "doc a-overload" + "Doc a-overload." nil) ;;; Methods ;; -(defmethod a-method ((obj some-class) &optional arg2) +(cl-defmethod a-method ((obj some-class) &optional arg2) "Doc String for a method." (call-next-method)) -(defgeneric a-generic (arg1 arg2) +(cl-defgeneric a-generic (arg1 arg2) "General description of a-generic.") ;;; Advice @@ -81,15 +79,16 @@ ;;; Variables ;; (defvar a-defvar (cons 1 2) - "Variable a") + "Variable a.") +;; FIXME: This practice is not recommended in recent Emacs. Remove? (defvar a-defvar-star (cons 1 2) - "*User visible var a") + "*User visible var a.") -(defconst a-defconst 'a "var doc const") +(defconst a-defconst 'a "Var doc const.") (defcustom a-defcustom nil - "doc custom" + "Doc custom." :group 'a-defgroup :type 'boolean) @@ -110,7 +109,7 @@ (defgroup a-defgroup nil - "Group for `emacs-lisp' regression-test") + "Group for `emacs-lisp' regression-test.") ;;; Classes ;; @@ -152,7 +151,6 @@ (defvar-mode-local emacs-lisp-mode a-mode-local-def "some value") - -;;; Provide -;; (provide 'test) + +;;; test.el ends here diff --git a/test/manual/cedet/tests/test.make b/test/manual/cedet/tests/test.make index ff169576f7c..80c0c8051c4 100644 --- a/test/manual/cedet/tests/test.make +++ b/test/manual/cedet/tests/test.make @@ -1,8 +1,8 @@ # test.make --- Semantic unit test for Make -*- makefile -*- -# Copyright (C) 2001-2002, 2010-2017 Free Software Foundation, Inc. +# Copyright (C) 2001-2002, 2010-2022 Free Software Foundation, Inc. -# Author: Eric M. Ludlam <eric@siege-engine.com> +# Author: Eric M. Ludlam <zappo@gnu.org> # This file is part of GNU Emacs. diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/manual/cedet/tests/testdoublens.cpp deleted file mode 100644 index c9a2f99f545..00000000000 --- a/test/manual/cedet/tests/testdoublens.cpp +++ /dev/null @@ -1,165 +0,0 @@ -// testdoublens.cpp --- semantic-ia-utest completion engine unit tests - -// Copyright (C) 2008-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -#include "testdoublens.hpp" - -namespace Name1 { - namespace Name2 { - - Foo::Foo() - { - p// -1- - // #1# ( "pMumble" "publishStuff" ) - ; - } - - int Foo::get() // ^1^ - { - p// -2- - // #2# ( "pMumble" "publishStuff" ) - ; - return 0; - } - - void Foo::publishStuff(int /* a */, int /* b */) // ^2^ - { - } - - void Foo::sendStuff(int /* a */, int /* b */) // ^3^ - { - } - - } // namespace Name2 -} // namespace Name1 - -// Test multiple levels of metatype expansion -int test_fcn () { - stage3_Foo MyFoo; - - MyFoo.// -3- - // #3# ( "Mumble" "get" ) - ; - - Name1::Name2::F//-4- - // #4# ( "Foo" ) - ; - - // @TODO - get this working... - Name1::stage2_Foo::M//-5- - /// #5# ( "Mumble" ) - ; -} - -stage3_Foo foo_fcn() { - // Can we go "up" to foo with senator-go-to-up-reference? -} - - -// Second test from Ravikiran Rajagopal - -namespace A { - class foo { - public: - void aa(); - void bb(); - }; -} -namespace A { - class bar { - public: - void xx(); - public: - foo myFoo; - }; - - void bar::xx() - { - myFoo.// -6- <--- cursor is here after the dot - // #6# ( "aa" "bb" ) - ; - } -} - -// Double namespace example from Hannu Koivisto -// -// This is tricky because the parent class "Foo" is found within the -// scope of B, so the scope calculation needs to put that together -// before searching for parents in scope. -namespace a { - namespace b { - - class Bar : public Foo - { - int baz(); - }; - - int Bar::baz() - { - return dum// -7- - // #7# ( "dumdum" ) - ; - } - - } // namespace b -} // namespace a - -// Three namespace example from Hannu Koivisto -// -// This one is special in that the name e::Foo, where "e" is in -// the scope, and not referenced from the global namespace. This -// wasn't previously handled, so the fullscope needed to be added -// to the list of things searched when in split-name decent search mode -// for scopes. - -namespace d { - namespace e { - - class Foo - { - public: - int write(); - }; - - } // namespace d -} // namespace e - - -namespace d { - namespace f { - - class Bar - { - public: - int baz(); - - private: - e::Foo &foo; - }; - - int Bar::baz() - { - return foo.w// -8- - // #8# ( "write" ) - ; - } - - } // namespace f -} // namespace d diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/manual/cedet/tests/testdoublens.hpp deleted file mode 100644 index 59eec741667..00000000000 --- a/test/manual/cedet/tests/testdoublens.hpp +++ /dev/null @@ -1,69 +0,0 @@ -// testdoublens.hpp --- Header file used in one of the Semantic tests - -// Copyright (C) 2008-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -namespace Name1 { - namespace Name2 { - - class Foo - { - typedef unsigned int Mumble; - public: - Foo(); - ~Foo(); - int get(); - - private: - void publishStuff(int a, int b); - - void sendStuff(int a, int b); - - Mumble* pMumble; - }; - - typedef Foo stage1_Foo; - - } // namespace Name2 - - typedef Name2::stage1_Foo stage2_Foo; - - typedef Name2::Foo decl_stage1_Foo; - -} // namespace Name1 - -typedef Name1::stage2_Foo stage3_Foo; - - -// Double namespace from Hannu Koivisto -namespace a { - namespace b { - - class Foo - { - struct Dum { - int diDum; - }; - - protected: - mutable a::b::Foo::Dum dumdum; - }; - - } // namespace b -} // namespace a diff --git a/test/manual/cedet/tests/testfriends.cpp b/test/manual/cedet/tests/testfriends.cpp deleted file mode 100644 index 20425f93afa..00000000000 --- a/test/manual/cedet/tests/testfriends.cpp +++ /dev/null @@ -1,38 +0,0 @@ -// Test parsing of friends and how they are used in completion. -/* - >> Thanks Damien Profeta for the nice example. - > - > I paste a small example. - > It would be great if friend can be well parsed and even greater if - > class B can access to all the members of A. -*/ - -class Af // %2% ( ( "testfriends.cpp" ) ( "Af" "B::testB" ) ) -{ -public: - int pubVar; -private: - int privateVar; - - friend class B; - -}; - -class B -{ -public: - int testB(); - int testAB(); - -}; - - -int B::testB() { - Af classA; - classA.//-1- - ; //#1# ( "privateVar" "pubVar" ) -} - -int B::testAB() { // %1% ( ( "testfriends.cpp" ) ( "B" "B::testAB" ) ) -} - diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/manual/cedet/tests/testjavacomp.java deleted file mode 100644 index 743aaca8547..00000000000 --- a/test/manual/cedet/tests/testjavacomp.java +++ /dev/null @@ -1,67 +0,0 @@ -// testjavacomp.java --- Semantic unit test for Java - -// Copyright (C) 2009-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -package tests.testjavacomp; - -class secondClass { - private void scFuncOne() { } - public void scFuncOne() { } -} - - -public class testjavacomp { - - private int funcOne() { } - private int funcTwo() { } - private char funcThree() { } - - class nestedClass { - private void ncFuncOne() { } - public void ncFuncOne() { } - } - - public void publicFunc() { - - int i; - - i = fu// -1- - // #1# ( "funcOne" "funcTwo" ) - ; - - fu// -2- - // #2# ( "funcOne" "funcThree" "funcTwo" ) - ; - - secondClass SC; - - SC.//-3- - // #3# ( "scFuncOne" ) - ; - - nestedClass NC; - - // @todo - need to fix this? I don't know if this is legal java. - NC.// - 4- - // #4# ( "ncFuncOne" ) - ; - } - -} // testjavacomp diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/manual/cedet/tests/testnsp.cpp deleted file mode 100644 index 012dc660600..00000000000 --- a/test/manual/cedet/tests/testnsp.cpp +++ /dev/null @@ -1,29 +0,0 @@ -// Test NSP (Name space parent) -// -// Test dereferencing parents based on local parent scope. -// -// Derived from data David Engster provided. - -namespace nsp { - - class rootclass { - public: - int fromroot() {}; - }; - -} - -namespace nsp { - class childclass : public rootclass { - public: - int fromchild() {}; - }; -} - -void myfcn_not_in_ns (void) { - nsp::childclass test; - - test.// -1- - ; // #1# ( "fromchild" "fromroot" ) -} - diff --git a/test/manual/cedet/tests/testpolymorph.cpp b/test/manual/cedet/tests/testpolymorph.cpp index 86bc75c6f27..ba64e39a7a5 100644 --- a/test/manual/cedet/tests/testpolymorph.cpp +++ b/test/manual/cedet/tests/testpolymorph.cpp @@ -1,8 +1,8 @@ /** testpolymorph.cpp --- A sequence of polymorphism examples. * - * Copyright (C) 2009-2017 Free Software Foundation, Inc. + * Copyright (C) 2009-2022 Free Software Foundation, Inc. * - * Author: Eric M. Ludlam <eric@siege-engine.com> + * Author: Eric M. Ludlam <zappo@gnu.org> * * This file is part of GNU Emacs. * diff --git a/test/manual/cedet/tests/testspp.c b/test/manual/cedet/tests/testspp.c index dc8f4a54bae..74b336172cd 100644 --- a/test/manual/cedet/tests/testspp.c +++ b/test/manual/cedet/tests/testspp.c @@ -1,8 +1,8 @@ /* testspp.cpp --- Semantic unit test for the C preprocessor - Copyright (C) 2007-2017 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. - Author: Eric M. Ludlam <eric@siege-engine.com> + Author: Eric M. Ludlam <zappo@gnu.org> This file is part of GNU Emacs. diff --git a/test/manual/cedet/tests/testsppcomplete.c b/test/manual/cedet/tests/testsppcomplete.c deleted file mode 100644 index d7899942285..00000000000 --- a/test/manual/cedet/tests/testsppcomplete.c +++ /dev/null @@ -1,30 +0,0 @@ -/* Example provided by Hannes Janetzek */ - -struct Test { int test; }; - -#define BLA(_type) \ - _type *bla = (_type*) malloc(sizeof(_type)); - -#define BLUB(_type) \ - (_type*)malloc(sizeof(_type)); - -#define FOO(_type) \ - _type *foo = BLUB(_type); - -#define BAR(_type) \ - _type *bar = (*_type)BLUB(_type); - -int main(int argc, char *argv[]) { - BLA(Test); - bla->// -1- - ; // #1# ( "test" ) - - FOO(Test); - foo->// -2- - ; // #2# ( "test" ) - - BAR(Test); - bar->// -3- - ; // #3# ( "test" ) -} - diff --git a/test/manual/cedet/tests/testsppreplace.c b/test/manual/cedet/tests/testsppreplace.c index 5c63a09a368..54ae3f0323e 100644 --- a/test/manual/cedet/tests/testsppreplace.c +++ b/test/manual/cedet/tests/testsppreplace.c @@ -1,7 +1,7 @@ /* testsppreplace.c --- unit test for CPP/SPP Replacement - Copyright (C) 2007-2017 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. - Author: Eric M. Ludlam <eric@siege-engine.com> + Author: Eric M. Ludlam <zappo@gnu.org> This file is part of GNU Emacs. diff --git a/test/manual/cedet/tests/testsppreplaced.c b/test/manual/cedet/tests/testsppreplaced.c index f60be8bcfb2..c359fa7d690 100644 --- a/test/manual/cedet/tests/testsppreplaced.c +++ b/test/manual/cedet/tests/testsppreplaced.c @@ -1,7 +1,7 @@ /* testsppreplaced.c --- unit test for CPP/SPP Replacement - Copyright (C) 2007-2017 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. - Author: Eric M. Ludlam <eric@siege-engine.com> + Author: Eric M. Ludlam <zappo@gnu.org> This file is part of GNU Emacs. diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/manual/cedet/tests/testsubclass.cpp deleted file mode 100644 index df8399e8d11..00000000000 --- a/test/manual/cedet/tests/testsubclass.cpp +++ /dev/null @@ -1,248 +0,0 @@ -// testsubclass.cpp --- unit test for analyzer and complex C++ inheritance - -// Copyright (C) 2007-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -//#include <iostream> -#include "testsubclass.hh" - -void animal::moose::setFeet(int numfeet) //^1^ -{ - if (numfeet > 4) { - std::cerr << "Why would a moose have more than 4 feet?" << std::endl; - return; - } - - fFeet = numfeet; -} - -int animal::moose::getFeet() //^2^ -{ - return fFeet; -} - -void animal::moose::doNothing() //^3^ -{ - animal::moose foo(); - - fFeet = N// -15- - ; // #15# ( "NAME1" "NAME2" "NAME3" ) -} - - -void deer::moose::setAntlers(bool have_antlers) //^4^ -{ - fAntlers = have_antlers; -} - -bool deer::moose::getAntlers() //^5^ -// %1% ( ( "testsubclass.cpp" "testsubclass.hh" ) ( "deer::moose::doSomething" "deer::moose::getAntlers" "moose" ) ) -{ - return fAntlers; -} - -bool i_dont_have_symrefs() -// %2% ( ("testsubclass.cpp" ) ("i_dont_have_symrefs")) -{ -} - -void deer::moose::doSomething() //^6^ -{ - // All these functions should be identified by semantic analyzer. - getAntlers(); - setAntlers(true); - - getFeet(); - setFeet(true); - - doNothing(); - - fSomeField = true; - - fIsValid = true; -} - -void deer::alces::setLatin(bool l) { - fLatin = l; -} - -bool deer::alces::getLatin() { - return fLatin; -} - -void deer::alces::doLatinStuff(moose moosein) { - // All these functions should be identified by semantic analyzer. - getFeet(); - setFeet(true); - - getLatin(); - setLatin(true); - - doNothing(); - - deer::moose foo(); - - -} - -moose deer::alces::createMoose() -{ - moose MooseVariableName; - bool tmp; - int itmp; - bool fool; - int fast; - - MooseVariableName = createMoose(); - - doLatinStuff(MooseVariableName); - - tmp = this.f// -1- - // #1# ( "fAlcesBool" "fIsValid" "fLatin" ) - ; - - itmp = this.f// -2- - // #2# ( "fAlcesInt" "fGreek" "fIsProtectedInt" ) - ; - - tmp = f// -3- - // #3# ( "fAlcesBool" "fIsValid" "fLatin" "fool" ) - ; - - itmp = f// -4- - // #4# ( "fAlcesInt" "fGreek" "fIsProtectedInt" "fast" ) - ; - - MooseVariableName = m// -5- - // #5# ( "moose" ) - - return MooseVariableName; -} - -/** Test Scope Changes - * - * This function is rigged to make sure the scope changes to account - * for different locations in local variable parsing. - */ -int someFunction(int mPickle) -{ - moose mMoose = deer::alces::createMoose(); - - if (mPickle == 1) { - - int mOption1 = 2; - - m// -5- - // #5# ( "mMoose" "mOption1" "mPickle" ) - ; - - } else { - - int mOption2 = 2; - - m// -6- - // #6# ( "mMoose" "mOption2" "mPickle" ) - ; - } - -} - -// Thanks Ming-Wei Chang for this next example. - -namespace pub_priv { - - class A{ - private: - void private_a(){} - public: - void public_a(); - }; - - void A::public_a() { - A other_a; - - other_a.p// -7- - // #7# ( "private_a" "public_a" ) - ; - } - - int some_regular_function(){ - A a; - a.p// -8- - // #8# ( "public_a" ) - ; - return 0; - } - -} - - -/** Test Scope w/in a function (non-method) with classes using - * different levels of inheritance. - */ -int otherFunction() -{ - sneaky::antelope Antelope(1); - sneaky::jackalope Jackalope(1); - sneaky::bugalope Bugalope(1); - - Antelope.// -9- - // #9# ( "fAntyPublic" "fQuadPublic" "testAccess") - ; - - Jackalope.// -10- - // #10# ( "fBunnyPublic" "testAccess") - ; - - Jackalope// @1@ 6 - ; - Jackalope; - Jackalope; - Jackalope; - - Bugalope.// -11- - // #11# ( "fBugPublic" "testAccess") - ; - Bugalope// @2@ 3 - ; -} - -/** Test methods within each class for types of access to the baseclass. - */ - -bool sneaky::antelope::testAccess() //^7^ -{ - this.// -12- - // #12# ( "fAntyPrivate" "fAntyProtected" "fAntyPublic" "fQuadProtected" "fQuadPublic" "testAccess" ) - ; -} - -bool sneaky::jackalope::testAccess() //^8^ -{ - this.// -13- - // #13# ( "fBunnyPrivate" "fBunnyProtected" "fBunnyPublic" "fQuadProtected" "fQuadPublic" "testAccess" ) - ; -} - -bool sneaky::bugalope::testAccess() //^9^ -{ - this.// -14- - // #14# ( "fBugPrivate" "fBugProtected" "fBugPublic" "fQuadPublic" "testAccess" ) - ; -} diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/manual/cedet/tests/testsubclass.hh deleted file mode 100644 index fe07b6fcb05..00000000000 --- a/test/manual/cedet/tests/testsubclass.hh +++ /dev/null @@ -1,190 +0,0 @@ -// testsubclass.hh --- unit test for analyzer and complex C++ inheritance - -// Copyright (C) 2007-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -//#include <cmath> -// #include <stdio.h> - -#ifndef TESTSUBCLASS_HH -#define TESTSUBCLASS_HH - -namespace animal { - - class moose { - public: - moose() : fFeet(0), - fIsValid(false) - { } - - virtual void setFeet(int); - int getFeet(); - - void doNothing(); - - enum moose_enum { - NAME1, NAME2, NAME3 }; - - - protected: - - bool fIsValid; - int fIsProtectedInt; - - private: - int fFeet; // Usually 2 or 4. - bool fIsPrivateBool; - - }; // moose - - int two_prototypes(); - int two_prototypes(); - - class quadruped { - public: - quadruped(int a) : fQuadPrivate(a) - { } - - int fQuadPublic; - - protected: - int fQuadProtected; - - private: - int fQuadPrivate; - - }; - -} - - -namespace deer { - - class moose : public animal::moose { - public: - moose() : fAntlers(false) - { } - - void setAntlers(bool); - bool getAntlers(); - - void doSomething(); - - protected: - - bool fSomeField; - - private: - bool fAntlers; - - }; - -} // deer - -// A second namespace of the same name will test the -// namespace merging needed to resolve deer::alces -namespace deer { - - class alces : public animal::moose { - public: - alces(int lat) : fLatin(lat) - { } - - void setLatin(bool); - bool getLatin(); - - void doLatinStuff(moose moosein); // for completion testing - - moose createMoose(); // for completion testing. - - protected: - bool fAlcesBool; - int fAlcesInt; - - private: - bool fLatin; - int fGreek; - }; - -}; - -// A third namespace with classes that does protected and private inheritance. -namespace sneaky { - - class antelope : public animal::quadruped { - - public: - antelope(int a) : animal::quadruped(), - fAntyProtected(a) - {} - - int fAntyPublic; - - bool testAccess(); - - protected: - int fAntyProtected; - - private : - int fAntyPrivate; - - }; - - class jackalope : protected animal::quadruped { - - public: - jackalope(int a) : animal::quadruped(), - fBunny(a) - {} - - int fBunnyPublic; - - bool testAccess(); - - protected: - bool fBunnyProtected; - - private : - bool fBunnyPrivate; - - }; - - // Nothing specified means private. - class bugalope : /* private*/ animal::quadruped { - - public: - bugalope(int a) : animal::quadruped(), - fBug(a) - {} - - int fBugPublic; - - bool testAccess(); - protected: - bool fBugProtected; - - private : - bool fBugPrivate; - - }; - - -}; - -#endif diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/manual/cedet/tests/testtypedefs.cpp deleted file mode 100644 index 5bc79fc8856..00000000000 --- a/test/manual/cedet/tests/testtypedefs.cpp +++ /dev/null @@ -1,80 +0,0 @@ -// testtypedefs.cpp --- Sample with some fake bits out of std::string - -// Copyright (C) 2008-2017 Free Software Foundation, Inc. - -// Author: Eric M. Ludlam <eric@siege-engine.com> - -// 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/>. - -// Thanks Ming-Wei Chang for these examples. - -namespace std { - template <T>class basic_string { - public: - void resize(int); - }; -} - -typedef std::basic_string<char> mstring; - -using namespace std; -typedef basic_string<char> bstring; - -int main(){ - mstring a; - a.// -1- - ; - // #1# ( "resize" ) - bstring b; - // It doesn't work here. - b.// -2- - ; - // #2# ( "resize" ) - return 0; -} - -// ------------------ - -class Bar -{ -public: - void someFunc() {} -}; - -typedef Bar new_Bar; - -template <class mytype> -class TBar -{ -public: - void otherFunc() {} -}; - -typedef TBar<char> new_TBar; - -int main() -{ - new_Bar nb; - new_TBar ntb; - - nb.// -3- - ; - // #3# ("someFunc") - ntb.// -4- - ; - // #4# ("otherFunc") - return 0; -} diff --git a/test/manual/cedet/tests/testvarnames.c b/test/manual/cedet/tests/testvarnames.c deleted file mode 100644 index a328f97a741..00000000000 --- a/test/manual/cedet/tests/testvarnames.c +++ /dev/null @@ -1,90 +0,0 @@ -/* testvarnames.cpp - Test variable and function names, lists of variables on one line, etc. - - Copyright (C) 2008-2017 Free Software Foundation, Inc. - - Author: Eric M. Ludlam <eric@siege-engine.com> - - 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/>. -*/ - -struct independent { - int indep_1; - int indep_2; -}; - -struct independent var_indep_struct; - -struct { - int unnamed_1; - int unnamed_2; -} var_unnamed_struct; - -struct { - int unnamed_3; - int unnamed_4; -} var_un_2, var_un_3; - -struct inlinestruct { - int named_1; - int named_2; -} var_named_struct; - -struct inline2struct { - int named_3; - int named_4; -} var_n_2, var_n_3; - -/* Structures with names that then declare variables - * should also be completable. - * - * Getting this to work is the bugfix in semantic-c.el CVS v 1.122 - */ -struct inlinestruct in_var1; -struct inline2struct in_var2; - -int test_1(int var_arg1) { - - var_// -1- - ; // #1# ("var_arg1" "var_indep_struct" "var_n_2" "var_n_3" "var_named_struct" "var_un_2" "var_un_3" "var_unnamed_struct") - - var_indep_struct.// -2- - ; // #2# ( "indep_1" "indep_2" ) - - var_unnamed_struct.// -3- - ; // #3# ( "unnamed_1" "unnamed_2" ) - - var_named_struct.// -4- - ; // #4# ( "named_1" "named_2" ) - - var_un_2.// -5- - ; // #5# ( "unnamed_3" "unnamed_4" ) - var_un_3.// -6- - ; // #6# ( "unnamed_3" "unnamed_4" ) - - var_n_2.// -7- - ; // #7# ( "named_3" "named_4" ) - var_n_3.// -8- - ; // #8# ( "named_3" "named_4" ) - - in_// -9- - ; // #9# ( "in_var1" "in_var2" ) - - in_var1.// -10- - ; // #10# ( "named_1" "named_2") - in_var2.// -11- - ; // #11# ( "named_3" "named_4") -} |