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 ;; Valid examples of etest usage might be:
  40 ;;
  41 ;; Checking (+ 1 1) yeilds a non-nil result:
  42 ;; (etest '(ok (+ 1 1)))
  43 ;;
  44 ;; You can add an extra argument to the end of any test and it will be
  45 ;; used as the documentation string for the test:
  46 ;;
  47 ;; (etest '(ok (+ 1 1) "Check 1 + 1 yeilds non-nil"))
  48 ;;
  49 ;; If you omit this string then one will be generated for you.
  50 ;;
  51 ;; Checking (+ 1 1) yeilds 2:
  52 ;; (etest '(eq (+ 1 1) 2))
  53 ;;
  54 ;; To combine these you might do this:
  55 ;; (etest '("Check '+' function" (ok (+ 1 1)) (eq (+ 1 1) 2)))
  56 ;;
  57 ;; The string is just a header to split things up and hopefully make
  58 ;; the output more readable. You can have header groups nest as deeply
  59 ;; as you like and within each as many tests as you like.
  60 ;;
  61 ;; To define your own tests the `deftest' function should be used. For
  62 ;; example the following can (and is) used to test etest itself:
  63 ;;
  64 ;; (deftest '(eres 1)
  65 ;;     (lambda (test)
  66 ;;       (etest-ok
  67 ;;        (plist-get (car (etest-run (list test))) :result))))
  68 ;;
  69 ;; Used like this:
  70 ;;
  71 ;; (etest '(eres (ok t)))
  72 ;;
  73 ;; I can see if etests 'built-ins' are working.
  74
  75 (require 'etest-result-mode)
  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   "Plist of test candidates where PROP is the name of the new
  90 test . See `deftest' for details of how to modify this.")
  91
  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   (let ((name (car details))
  97         (argcount (cadr details)))
  98     (plist-put etest-candidates-plist
  99                name (list func argcount))))
 100
 101 (defun etest-ok (test)
 102   "Simply eval TEST and pass if the result is non-nil."
 103   (let ((ret (eval test))
 104         (result '()))
 105     (setq result (plist-put result :result (not (null ret))))
 106     (setq result (plist-put result :comments (format "got: '%S'" ret)))
 107     result))
 108
 109 (defun etest-equality-test (func one two)
 110   "Compare two items, ONE and TWO, using the function
 111 FUNC. Returns a test result."
 112   (let ((one (eval one))
 113         (two (eval two))
 114         (res (funcall func (eval one) (eval two)))
 115         (result '()))
 116     (setq result (plist-put result :result res))
 117     (setq result (plist-put result :comments
 118                             (if res
 119                                 (format "both: '%S'" one)
 120                                 (format "one: '%S'\ntwo: '%S'" one two))))))
 121
 122 (defun etest-null (test)
 123   "Allows the use of `null' in a test."
 124   (etest-ok `(null ,test)))
 125
 126 (defun etest-eq (one two)
 127   "Allows the use of `eq' in a test."
 128   (etest-equality-test 'eq one two))
 129
 130 (defun etest-equal (one two)
 131   "Allows the use of `equal' in a test."
 132   (etest-equality-test 'equal one two))
 133
 134 (defun etest-eql (one two)
 135   (etest-equality-test 'eql one two))
 136
 137 (defun etest-noerror (form)
 138   "Assert FORM evals without error."
 139   (let ((result (etest-error form)))
 140     (plist-put result :result (not (plist-get result :result)))))
 141
 142 (defun etest-error (form)
 143   "Assert FORM evals with error."
 144   (let* ((result '())
 145          (val (condition-case err (eval form)
 146                  (error
 147                   (setq result (list :result t
 148                                      :comments (format "got: '%S'" err)))))))
 149     (if result
 150         result
 151         (list :result nil
 152               :comments (format "got: '%S'" val)))))
 153
 154 (defun etest-resultp (result)
 155   "Check that RESULT is a vaid test result."
 156   (and (plist-member result :result)
 157        (booleanp (plist-get result :result))
 158        (plist-member result :comments)))
 159
 160 (defun etest-like (form re)
 161   "Check string is like re"
 162   (let* ((i 0)
 163          (match nil)
 164          (re (eval re))
 165          (string (eval form))
 166          (comments (concat "searching: '" string "'\n"))
 167          (res (not (not (string-match re string))))
 168          (result (list :result res)))
 169     (while (setq match (match-string (setq i (1+ i)) string))
 170       (setq comments (concat (or comments "")
 171                              (format "match %3d: '%s'\n" i match))))
 172     (plist-put result :comments comments)
 173     result))
 174
 175 ;;;###autoload
 176 (defmacro etest (&rest form)
 177   "Wrapper to `etest-run'. Will popup a window displaying the
 178 results of the run."
 179   `(let ((results (etest-run ',form)))
 180      (when (fboundp etest-results-function)
 181        (funcall etest-results-function results))
 182      results))
 183
 184 (defun etest-run (form)
 185   "This function does all of the work where actually running the
 186 tests is concerned. Takes a valid etest form and will return a
 187 similarly shaped set of results. "
 188   (mapcar
 189    '(lambda (test)
 190      (let ((name (car test)))
 191        (cond
 192          ((stringp name)
 193           (cons name (etest-run (cdr test))))
 194          ((symbolp name)
 195           (let ((cand (car (plist-get etest-candidates-plist name)))
 196                 (args (cdr test))
 197                 (argcount (cadr (plist-get etest-candidates-plist name)))
 198                 (doc nil))
 199             (unless cand
 200               (error "'%s' is not a valid name type" name))
 201             (if (< (length args) argcount)
 202                 (error "%s needs %d arguments" cand argcount)
 203                 (if (and (eq (length args) (1+ argcount))
 204                          (stringp (car (last args))))
 205                     (progn
 206                       (setq doc (car (last args)))
 207                       (setq args (delq doc args)))
 208                     (setq doc (prin1-to-string test))))
 209             (plist-put (apply cand args) :doc doc))))))
 210    form))
 211
 212 ;; This is defined so that etest can test itself
 213 (defun etest-test-tests (test result)
 214   "This test is used to test ETest itself. TEST is the test to be
 215 run (in ETest syntax) and RESULT is a plist of items you would
 216 like to compare. See the file etest.etest for example usage."
 217   (let ((testres (car (etest-run (list test))))
 218         (my-res t)
 219         (my-comments ""))
 220     (when (null (plist-get testres :result))
 221       (setq my-comments "note: test result was nil\n"))
 222     (dolist (sym '(:result :comments :doc))
 223       (let ((testval (plist-get testres sym))
 224             (resultval (plist-get result sym)))
 225         (when (and (plist-member result sym)
 226                    (not (equal testval resultval)))
 227           (setq my-res nil)
 228           (setq my-comments
 229                 (concat my-comments
 230                         (format "got: %S from '%S'\n"
 231                                 resultval sym))))))
 232     (list :result my-res :comments my-comments)))
 233
 234 ;; Make `etest-test-tests' available
 235 (deftest '(eres 2) 'etest-test-tests)
 236
 237 (provide 'etest)