Find file
Fetching contributors…
Cannot retrieve contributors at this time
158 lines (131 sloc) 5.59 KB
;;; selftest.el --- Personal unit tests
;; Copyright (C) 2007, 2008, 2009 Edward O'Connor
;; Author: Edward O'Connor <>
;; Keywords: convenience
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This is a simple library for managing your personal unit tests. If
;; you're unfamiliar with the concept, please read this blog post:
;; Here's an example use:
;; (require 'selftest)
;; (define-selftest exercise
;; "Did I get >=30min of exercise yesterday"
;; :group 'health
;; :when 'always)
;; The command `selftest-run' may be used to run all of your tests.
;;; History:
;; 2007-09-11: Initial version.
;; 2007-09-13: Added `selftest-analyze'.
;; 2007-09-14: Added automatic Twitter posting.
;; Uses (a patched version of) twit.el, which see.
;; 2008-01-08: Added ability to filter when each test should be taken.
;; 2009-06-19: Use `read-char-spec' for `selftest-ask' UI.
;;; Code:
;; Latest version at
(autoload 'read-char-spec "read-char-spec")
(defvar selftest-tests '())
(defvar selftest-twitter-results t
"*When non-null, post selftest results to your Twitter account.
Requires twit.el, which is available on the EmacsWiki.")
(defun selftest-ask (prompt)
"Like `y-or-n-p', but asks (with PROMPT) for pass, fail, or skip."
(read-char-spec prompt '((?p :pass "You passed this test")
(?f :fail "You failed this test")
(?y :pass "You passed this test")
(?n :fail "You failed this test")
(?s :skip "You're skipping this test"))))
(defmacro define-selftest (slug question &rest params)
"Defines a new personal unit test named SLUG.
QUESTION is the question to ask the user.
PARAMS are currently ignored."
(let ((test-func-sym (intern (format "selftest-%s" slug)))
(group (or (plist-get params :group) 'misc))
(predicate (or (plist-get params :when) 'always)))
(defun ,test-func-sym (answer)
,(format "Personal unit test %s" (list 'quote slug))
(interactive (list (selftest-ask ,question)))
(put ',test-func-sym :selftest-slug ',slug)
(put ',test-func-sym :selftest-group ,group)
(put ',test-func-sym :selftest-predicate ,predicate)
(add-to-list 'selftest-tests ',test-func-sym)
;; FIXME: do something with group
(put 'define-selftest 'lisp-indent-function 1)
(put 'define-selftest 'doc-string-elt 2)
(defun selftest-analyze (results)
"Produce a report on the pass/fail ratio in RESULTS."
(let ((date (car results))
(results (cdr results))
(pass-count 0)
(fail-count 0)
(pass/fail-count 0)
(skip-count 0))
(dolist (test results)
(when (eq (cdr test) :pass) (incf pass-count))
(when (eq (cdr test) :fail) (incf fail-count))
(when (eq (cdr test) :skip) (incf skip-count)))
(setq pass/fail-count (+ pass-count fail-count))
(format "Personal unit test results for %s: %d/%d (%d%%) passed, %d skipped."
date pass-count pass/fail-count
(round (* 100 (/ (float pass-count) (float pass/fail-count))))
(defun selftest-always-p ()
(put 'always :selftest-predicate 'selftest-always-p)
(defun selftest-monday-p ()
(let ((day-of-week (nth 6 (decode-time (current-time)))))
(= day-of-week 1)))
(put 'monday :selftest-predicate 'selftest-monday-p)
(defun selftest-weekday-p ()
(let ((day-of-week (nth 6 (decode-time (current-time)))))
(and (> day-of-week 0) (< day-of-week 7))))
(put 'weekday :selftest-predicate 'selftest-weekday-p)
(defun selftest-weekend-p ()
(not (selftest-weekday-p)))
(put 'weekend :selftest-predicate 'selftest-weekend-p)
(defun selftest-predicate (sym)
"Return the selftest predicate for SYM.
Defaults to `selftest-always-p'."
(let ((predicate (get sym :selftest-predicate)))
(cond (predicate (selftest-predicate predicate))
((functionp sym) sym)
(t 'always))))
(defun selftest-take-test-p (test)
"Non-null iff TEST should be taken today."
(funcall (selftest-predicate test)))
(defun selftest-run (&rest ignore)
"Run all defined selftests, and insert the results at point."
(let ((results '())
(dolist (test selftest-tests)
(if (selftest-take-test-p test)
(setq result (call-interactively test))
(setq result :skip))
(add-to-list 'results (cons (get test :selftest-slug) result)))
(setq results (cons (format-time-string "%Y-%m-%d") results))
(prin1 results (current-buffer))
(let ((analysis (selftest-analyze results)))
(when (called-interactively-p)
(message "%s" analysis))
(when (and (require 'twit nil t) selftest-twitter-results)
(twit-post analysis)))
(provide 'selftest)
;;; selftest.el ends here