etest.el

   1 ;;; etest.el --- Run tests and get back a hierarchical set of results.
   2
   3 ;; Copyright (C) 2008 Philip Jackson
   4
   5 ;; Author: Philip Jackson <phil@shellarchive.co.uk>
   6
   7 ;; This file is not currently part of GNU Emacs.
   8
   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.
  13
  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.
  18
  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.
  23
  24 ;;; Commentary:
  25
  26 ;; etest lets you define tests in a domain specific, hierarchical
  27 ;; manner and gather results in a simple, structure of the same shape.
  28
  29 ;; To install you must put the location of etest into your
  30 ;; `load-path', perhaps like this:
  31 ;;
  32 ;; (add-to-list 'load-path "~/.elisp/etest")
  33 ;;
  34 ;; Then actually load etest.el:
  35 ;;
  36 ;; (require 'etest)
  37 ;;
  38 ;; Valid examples of etest usage might be:
  39 ;;
  40 ;; Checking (+ 1 1) yeilds a non-nil result:
  41 ;; (etest '(ok (+ 1 1)))
  42 ;;
  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))
  52 ;;
  53 ;; To combine these you might do this:
  54 ;; (etest '("Check '+' function" (ok (+ 1 1)) (eq (+ 1 1) 2)))
  55 ;;
  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.
  59 ;;
  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))))
  67 ;;
  68 ;; Used like this:
  69 ;;
  70 ;; (etest '(eres (ok t)))
  71 ;;
  72 ;; I can see if etests 'built-ins' are working.
  73
  74 (require 'etest-result-mode)
  75 (require 'etest-execute)
  76
  77 (defvar etest-results-function 'etest-rm-refresh-buffer
  78   "Function used to display the results of a run.")
  79
  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     skip    (etest-skip 1)
  90     todo    (etest-todo 1))
  91   "Plist of test candidates where PROP is the name of the new
  92 test . See `deftest' for details of how to modify this.")
  93
  94 (defun deftest (details func)
  95   "Define a new test. DETAILS must be a list containing the name
  96 of the test and the argcount. FUNC is the actual function that
  97 will be run."
  98   (destructuring-bind (name argcount) details
  99     (plist-put etest-candidates-plist
 100                name (list func argcount))))
 101
 102 (defun etest-skip-todo (form keyword)
 103   "Return an etest result set with :result set to t. Set
 104 KEYWORD (usually todo or skip) to t and comments to the result."
 105   (let ((res (prin1-to-string
 106               (condition-case err (car (etest-run (list form)))
 107               (error
 108                err)))))
 109     (list :result t
 110           :comments (concat "got: " (replace-regexp-in-string "\n" "" res))
 111           keyword t)))
 112
 113 (defun etest-skip (form)
 114   "Call `etest-skip-todo' with the keyword being :skip"
 115   (etest-skip-todo form :skip))
 116
 117 (defun etest-todo (form)
 118   "Call `etest-skip-todo' with the keyword being :todo"
 119   (etest-skip-todo form :todo))
 120
 121 (defun etest-ok (test)
 122   "Simply eval TEST and pass if the result is non-nil."
 123   (let ((ret (eval test))
 124         (result '()))
 125     (setq result (plist-put result :result (not (null ret))))
 126     (setq result (plist-put result :comments (format "got: '%S'" ret)))
 127     result))
 128
 129 (defun etest-equality-test (func one two)
 130   "Compare two items, ONE and TWO, using the function
 131 FUNC. Returns a test result."
 132   (let ((one (eval one))
 133         (two (eval two))
 134         (res (funcall func (eval one) (eval two)))
 135         (result '()))
 136     (setq result (plist-put result :result res))
 137     (setq result (plist-put result :comments
 138                             (if res
 139                                 (format "both: '%S'" one)
 140                                 (format "one: '%S'\ntwo: '%S'" one two))))))
 141
 142 (defun etest-null (test)
 143   "Allows the use of `null' in a test."
 144   (let ((ret (eval test))
 145         (result '()))
 146     (setq result (plist-put result :result (null ret)))
 147     (setq result (plist-put result :comments (format "got: '%S'" ret)))
 148     result))
 149
 150 (defun etest-eq (one two)
 151   "Allows the use of `eq' in a test."
 152   (etest-equality-test 'eq one two))
 153
 154 (defun etest-equal (one two)
 155   "Allows the use of `equal' in a test."
 156   (etest-equality-test 'equal one two))
 157
 158 (defun etest-eql (one two)
 159   (etest-equality-test 'eql one two))
 160
 161 (defun etest-noerror (form)
 162   "Assert FORM evals without error."
 163   (let ((result (etest-error form)))
 164     (plist-put result :result (not (plist-get result :result)))))
 165
 166 (defun etest-error (form)
 167   "Assert FORM evals with error."
 168   (let* ((result '())
 169          (val (condition-case err (eval form)
 170                  (error
 171                   (setq result (list :result t
 172                                      :comments (format "got: '%S'" err)))))))
 173     (if result
 174         result
 175         (list :result nil
 176               :comments (format "got: '%S'" val)))))
 177
 178 (defun etest-resultp (result)
 179   "Check that RESULT is a vaid test result."
 180   (and (plist-member result :result)
 181        (booleanp (plist-get result :result))
 182        (plist-member result :comments)))
 183
 184 (defun etest-like (form re)
 185   "Check string is like re"
 186   (let* ((i 0)
 187          (match nil)
 188          (re (eval re))
 189          (string (eval form))
 190          (comments (format "   needle: '%s'\n haystack: '%s'\n" re string))
 191          (res (not (not (string-match re string))))
 192          (result (list :result res)))
 193     (while (setq match (match-string (setq i (1+ i)) string))
 194       (setq comments (concat (or comments "")
 195                              (format "match %3d: '%s'\n" i match))))
 196     (plist-put result :comments comments)
 197     result))
 198
 199 ;;;###autoload
 200 (defmacro etest (&rest form)
 201   "Wrapper to `etest-run'. Will popup a window displaying the
 202 results of the run."
 203   `(let* ((meta-info (list :pass 0
 204                            :fail 0
 205                            :timestart (current-time)
 206                            :timefinish 0))
 207           (results (etest-run ',form meta-info)))
 208      (plist-put meta-info :timefinish (current-time))
 209      (when (fboundp etest-results-function)
 210        (funcall etest-results-function results meta-info))
 211      results))
 212
 213 (defun etest-run (form &optional meta-info)
 214   "This function does all of the work where actually running the
 215 tests is concerned. Takes a valid etest form and will return a
 216 similarly shaped set of results. "
 217   (mapcar
 218    '(lambda (test)
 219      (let ((name (car test)))
 220        (cond
 221          ((stringp name)
 222           (cons name (etest-run (cdr test) meta-info)))
 223          ((symbolp name)
 224           (let ((cand (car (plist-get etest-candidates-plist name)))
 225                 (args (cdr test))
 226                 (argcount (cadr (plist-get etest-candidates-plist name)))
 227                 (doc nil))
 228             (unless cand
 229               (error "'%s' is not a valid name type" name))
 230             (if (< (length args) argcount)
 231                 (error "%s needs %d arguments" cand argcount)
 232                 (if (and (eq (length args) (1+ argcount))
 233                          (stringp (car (last args))))
 234                     (progn
 235                       (setq doc (car (last args)))
 236                       (setq args (delq doc args)))
 237                     (setq doc (prin1-to-string test))))
 238             (let ((results (apply cand args)))
 239               (plist-put results :doc doc)
 240               (when meta-info
 241                 (etest-meta-info-update-pass-fail results meta-info))
 242               results))))))
 243    form))
 244
 245 (defun etest-meta-info-update-pass-fail (result meta-info)
 246   "Update the pass/fail item in the meta-info plist based on the
 247 resuls in RESULT."
 248   (let ((type (if (plist-get result :result) :pass :fail)))
 249     (plist-put meta-info type (1+ (plist-get meta-info type)))))
 250
 251 ;; This is defined so that etest can test itself
 252 (defun etest-test-tests (test result)
 253   "This test is used to test ETest itself. TEST is the test to be
 254 run (in ETest syntax) and RESULT is a plist of items you would
 255 like to compare. See the file etest.etest for example usage."
 256   (let* ((testres (car (etest-run (list test))))
 257          (my-res t)
 258          (res-items '(:result :comments :doc :skip :todo))
 259          (my-comments (mapconcat
 260                        '(lambda (item)
 261                          (format "%9S %S" item (plist-get testres item)))
 262                        res-items
 263                        "\n")))
 264     (dolist (sym res-items)
 265       (let ((testval (plist-get testres sym))
 266             (resultval (plist-get result sym)))
 267         (when (and (plist-member result sym)
 268                    (not (equal testval resultval)))
 269           (setq my-res nil))))
 270     (list :result my-res :comments my-comments)))
 271
 272 ;; Make `etest-test-tests' available
 273 (deftest '(eres 2) 'etest-test-tests)
 274
 275 (provide 'etest)