1
;; Authors: Martin Blais <blais@furius.ca>
2
;; Date: $Date: 2005/04/01 23:19:41 $
3
;; Copyright: This module has been placed in the public domain.
5
;; Simple generic test runner for test scripts.
9
;; emacs --script <file>.el
12
;; There are mainly two useful functions from this pacakge:
14
;; 1. regression-test-compare-expect-values : used to compare expected output
15
;; values from running a function;
17
;; 2. regression-test-compare-expect-buffer : used to compare expected output
18
;; buffer contents after running the function.
20
;; regression-test-compare-expect-values test format
21
;; -------------------------------------------------
23
;; The tests are a list of tuples, with the following entries:
25
;; - a SYMBOL that uniquely identifies the test.
27
;; - the input buffer CONTENTS to prepare and run the test on. If char @ is
28
;; present in the buffer, it is removed and the cursor is placed at that
29
;; position before running the tested function.
31
;; - the expected OUTPUT value that the function should return. If the actual
32
;; output is different from this, the test will fail.
34
;; - an optional list of INPUT ARGUMENTS that the test function is called with
37
;; regression-test-compare-expect-buffer test format
38
;; -------------------------------------------------
40
;; - a SYMBOL that uniquely identifies the test.
42
;; - the input buffer CONTENTS to prepare and run the test on. Here too, char @
43
;; is present in the buffer, it is removed and the cursor is placed at that
44
;; position before running the tested function.
46
;; - the EXPECTED buffer contents after the function has been run.
47
;; Additionally, if char @ is present, it is checked that the cursor is
48
;; located at that position in the buffer after the function is run (this is
51
;; - an optional list of PREFIX ARGUMENTS, which indicates to the test program
52
;; to set those prefix arguments before running the given function. If there
53
;; are multiple prefix args, the function is invoked many times.
59
(defvar regression-point-char "@"
60
"Special character used to mark the position of point in input
61
text and expected text.")
63
(defun regression-test-loop (suitename testfun testlist fun &optional continue)
64
"Loop over a series of tests in a buffer and run the 'testfun'
67
(message (format "\n\n Test Suite: %s\n\n" suitename))
69
(let ((buf (get-buffer-create "regression-tests"))
72
(dolist (curtest testlist)
74
;; Print current text.
75
(message (format "========= %s" (prin1-to-string (car curtest))))
77
;; Prepare a buffer with the starting text, and move the cursor where
78
;; the special character is located.
79
(switch-to-buffer buf)
81
(insert (cadr curtest))
83
(if (not (search-backward regression-point-char nil t))
84
(error (concat "Error: Badly formed test input, missing "
85
"the cursor position marker.")))
89
(setq errtxt (funcall testfun
96
(progn (message errtxt)
97
(message "(Continuing...)"))
103
(defun regression-compare-buffers (testname expected testargs)
104
"Compare the buffer and expected text and return actual
105
contents if they do not match."
107
;; Run the section title update command n times.
108
(dolist (x (or testargs (list nil)))
109
(let ((current-prefix-arg x))
112
;; Compare the buffer output with the expected text.
113
(let* (;; Get the actual buffer contents.
114
(actual (buffer-string))
115
;; Get the expected location of point
116
(exppoint (string-match regression-point-char expected))
118
(expected-clean (if exppoint
119
(concat (substring expected 0 exppoint)
120
(substring expected (+ 1 exppoint)))
123
;; Adjust position of point vs. string index.
124
(exppoint (and exppoint (+ exppoint 1)))
128
(if (not (string= expected-clean actual))
129
;; Error! Test failed.
130
(format "Error: Test %s failed: \nexpected\n%s\ngot\n%s"
132
(prin1-to-string expected-clean)
133
(prin1-to-string actual))
134
(if (and exppoint (not (equal exppoint (point))))
135
;; Error! Test failed, final position of cursor is not the same.
136
(format "Error: Test %s failed: cursor badly placed." testname))
139
(defun regression-test-compare-expect-buffer
140
(suitename testlist fun &optional continue)
141
"Run the regression tests for the expected buffer contents."
142
(regression-test-loop
143
suitename 'regression-compare-buffers testlist fun continue))
146
(defun regression-compare-values (testname expected testargs)
147
"Compare the buffer and expected text and return actual
148
contents if they do not match."
151
;; Run the section title update command n times.
152
(setq actual (apply fun testargs))
154
;; Compare the buffer output with the expected text.
155
(if (not (equal actual expected))
156
;; Error! Test failed.
157
(format "Error: Test %s failed: expected '%s' got '%s'."
159
(prin1-to-string expected)
160
(prin1-to-string actual))
163
(defun regression-test-compare-expect-values
164
(suitename testlist fun &optional continue)
165
"Run the regression tests for expected values comparison."
166
(regression-test-loop
167
suitename 'regression-compare-values testlist fun continue))
added
removed
tools/editors/emacs/tests/tests-runner.el
