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