github github
  • Home
  • Pricing and Signup
  • Training
  • Gist
  • Blog
  • Login

hober / selftest-el

  • Admin
  • Watch Unwatch
  • Fork
  • Your Fork
  • Pull Request
  • Download Source
    • 5
    • 1
  • Source
  • Commits
  • Network (1)
  • Issues (0)
  • Downloads (0)
  • Wiki (1)
  • Graphs
  • Branch: master

click here to add a description

click here to add a homepage

  • Switch Branches (1)
    • master ✓
  • Switch Tags (0)
  • Branch List
Sending Request…
Click here to lend your support to: selftest-el and make a donation at www.pledgie.com !

run your personal unit tests in Emacs — Read more

  Cancel

http://hober.backpackit.com/pub/1233865

  Cancel
  • HTTP
  • Git Read-Only

This URL has Read+Write access

Remove redundant Make step. 
hober (author)
Tue Aug 31 19:45:12 -0700 2010
commit  c41beaadafa06a9fe4f1
tree    90222e59dd9484e48839
parent  cbb727c4c759e8026dd9
selftest-el / selftest.el selftest.el
Txt 100644 158 lines (131 sloc) 5.723 kb
  • edit
  • raw
  • blame
  • history
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
;;; selftest.el --- Personal unit tests

;; Copyright (C) 2007, 2008, 2009 Edward O'Connor

;; Author: Edward O'Connor <hober0@gmail.com>
;; 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; 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:
;;
;; http://withoutane.com/rants/2007/08/personal-unit-tests

;; 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 http://edward.oconnor.cx/elisp/read-char-spec.el
(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)))
    `(progn
       (defun ,test-func-sym (answer)
         ,(format "Personal unit test %s" (list 'quote slug))
         (interactive (list (selftest-ask ,question)))
         answer)
       (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
       ',test-func-sym)))

(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))))
            skip-count)))

(defun selftest-always-p ()
  t)
(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."
  (interactive)
  (let ((results '())
        result)
    (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)))
    results))

(provide 'selftest)
;;; selftest.el ends here

Dedicated Server Powered by the Dedicated Servers and
Cloud Computing of Rackspace Hosting®
  • Blog
  • Support
  • Training
  • Job Board
  • Shop
  • Contact
  • API
  • Status
  • © 2010 GitHub Inc. All rights reserved.
  • Terms of Service
  • Privacy
  • Security
  • English
  • Deutsch
  • Français
  • 日本語
  • Português (BR)
  • 中文
  • See all available languages

Your current locale selection: English. Choose another?

  • English
  • Afrikaans
  • Català
  • Čeština
  • Deutsch
  • Español
  • Français
  • Hrvatski
  • Indonesia
  • Italiano
  • 日本語
  • Nederlands
  • Norsk
  • Polski
  • Português (BR)
  • Српски
  • Svenska
  • 中文