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