46 |
(defvar *expected-failures* nil |
(defvar *expected-failures* nil |
47 |
"A list of test names that are expected to fail.") |
"A list of test names that are expected to fail.") |
48 |
|
|
49 |
|
(defvar *notes* (make-hash-table :test 'equal) |
50 |
|
"A mapping from names of notes to note objects.") |
51 |
|
|
52 |
(defstruct (entry (:conc-name nil)) |
(defstruct (entry (:conc-name nil)) |
53 |
pend name props form vals) |
pend name props form vals) |
54 |
|
|
55 |
|
;;; Note objects are used to attach information to tests. |
56 |
|
;;; A typical use is to mark tests that depend on a particular |
57 |
|
;;; part of a set of requirements, or a particular interpretation |
58 |
|
;;; of the requirements. |
59 |
|
|
60 |
|
(defstruct note |
61 |
|
name |
62 |
|
contents |
63 |
|
disabled ;; When true, tests with this note are considered inactive |
64 |
|
) |
65 |
|
|
66 |
;; (defmacro vals (entry) `(cdddr ,entry)) |
;; (defmacro vals (entry) `(cdddr ,entry)) |
67 |
|
|
68 |
(defmacro defn (entry) |
(defmacro defn (entry) |
101 |
name)) |
name)) |
102 |
entry)) |
entry)) |
103 |
|
|
104 |
|
(defun entry-notes (entry) |
105 |
|
(let* ((props (props entry)) |
106 |
|
(notes (getf props :notes))) |
107 |
|
(if (listp notes) |
108 |
|
notes |
109 |
|
(list notes)))) |
110 |
|
|
111 |
|
(defun has-disabled-note (entry) |
112 |
|
(let ((notes (entry-notes entry))) |
113 |
|
(loop for n in notes |
114 |
|
for note = (if (note-p n) n |
115 |
|
(gethash n *notes*)) |
116 |
|
thereis (and note (note-disabled note))))) |
117 |
|
|
118 |
(defmacro deftest (name &rest body) |
(defmacro deftest (name &rest body) |
119 |
(let* ((p body) |
(let* ((p body) |
120 |
(properties |
(properties |
307 |
(defun do-entries (s) |
(defun do-entries (s) |
308 |
(format s "~&Doing ~A pending test~:P ~ |
(format s "~&Doing ~A pending test~:P ~ |
309 |
of ~A tests total.~%" |
of ~A tests total.~%" |
310 |
(count t (cdr *entries*) |
(count t (the list (cdr *entries*)) :key #'pend) |
|
:key #'pend) |
|
311 |
(length (cdr *entries*))) |
(length (cdr *entries*))) |
312 |
(dolist (entry (cdr *entries*)) |
(dolist (entry (cdr *entries*)) |
313 |
(when (pend entry) |
(when (and (pend entry) |
314 |
|
(not (has-disabled-note entry))) |
315 |
(format s "~@[~<~%~:; ~:@(~S~)~>~]" |
(format s "~@[~<~%~:; ~:@(~S~)~>~]" |
316 |
(do-entry entry s)))) |
(do-entry entry s)))) |
317 |
(let ((pending (pending-tests)) |
(let ((pending (pending-tests)) |
342 |
new-failures))) |
new-failures))) |
343 |
)) |
)) |
344 |
(null pending)))) |
(null pending)))) |
345 |
|
|
346 |
|
;;; Note handling functions and macros |
347 |
|
|
348 |
|
(defmacro defnote (name contents) |
349 |
|
`(eval-when #+gcl (load eval) #-gcl (:load-toplevel :execute) |
350 |
|
(let ((note (make-note :name ,name :contents ,contents))) |
351 |
|
(setf (gethash *notes* (note-name note)) note) |
352 |
|
note))) |
353 |
|
|