/[gcl]/gcl/ansi-tests/rt.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/rt.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by pfdietz, Sat Jun 28 21:02:55 2003 UTC revision 1.10 by pfdietz, Tue Jul 1 02:08:54 2003 UTC
# Line 46  Line 46 
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)
# Line 87  Line 101 
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
# Line 279  Line 307 
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))
# Line 314  Line 342 
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    

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26