etest-result-mode.el: Prettier alignment of metadata output.
[ETest.git] / etest.el
blobddd07a4bebabd30c8f6b4c781d8a57680a452345
1 ;;; etest.el --- Run tests and get back a hierarchical set of results.
3 ;; Copyright (C) 2008 Philip Jackson
5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
7 ;; This file is not currently part of GNU Emacs.
9 ;; This program is free software; you can redistribute it and/or
10 ;; modify it under the terms of the GNU General Public License as
11 ;; published by the Free Software Foundation; either version 2, or (at
12 ;; your option) any later version.
14 ;; This program is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program ; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
24 ;;; Commentary:
26 ;; etest lets you define tests in a domain specific, hierarchical
27 ;; manner and gather results in a simple, structure of the same shape.
29 ;; To install you must put the location of etest into your
30 ;; `load-path', perhaps like this:
32 ;; (add-to-list 'load-path "~/.elisp/etest")
34 ;; Then actually load etest.el:
36 ;; (require 'etest)
37 ;;
38 ;; Valid examples of etest usage might be:
40 ;; Checking (+ 1 1) yeilds a non-nil result:
41 ;; (etest '(ok (+ 1 1)))
43 ;; You can add an extra argument to the end of any test and it will be
44 ;; used as the documentation string for the test:
45 ;;
46 ;; (etest '(ok (+ 1 1) "Check 1 + 1 yeilds non-nil"))
47 ;;
48 ;; If you omit this string then one will be generated for you.
49 ;;
50 ;; Checking (+ 1 1) yeilds 2:
51 ;; (etest '(eq (+ 1 1) 2))
53 ;; To combine these you might do this:
54 ;; (etest '("Check '+' function" (ok (+ 1 1)) (eq (+ 1 1) 2)))
56 ;; The string is just a header to split things up and hopefully make
57 ;; the output more readable. You can have header groups nest as deeply
58 ;; as you like and within each as many tests as you like.
60 ;; To define your own tests the `deftest' function should be used. For
61 ;; example the following can (and is) used to test etest itself:
62 ;;
63 ;; (deftest '(eres 1)
64 ;; (lambda (test)
65 ;; (etest-ok
66 ;; (plist-get (car (etest-run (list test))) :result))))
68 ;; Used like this:
69 ;;
70 ;; (etest '(eres (ok t)))
71 ;;
72 ;; I can see if etests 'built-ins' are working.
74 (require 'etest-result-mode)
75 (require 'etest-execute)
77 (defvar etest-results-function 'etest-rm-refresh-buffer
78 "Function used to display the results of a run.")
80 (defvar etest-candidates-plist
81 '(eq (etest-eq 2)
82 noerror (etest-noerror 1)
83 error (etest-error 1)
84 like (etest-like 2)
85 null (etest-null 1)
86 equal (etest-equal 2)
87 eql (etest-eql 2)
88 ok (etest-ok 1))
89 "Plist of test candidates where PROP is the name of the new
90 test . See `deftest' for details of how to modify this.")
92 (defun deftest (details func)
93 "Define a new test. DETAILS must be a list containing the name
94 of the test and the argcount. FUNC is the actual function that
95 will be run."
96 (destructuring-bind (name argcount) details
97 (plist-put etest-candidates-plist
98 name (list func argcount))))
100 (defun etest-ok (test)
101 "Simply eval TEST and pass if the result is non-nil."
102 (let ((ret (eval test))
103 (result '()))
104 (setq result (plist-put result :result (not (null ret))))
105 (setq result (plist-put result :comments (format "got: '%S'" ret)))
106 result))
108 (defun etest-equality-test (func one two)
109 "Compare two items, ONE and TWO, using the function
110 FUNC. Returns a test result."
111 (let ((one (eval one))
112 (two (eval two))
113 (res (funcall func (eval one) (eval two)))
114 (result '()))
115 (setq result (plist-put result :result res))
116 (setq result (plist-put result :comments
117 (if res
118 (format "both: '%S'" one)
119 (format "one: '%S'\ntwo: '%S'" one two))))))
121 (defun etest-null (test)
122 "Allows the use of `null' in a test."
123 (let ((ret (eval test))
124 (result '()))
125 (setq result (plist-put result :result (null ret)))
126 (setq result (plist-put result :comments (format "got: '%S'" ret)))
127 result))
129 (defun etest-eq (one two)
130 "Allows the use of `eq' in a test."
131 (etest-equality-test 'eq one two))
133 (defun etest-equal (one two)
134 "Allows the use of `equal' in a test."
135 (etest-equality-test 'equal one two))
137 (defun etest-eql (one two)
138 (etest-equality-test 'eql one two))
140 (defun etest-noerror (form)
141 "Assert FORM evals without error."
142 (let ((result (etest-error form)))
143 (plist-put result :result (not (plist-get result :result)))))
145 (defun etest-error (form)
146 "Assert FORM evals with error."
147 (let* ((result '())
148 (val (condition-case err (eval form)
149 (error
150 (setq result (list :result t
151 :comments (format "got: '%S'" err)))))))
152 (if result
153 result
154 (list :result nil
155 :comments (format "got: '%S'" val)))))
157 (defun etest-resultp (result)
158 "Check that RESULT is a vaid test result."
159 (and (plist-member result :result)
160 (booleanp (plist-get result :result))
161 (plist-member result :comments)))
163 (defun etest-like (form re)
164 "Check string is like re"
165 (let* ((i 0)
166 (match nil)
167 (re (eval re))
168 (string (eval form))
169 (comments (format " needle: '%s'\nhaystack: '%s'\n" re string))
170 (res (not (not (string-match re string))))
171 (result (list :result res)))
172 (while (setq match (match-string (setq i (1+ i)) string))
173 (setq comments (concat (or comments "")
174 (format "match %3d: '%s'\n" i match))))
175 (plist-put result :comments comments)
176 result))
178 ;;;###autoload
179 (defmacro etest (&rest form)
180 "Wrapper to `etest-run'. Will popup a window displaying the
181 results of the run."
182 `(let* ((meta-info (list :pass 0
183 :fail 0
184 :timestart (current-time)
185 :timefinish 0))
186 (results (etest-run ',form meta-info)))
187 (plist-put meta-info :timefinish (current-time))
188 (when (fboundp etest-results-function)
189 (funcall etest-results-function results meta-info))
190 results))
192 (defun etest-run (form &optional meta-info)
193 "This function does all of the work where actually running the
194 tests is concerned. Takes a valid etest form and will return a
195 similarly shaped set of results. "
196 (mapcar
197 '(lambda (test)
198 (let ((name (car test)))
199 (cond
200 ((stringp name)
201 (cons name (etest-run (cdr test) meta-info)))
202 ((symbolp name)
203 (let ((cand (car (plist-get etest-candidates-plist name)))
204 (args (cdr test))
205 (argcount (cadr (plist-get etest-candidates-plist name)))
206 (doc nil))
207 (unless cand
208 (error "'%s' is not a valid name type" name))
209 (if (< (length args) argcount)
210 (error "%s needs %d arguments" cand argcount)
211 (if (and (eq (length args) (1+ argcount))
212 (stringp (car (last args))))
213 (progn
214 (setq doc (car (last args)))
215 (setq args (delq doc args)))
216 (setq doc (prin1-to-string test))))
217 (let ((results (apply cand args)))
218 (plist-put results :doc doc)
219 (when meta-info
220 (etest-meta-info-update-pass-fail results meta-info))
221 results))))))
222 form))
224 (defun etest-meta-info-update-pass-fail (result meta-info)
225 "Update the pass/fail item in the meta-info plist based on the
226 resuls in RESULT."
227 (let ((type (if (plist-get result :result) :pass :fail)))
228 (plist-put meta-info type (1+ (plist-get meta-info type)))))
230 ;; This is defined so that etest can test itself
231 (defun etest-test-tests (test result)
232 "This test is used to test ETest itself. TEST is the test to be
233 run (in ETest syntax) and RESULT is a plist of items you would
234 like to compare. See the file etest.etest for example usage."
235 (let ((testres (car (etest-run (list test))))
236 (my-res t)
237 (my-comments ""))
238 (when (null (plist-get testres :result))
239 (setq my-comments "note: test result was nil\n"))
240 (dolist (sym '(:result :comments :doc))
241 (let ((testval (plist-get testres sym))
242 (resultval (plist-get result sym)))
243 (when (and (plist-member result sym)
244 (not (equal testval resultval)))
245 (setq my-res nil)
246 (setq my-comments
247 (concat my-comments
248 (format "got: %S from '%S'\n"
249 resultval sym))))))
250 (list :result my-res :comments my-comments)))
252 ;; Make `etest-test-tests' available
253 (deftest '(eres 2) 'etest-test-tests)
255 (provide 'etest)