1 ;-*-syntax:COMMON-LISP-*-
3 #|----------------------------------------------------------------------------|
4 | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
6 | Permission to use, copy, modify, and distribute this software and its |
7 | documentation for any purpose and without fee is hereby granted, provided |
8 | that this copyright and permission notice appear in all copies and |
9 | supporting documentation, and that the name of M.I.T. not be used in |
10 | advertising or publicity pertaining to distribution of the software |
11 | without specific, written prior permission. M.I.T. makes no |
12 | representations about the suitability of this software for any purpose. |
13 | It is provided "as is" without express or implied warranty. |
15 | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
16 | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL |
17 | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR |
18 | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, |
19 | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, |
20 | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS |
22 |----------------------------------------------------------------------------|#
24 ;This is the December 19, 1990 version of a set of tests that use the
25 ;RT regression tester to test itself. See the documentation of RT for
26 ;a discusion of how to use this file.
32 (defmacro setup (&rest body)
33 `(do-setup '(progn ., body)))
35 (defun do-setup (form)
37 (*do-tests-when-defined* nil)
38 (rt::*entries* (list nil))
46 (with-output-to-string (*standard-output*)
49 (catch 'rt::*debug* (eval form))))))
52 (defun normalize (string)
53 (with-input-from-string (s string)
54 (normalize-stream s)))
56 (defvar *file-name* nil)
58 (defun get-file-name ()
59 (loop (if *file-name* (return *file-name*))
60 (format *error-output*
61 "~%Type a string representing naming of a scratch disk file: ")
62 (setq *file-name* (read))
63 (if (not (stringp *file-name*)) (setq *file-name* nil))))
67 (defmacro with-temporary-file (f &body forms)
68 `(let ((,f *file-name*))
70 (get-file-output ,f)))
72 (defun get-file-output (f)
73 (prog1 (with-open-file (in f)
74 (normalize-stream in))
77 (defun normalize-stream (s)
79 (loop (push (read-line s nil s) l)
81 (setq l (nreverse (cdr l)))
83 (delete "" l :test #'equal)))
88 (setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
89 ("Redefining test T1") (t1 3 3) t1 (t1 (t 2)))
91 (setup (deftest (t 2) 3 3) (get-test '(t 2)))
92 ("Redefining test (T 2)") ((t 2) 3 3))
94 (setup (deftest 2 3 3) (values (get-test 2) *test* (pending-tests)))
95 () (2 3 3) 2 (t1 (t 2) 2))
97 (setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3)))
105 (setup (values (do-test 't1) *test* (pending-tests)))
108 (setup (values (do-test '(t 2)) (pending-tests)))
112 "Actual value: 4.") nil (t1 (t 2)))
114 (setup (let ((*test* 't1)) (do-test)))
118 (setup (values (get-test 't1) *test*))
121 (setup (get-test '(t 2)))
124 (setup (let ((*test* 't1)) (get-test)))
127 (setup (deftest t3 1 1) (get-test))
130 (setup (get-test 't0))
131 ("No test with name T0.") nil)
134 (setup (values (rem-test 't1) (pending-tests)))
137 (setup (values (rem-test '(t 2)) (pending-tests)))
140 (setup (let ((*test* '(t 2))) (rem-test)) (pending-tests))
143 (setup (values (rem-test 't0) (pending-tests)))
146 (setup (rem-all-tests) (rem-test 't0) (pending-tests))
149 (deftest rem-all-tests-1
150 (setup (values (rem-all-tests) (pending-tests)))
152 (deftest rem-all-tests-2
153 (setup (rem-all-tests) (rem-all-tests) (pending-tests))
157 (setup (let ((*print-case* :downcase))
158 (values (do-tests) (continue-testing) (do-tests))))
159 ("Doing 2 pending tests of 2 tests total."
165 "1 out of 2 total tests failed: (T 2)."
166 "Doing 1 pending test of 2 tests total."
171 "1 out of 2 total tests failed: (T 2)."
172 "Doing 2 pending tests of 2 tests total."
178 "1 out of 2 total tests failed: (T 2).")
184 (setup (rem-test '(t 2))
186 (values (do-tests) (continue-testing) (do-tests)))
187 ("Doing 2 pending tests of 2 tests total."
190 "Doing 0 pending tests of 2 tests total."
192 "Doing 2 pending tests of 2 tests total."
199 (setup (rem-all-tests) (values (do-tests) (continue-testing)))
200 ("Doing 0 pending tests of 0 tests total."
202 "Doing 0 pending tests of 0 tests total."
207 (setup (normalize (with-output-to-string (s) (do-tests s))))
209 ("Doing 2 pending tests of 2 tests total."
215 "1 out of 2 total tests failed: (T 2)."))
217 (setup (with-temporary-file s (do-tests s)))
219 ("Doing 2 pending tests of 2 tests total."
225 "1 out of 2 total tests failed: (T 2)."))
227 (deftest continue-testing-1
228 (setup (deftest temp (continue-testing) 5) (do-test 'temp) (pending-tests))