Adapt the CEDET SRecoder template test to use ERT
These tests were copied from CEDET from SourceForge. Author: Eric Ludlam <zappo@gnu.org>
This commit is contained in:
Eric Ludlam
Stefan Monnier
parent
3f8915a019
commit
57a786db5a
3 changed files with 490 additions and 2 deletions
37
etc/srecode/proj-test.srt
Normal file
37
etc/srecode/proj-test.srt
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
;; proj-test.srt --- SRecode template for testing project scoping.
|
||||
|
||||
;; Copyright (C) 2008-2019 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/>.
|
||||
|
||||
set mode "srecode-template-mode"
|
||||
set escape_start "{{"
|
||||
set escape_end "}}"
|
||||
|
||||
set application "tests"
|
||||
set project "/tmp/"
|
||||
|
||||
context test
|
||||
|
||||
template test-project
|
||||
"A template that only exists for files in /tmp."
|
||||
----
|
||||
Contents doesn't matter.
|
||||
----
|
||||
|
||||
;; end
|
||||
|
|
@ -83,13 +83,13 @@ template gapsomething :blank
|
|||
template inlinetext
|
||||
"Insert text that has no newlines"
|
||||
----
|
||||
*In the middle*
|
||||
*In the middle*
|
||||
----
|
||||
|
||||
template includable :blank
|
||||
----
|
||||
;; An includable $COMMENT$ we could use.
|
||||
;; $^$
|
||||
;; $INPUTNAME$$^$
|
||||
;; Text after a point inserter.
|
||||
----
|
||||
|
||||
|
|
@ -99,6 +99,8 @@ $>WI1:includable$
|
|||
----
|
||||
|
||||
template wrapinclude-around
|
||||
sectiondictionary "WI1"
|
||||
set INPUTNAME "[VAR]"
|
||||
----
|
||||
$<WI1:includable$Intermediate Comments$/WI1$
|
||||
----
|
||||
|
|
@ -145,4 +147,74 @@ OUTSIDE SECTION: $UTESTVAR1$
|
|||
INSIDE SECTION: $#A$$UTESTVAR1$$/A$
|
||||
----
|
||||
|
||||
template custom-arg-w-arg :utestwitharg
|
||||
----
|
||||
Value of xformed UTWA: $UTESTARGXFORM$
|
||||
----
|
||||
|
||||
template custom-arg-w-subdict :utestwitharg
|
||||
sectiondictionary "UTLOOP"
|
||||
set NAME "item1"
|
||||
sectiondictionary "UTLOOP"
|
||||
set NAME "item2"
|
||||
sectiondictionary "UTLOOP"
|
||||
set NAME "item3"
|
||||
----
|
||||
All items here: $FOO_item1$ $FOO_item2$ $FOO_item3$
|
||||
----
|
||||
|
||||
template nested-dictionary-syntax-flat
|
||||
section "TOP"
|
||||
show SUB
|
||||
set NAME "item1"
|
||||
end
|
||||
----
|
||||
$#TOP$$#SUB$sub $/SUB$$NAME$$/TOP$
|
||||
----
|
||||
|
||||
template nested-dictionary-syntax-nesting
|
||||
section "TOP"
|
||||
show SHOW1
|
||||
set NAME "item1"
|
||||
section "SUB"
|
||||
show SHOW11
|
||||
set NAME "item11"
|
||||
end
|
||||
show SHOW2
|
||||
set NAME "item2"
|
||||
section "SUB"
|
||||
show SHOW21
|
||||
set NAME "item21"
|
||||
end
|
||||
show SHOW3
|
||||
set NAME "item3"
|
||||
section "SUB"
|
||||
show SHOW11
|
||||
set NAME "item31"
|
||||
section "SUB"
|
||||
show SHOW311
|
||||
set NAME "item311"
|
||||
end
|
||||
section "SUB"
|
||||
show SHOW321
|
||||
set NAME "item321"
|
||||
end
|
||||
end
|
||||
end
|
||||
----
|
||||
$#TOP$$#SUB$$NAME$$#SUB$-$NAME$$/SUB$ $/SUB$$/TOP$
|
||||
----
|
||||
|
||||
template nested-dictionary-syntax-mixed
|
||||
section "TOP"
|
||||
show SUB
|
||||
set NAME "item1"
|
||||
end
|
||||
sectiondictionary "SECTION"
|
||||
show SUB
|
||||
set NAME "item2"
|
||||
----
|
||||
$#TOP$$NAME$$/TOP$ $#SECTION$$NAME$$/SECTION$
|
||||
----
|
||||
|
||||
;; end
|
||||
|
|
|
|||
379
test/lisp/cedet/srecode-utest-template.el
Normal file
379
test/lisp/cedet/srecode-utest-template.el
Normal file
|
|
@ -0,0 +1,379 @@
|
|||
;;; srecode/test.el --- SRecode Core Template tests.
|
||||
|
||||
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; Tests of SRecode template insertion routines and tricks.
|
||||
;;
|
||||
|
||||
|
||||
(require 'srecode/map)
|
||||
(require 'srecode/insert)
|
||||
(require 'srecode/dictionary)
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; MAP DUMP TESTING
|
||||
(defun srecode-utest-map-reset ()
|
||||
"Reset, then dump the map of SRecoder templates.
|
||||
Probably should be called 'describe-srecode-maps'."
|
||||
(interactive)
|
||||
(message "SRecode Template Path: %S" srecode-map-load-path)
|
||||
;; Interactive call allows us to dump.
|
||||
(call-interactively 'srecode-get-maps)
|
||||
(switch-to-buffer "*SRECODE MAP*")
|
||||
(message (buffer-string))
|
||||
)
|
||||
|
||||
;;; OUTPUT TESTING
|
||||
;;
|
||||
(defclass srecode-utest-output ()
|
||||
((point :initarg :point
|
||||
:type string
|
||||
:documentation
|
||||
"Name of this test point.")
|
||||
(name :initarg :name
|
||||
:type string
|
||||
:documentation
|
||||
"Name of the template tested.")
|
||||
(output :initarg :output
|
||||
:type string
|
||||
:documentation
|
||||
"Expected output of the template.")
|
||||
(dict-entries :initarg :dict-entries
|
||||
:initform nil
|
||||
:type list
|
||||
:documentation
|
||||
"Additional dictionary entries to specify.")
|
||||
(pre-fill :initarg :pre-fill
|
||||
:type (or null string)
|
||||
:initform nil
|
||||
:documentation
|
||||
"Text to prefill a buffer with.
|
||||
Place cursor on the ! and delete it.
|
||||
If there is a second !, the put the mark there."))
|
||||
"A single template test.")
|
||||
|
||||
(cl-defmethod srecode-utest-test ((o srecode-utest-output))
|
||||
"Perform the insertion and test the output.
|
||||
Assumes that the current buffer is the testing buffer.
|
||||
Return NIL on success, or a diagnostic on failure."
|
||||
(let ((fail nil))
|
||||
(catch 'fail-early
|
||||
(with-slots (name (output-1 output) dict-entries pre-fill) o
|
||||
;; Prepare buffer: erase content and maybe insert pre-fill
|
||||
;; content.
|
||||
(erase-buffer)
|
||||
(insert (or pre-fill ""))
|
||||
(goto-char (point-min))
|
||||
(let ((start nil))
|
||||
(when (re-search-forward "!" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(setq start (point))
|
||||
(replace-match ""))
|
||||
(when (re-search-forward "!" nil t)
|
||||
(push-mark (match-beginning 0) t t)
|
||||
(replace-match ""))
|
||||
(when start (goto-char start)))
|
||||
|
||||
;; Find a template, perform an insertion and validate the output.
|
||||
(let ((dict (srecode-create-dictionary))
|
||||
(temp (or (srecode-template-get-table
|
||||
(srecode-table) name "test" 'tests)
|
||||
(progn
|
||||
(srecode-map-update-map)
|
||||
(srecode-template-get-table
|
||||
(srecode-table) name "test" 'tests))
|
||||
(progn
|
||||
(setq fail (format "Test template \"%s\" for `%s' not loaded!"
|
||||
name major-mode))
|
||||
(throw 'fail-early t)
|
||||
)))
|
||||
(srecode-handle-region-when-non-active-flag t))
|
||||
|
||||
;; RESOLVE AND INSERT
|
||||
(let ((entry dict-entries))
|
||||
(while entry
|
||||
(srecode-dictionary-set-value
|
||||
dict (nth 0 entry) (nth 1 entry))
|
||||
(setq entry (nthcdr 1 entry))))
|
||||
|
||||
(srecode-insert-fcn temp dict)
|
||||
|
||||
;; COMPARE THE OUTPUT
|
||||
(let ((actual (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(if (string= output-1 actual)
|
||||
nil
|
||||
|
||||
(goto-char (point-max))
|
||||
(insert "\n\n ------------- ^^ actual ^^ ------------\n\n
|
||||
------------- vv expected vv ------------\n\n"
|
||||
output-1)
|
||||
(setq fail
|
||||
(list (format "Entry %s failed:" (oref o point))
|
||||
(buffer-string))
|
||||
)))))
|
||||
)
|
||||
fail))
|
||||
|
||||
;;; ARG HANDLER
|
||||
;;
|
||||
(defun srecode-semantic-handle-:utest (dict)
|
||||
"Add macros into the dictionary DICT for unit testing purposes."
|
||||
(srecode-dictionary-set-value dict "UTESTVAR1" "ARG HANDLER ONE")
|
||||
(srecode-dictionary-set-value dict "UTESTVAR2" "ARG HANDLER TWO")
|
||||
)
|
||||
|
||||
(defun srecode-semantic-handle-:utestwitharg (dict)
|
||||
"Add macros into the dictionary DICT based on other vars in DICT."
|
||||
(let ((val1 (srecode-dictionary-lookup-name dict "UTWA"))
|
||||
(nval1 nil))
|
||||
;; If there is a value, mutate it
|
||||
(if (and val1 (stringp val1))
|
||||
(setq nval1 (upcase val1))
|
||||
;; No value, make stuff up
|
||||
(setq nval1 "NO VALUE"))
|
||||
|
||||
(srecode-dictionary-set-value dict "UTESTARGXFORM" nval1))
|
||||
|
||||
(let ((dicts (srecode-dictionary-lookup-name dict "UTLOOP")))
|
||||
(dolist (D dicts)
|
||||
;; For each dictionary, lookup NAME, and transform into
|
||||
;; something in DICT instead.
|
||||
(let ((sval (srecode-dictionary-lookup-name D "NAME")))
|
||||
(srecode-dictionary-set-value dict (concat "FOO_" sval) sval)
|
||||
)))
|
||||
)
|
||||
|
||||
;;; TEST POINTS
|
||||
;;
|
||||
(defvar srecode-utest-output-entries
|
||||
(list
|
||||
(srecode-utest-output
|
||||
:point "test1" :name "test"
|
||||
:output (concat ";; " (user-full-name) "\n"
|
||||
";; " (upcase (user-full-name))) )
|
||||
(srecode-utest-output
|
||||
:point "subs" :name "subs"
|
||||
:output ";; Before Loop
|
||||
;; After Loop" )
|
||||
(srecode-utest-output
|
||||
:point "firstlast" :name "firstlast"
|
||||
:output "
|
||||
;; << -- FIRST
|
||||
;; I'm First
|
||||
;; I'm Not Last
|
||||
;; -- >>
|
||||
|
||||
;; << -- MIDDLE
|
||||
;; I'm Not First
|
||||
;; I'm Not Last
|
||||
;; -- >>
|
||||
|
||||
;; << -- LAST
|
||||
;; I'm Not First
|
||||
;; I'm Last
|
||||
;; -- >>
|
||||
" )
|
||||
(srecode-utest-output
|
||||
:point "gapsomething" :name "gapsomething"
|
||||
:output ";; First Line
|
||||
### ALL ALONE ON A LINE ###
|
||||
;;Second Line"
|
||||
:pre-fill ";; First Line
|
||||
!;;Second Line")
|
||||
(srecode-utest-output
|
||||
:point "wrapsomething" :name "wrapsomething"
|
||||
:output ";; Put this line in front:
|
||||
;; First Line
|
||||
;; Put this line at the end:"
|
||||
:pre-fill "!;; First Line
|
||||
!")
|
||||
(srecode-utest-output
|
||||
:point "inlinetext" :name "inlinetext"
|
||||
:output ";; A big long comment XX*In the middle*XX with cursor in middle"
|
||||
:pre-fill ";; A big long comment XX!XX with cursor in middle")
|
||||
|
||||
(srecode-utest-output
|
||||
:point "wrapinclude-basic" :name "wrapinclude-basic"
|
||||
:output ";; An includable we could use.
|
||||
;;
|
||||
;; Text after a point inserter."
|
||||
)
|
||||
(srecode-utest-output
|
||||
:point "wrapinclude-basic2" :name "wrapinclude-basic"
|
||||
:output ";; An includable MOOSE we could use.
|
||||
;;
|
||||
;; Text after a point inserter."
|
||||
:dict-entries '("COMMENT" "MOOSE")
|
||||
)
|
||||
(srecode-utest-output
|
||||
:point "wrapinclude-around" :name "wrapinclude-around"
|
||||
:output ";; An includable we could use.
|
||||
;; [VAR]Intermediate Comments
|
||||
;; Text after a point inserter."
|
||||
)
|
||||
(srecode-utest-output
|
||||
:point "wrapinclude-around1" :name "wrapinclude-around"
|
||||
:output ";; An includable PENGUIN we could use.
|
||||
;; [VAR]Intermediate Comments
|
||||
;; Text after a point inserter."
|
||||
:dict-entries '("COMMENT" "PENGUIN")
|
||||
)
|
||||
(srecode-utest-output
|
||||
:point "complex-subdict" :name "complex-subdict"
|
||||
:output ";; I have a cow and a dog.")
|
||||
(srecode-utest-output
|
||||
:point "wrap-new-template" :name "wrap-new-template"
|
||||
:output "template newtemplate
|
||||
\"A nice doc string goes here.\"
|
||||
----
|
||||
Random text in the new template
|
||||
----
|
||||
bind \"a\""
|
||||
:dict-entries '( "NAME" "newtemplate" "KEY" "a" )
|
||||
)
|
||||
(srecode-utest-output
|
||||
:point "column-data" :name "column-data"
|
||||
:output "Table of Values:
|
||||
Left Justified | Right Justified
|
||||
FIRST | FIRST
|
||||
VERY VERY LONG STRIN | VERY VERY LONG STRIN
|
||||
MIDDLE | MIDDLE
|
||||
S | S
|
||||
LAST | LAST")
|
||||
(srecode-utest-output
|
||||
:point "custom-arg-handler" :name "custom-arg-handler"
|
||||
:output "OUTSIDE SECTION: ARG HANDLER ONE
|
||||
INSIDE SECTION: ARG HANDLER ONE")
|
||||
(srecode-utest-output
|
||||
:point "custom-arg-w-arg none" :name "custom-arg-w-arg"
|
||||
:output "Value of xformed UTWA: NO VALUE")
|
||||
(srecode-utest-output
|
||||
:point "custom-arg-w-arg upcase" :name "custom-arg-w-arg"
|
||||
:dict-entries '( "UTWA" "uppercaseme" )
|
||||
:output "Value of xformed UTWA: UPPERCASEME")
|
||||
(srecode-utest-output
|
||||
:point "custom-arg-w-subdict" :name "custom-arg-w-subdict"
|
||||
:output "All items here: item1 item2 item3")
|
||||
|
||||
;; Test cases for new "section ... end" dictionary syntax
|
||||
(srecode-utest-output
|
||||
:point "nested-dictionary-syntax-flat"
|
||||
:name "nested-dictionary-syntax-flat"
|
||||
:output "sub item1")
|
||||
(srecode-utest-output
|
||||
:point "nested-dictionary-syntax-nesting"
|
||||
:name "nested-dictionary-syntax-nesting"
|
||||
:output "item11-item11-item21-item31 item21-item11-item21-item31 item31-item311-item321 ")
|
||||
(srecode-utest-output
|
||||
:point "nested-dictionary-syntax-mixed"
|
||||
:name "nested-dictionary-syntax-mixed"
|
||||
:output "item1 item2"))
|
||||
"Test point entries for the template output tests.")
|
||||
|
||||
;;; Master Harness
|
||||
;;
|
||||
(defvar srecode-utest-testfile
|
||||
(expand-file-name (concat (make-temp-name "srecode-utest-") ".srt") temporary-file-directory)
|
||||
"File used to do testing.")
|
||||
|
||||
(ert-deftest srecode-utest-template-output ()
|
||||
"Test various template insertion options."
|
||||
(save-excursion
|
||||
(let ((testbuff (find-file-noselect srecode-utest-testfile)))
|
||||
|
||||
(set-buffer testbuff)
|
||||
|
||||
(srecode-load-tables-for-mode major-mode)
|
||||
(srecode-load-tables-for-mode major-mode 'tests)
|
||||
|
||||
(should (srecode-table major-mode))
|
||||
|
||||
;; Loop over the output testpoints.
|
||||
|
||||
(dolist (p srecode-utest-output-entries)
|
||||
(set-buffer testbuff) ;; XEmacs causes a buffer switch. I don't know why
|
||||
(should-not (srecode-utest-test p))
|
||||
)
|
||||
|
||||
))
|
||||
(when (file-exists-p srecode-utest-testfile)
|
||||
(delete-file srecode-utest-testfile)))
|
||||
|
||||
;;; Project test
|
||||
;;
|
||||
;; Test that "project" specification works ok.
|
||||
|
||||
(ert-deftest srecode-utest-project ()
|
||||
"Test thta project filtering works."
|
||||
(save-excursion
|
||||
(let ((testbuff (find-file-noselect srecode-utest-testfile))
|
||||
(temp nil))
|
||||
|
||||
(set-buffer testbuff)
|
||||
(erase-buffer)
|
||||
|
||||
;; Load the basics, and test that we can't find the application templates.
|
||||
(srecode-load-tables-for-mode major-mode)
|
||||
|
||||
(should (srecode-table major-mode))
|
||||
|
||||
(setq temp (srecode-template-get-table (srecode-table)
|
||||
"test-project"
|
||||
"test"
|
||||
'tests
|
||||
))
|
||||
(when temp
|
||||
(should-not "App Template Loaded when not specified."))
|
||||
|
||||
;; Load the application templates, and make sure we can find them.
|
||||
(srecode-load-tables-for-mode major-mode 'tests)
|
||||
|
||||
(setq temp (srecode-template-get-table (srecode-table)
|
||||
"test-project"
|
||||
"test"
|
||||
'tests
|
||||
))
|
||||
|
||||
(when (not temp)
|
||||
(should-not "Failed to load app specific template when available."))
|
||||
|
||||
;; Temporarily change the home of this file. This will make the
|
||||
;; project template go out of scope.
|
||||
(let ((default-directory (expand-file-name "~/")))
|
||||
|
||||
(setq temp (srecode-template-get-table (srecode-table)
|
||||
"test-project"
|
||||
"test"
|
||||
'tests
|
||||
))
|
||||
|
||||
(when temp
|
||||
(should-not "Project specific template available when in wrong directory."))
|
||||
|
||||
)))
|
||||
(when (file-exists-p srecode-utest-testfile)
|
||||
(delete-file srecode-utest-testfile)))
|
||||
|
||||
|
||||
(provide 'cedet/srecode-utest-template)
|
||||
;;; srecode-utest-template.el ends here
|
||||
Loading…
Add table
Reference in a new issue