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
  76 (defvar etest-results-function 'etest-rm-refresh-buffer
  77   "Function used to display the results of a run.")
  78
  79 (defvar etest-candidates-plist
  80   '(eq      (etest-eq 2)
  81     noerror (etest-noerror 1)
  82     error   (etest-error 1)
  83     like    (etest-like 2)
  84     null    (etest-null 1)
  85     equal   (etest-equal 2)
  86     eql     (etest-eql 2)
  87     ok      (etest-ok 1))
  88   "Plist of test candidates where PROP is the name of the new
  89 test . See `deftest' for details of how to modify this.")
  90
  91 (defun deftest (details func)
  92   "Define a new test. DETAILS must be a list containing the name
  93 of the test and the argcount. FUNC is the actual function that
  94 will be run."
  95   (let ((name (car details))
  96         (argcount (cadr details)))
  97     (plist-put etest-candidates-plist
  98                name (list func argcount))))
  99
 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))
 107
 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))))))
 120
 121 (defun etest-null (test)
 122   "Allows the use of `null' in a test."
 123   (etest-ok `(null ,test)))
 124
 125 (defun etest-eq (one two)
 126   "Allows the use of `eq' in a test."
 127   (etest-equality-test 'eq one two))
 128
 129 (defun etest-equal (one two)
 130   "Allows the use of `equal' in a test."
 131   (etest-equality-test 'equal one two))
 132
 133 (defun etest-eql (one two)
 134   (etest-equality-test 'eql one two))
 135
 136 (defun etest-noerror (form)
 137   "Assert FORM evals without error."
 138   (let ((result (etest-error form)))
 139     (plist-put result :result (not (plist-get result :result)))))
 140
 141 (defun etest-error (form)
 142   "Assert FORM evals with error."
 143   (let* ((result '())
 144          (val (condition-case err (eval form)
 145                  (error
 146                   (setq result (list :result t
 147                                      :comments (format "got: '%S'" err)))))))
 148     (if result
 149         result
 150         (list :result nil
 151               :comments (format "got: '%S'" val)))))
 152
 153 (defun etest-resultp (result)
 154   "Check that RESULT is a vaid test result."
 155   (and (plist-member result :result)
 156        (booleanp (plist-get result :result))
 157        (plist-member result :comments)))
 158
 159 (defun etest-like (form re)
 160   "Check string is like re"
 161   (let* ((i 0)
 162          (match nil)
 163          (re (eval re))
 164          (string (eval form))
 165          (comments (concat "searching: '" string "'\n"))
 166          (res (not (not (string-match re string))))
 167          (result (list :result res)))
 168     (while (setq match (match-string (setq i (1+ i)) string))
 169       (setq comments (concat (or comments "")
 170                              (format "match %3d: '%s'\n" i match))))
 171     (plist-put result :comments comments)
 172     result))
 173
 174 ;;;###autoload
 175 (defmacro etest (&rest form)
 176   "Wrapper to `etest-run'. Will popup a window displaying the
 177 results of the run."
 178   `(let ((results (etest-run ',form)))
 179      (when (fboundp etest-results-function)
 180        (funcall etest-results-function results))
 181      results))
 182
 183 (defun etest-run (form)
 184   "This function does all of the work where actually running the
 185 tests is concerned. Takes a valid etest form and will return a
 186 similarly shaped set of results. "
 187   (mapcar
 188    '(lambda (test)
 189      (let ((name (car test)))
 190        (cond
 191          ((stringp name)
 192           (cons name (etest-run (cdr test))))
 193          ((symbolp name)
 194           (let ((cand (car (plist-get etest-candidates-plist name)))
 195                 (args (cdr test))
 196                 (argcount (cadr (plist-get etest-candidates-plist name)))
 197                 (doc nil))
 198             (unless cand
 199               (error "'%s' is not a valid name type" name))
 200             (if (< (length args) argcount)
 201                 (error "%s needs %d arguments" cand argcount)
 202                 (if (and (eq (length args) (1+ argcount))
 203                          (stringp (car (last args))))
 204                     (progn
 205                       (setq doc (car (last args)))
 206                       (setq args (delq doc args)))
 207                     (setq doc (prin1-to-string test))))
 208             (plist-put (apply cand args) :doc doc))))))
 209    form))
 210
 211 ;; This is defined so that etest can test itself
 212 (defun etest-test-tests (test result)
 213   "This test is used to test ETest itself. TEST is the test to be
 214 run (in ETest syntax) and RESULT is a plist of items you would
 215 like to compare. See the file etest.etest for example usage."
 216   (let ((testres (car (etest-run (list test))))
 217         (my-res t)
 218         (my-comments ""))
 219     (when (null (plist-get testres :result))
 220       (setq my-comments "note: test result was nil\n"))
 221     (dolist (sym '(:result :comments :doc))
 222       (let ((testval (plist-get testres sym))
 223             (resultval (plist-get result sym)))
 224         (when (and (plist-member result sym)
 225                    (not (equal testval resultval)))
 226           (setq my-res nil)
 227           (setq my-comments
 228                 (concat my-comments
 229                         (format "got: %S from '%S'\n"
 230                                 resultval sym))))))
 231     (list :result my-res :comments my-comments)))
 232
 233 ;; Make `etest-test-tests' available
 234 (deftest '(eres 2) 'etest-test-tests)
 235
 236 (provide 'etest)