rt-test.lsp 7.43 KB
Newer Older
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
;-*-syntax:COMMON-LISP-*-

#|----------------------------------------------------------------------------|
 | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
 |                                                                            |
 | Permission  to  use,  copy, modify, and distribute this software  and  its |
 | documentation for any purpose  and without fee is hereby granted, provided |
 | that this copyright  and  permission  notice  appear  in  all  copies  and |
 | supporting  documentation,  and  that  the  name  of M.I.T. not be used in |
 | advertising or  publicity  pertaining  to  distribution  of  the  software |
 | without   specific,   written   prior   permission.    M.I.T.   makes   no |
 | representations  about  the  suitability of this software for any purpose. |
 | It is provided "as is" without express or implied warranty.                |
 |                                                                            |
 |  M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,  INCLUDING  |
 |  ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL  |
 |  M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL  DAMAGES  OR  |
 |  ANY  DAMAGES  WHATSOEVER  RESULTING  FROM  LOSS OF USE, DATA OR PROFITS,  |
 |  WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER  TORTIOUS  ACTION,  |
 |  ARISING  OUT  OF  OR  IN  CONNECTION WITH THE USE OR PERFORMANCE OF THIS  |
 |  SOFTWARE.                                                                 |
 |----------------------------------------------------------------------------|#

;This is the December 19, 1990 version of a set of tests that use the
;RT regression tester to test itself.  See the documentation of RT for
;a discusion of how to use this file.

camm's avatar
camm committed
28 29 30 31
(cl:defpackage :rt-tests
  (:use :cl :regression-test))

(in-package :rt-tests)
32
;; (require "RT")
camm's avatar
camm committed
33
;;(use-package :regression-test)
34 35 36 37

(defmacro setup (&rest body)
  `(do-setup '(progn ., body)))

camm's avatar
camm committed
38 39
(defmacro with-blank-tests (&body body)
  `(let ((regression-test::*entries* (list nil))
sds's avatar
sds committed
40 41 42
         (regression-test::*entries-table* (make-hash-table :test #'equal))
         (*test* nil)
         (regression-test::*in-test* nil))
camm's avatar
camm committed
43 44 45
    (let ((regression-test::*entries-tail* regression-test::*entries*))
      ,@body)))

46
(defun do-setup (form)
camm's avatar
camm committed
47 48
  (with-blank-tests
      (let ((*do-tests-when-defined* nil)
sds's avatar
sds committed
49 50 51 52 53 54 55 56 57 58 59
            (regression-test::*debug* t)
            result)
        (deftest t1 4 4)
        (deftest (t 2) 4 3)
        (values-list
         (cons (normalize
              (with-output-to-string (*standard-output*)
                (setq result
                      (multiple-value-list
                        (catch 'regression-test::*debug* (eval form))))))
            result)))))
60 61 62 63 64 65 66 67 68

(defun normalize (string)
  (with-input-from-string (s string)
    (normalize-stream s)))

(defvar *file-name* nil)

(defun get-file-name ()
  (loop (if *file-name* (return *file-name*))
sds's avatar
sds committed
69 70 71 72
        (format *error-output*
                "~%Type a string representing naming of a scratch disk file: ")
        (setq *file-name* (read))
        (if (not (stringp *file-name*)) (setq *file-name* nil))))
73 74 75 76 77 78 79 80 81 82

(get-file-name)

(defmacro with-temporary-file (f &body forms)
  `(let ((,f *file-name*))
     ,@ forms
     (get-file-output ,f)))

(defun get-file-output (f)
  (prog1 (with-open-file (in f)
sds's avatar
sds committed
83 84
           (normalize-stream in))
         (delete-file f)))
85 86 87 88

(defun normalize-stream (s)
  (let ((l nil))
    (loop (push (read-line s nil s) l)
sds's avatar
sds committed
89 90 91
          (when (eq (car l) s)
            (setq l (nreverse (cdr l)))
            (return nil)))
92 93 94 95 96 97
    (delete "" l :test #'equal)))

(rem-all-tests)

(deftest deftest-1
  (setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
camm's avatar
camm committed
98
  ("Redefining test RT-TESTS::T1") (t1 3 3) t1 (t1 (t 2)))
99 100 101 102 103 104 105 106
(deftest deftest-2
  (setup (deftest (t 2) 3 3) (get-test '(t 2)))
  ("Redefining test (T 2)") ((t 2) 3 3))
(deftest deftest-3
  (setup (deftest 2 3 3) (values (get-test 2) *test* (pending-tests)))
  () (2 3 3) 2 (t1 (t 2) 2))
(deftest deftest-4
  (setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3)))
camm's avatar
camm committed
107
  ("Test (RT-TESTS::TEMP) failed"
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
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4.")
  (temp))

(deftest do-test-1
  (setup (values (do-test 't1) *test* (pending-tests)))
  () t1 t1 ((t 2)))
(deftest do-test-2
  (setup (values (do-test '(t 2)) (pending-tests)))
  ("Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4.") nil (t1 (t 2)))
(deftest do-test-3
  (setup (let ((*test* 't1)) (do-test)))
  () t1)

(deftest get-test-1
  (setup (values (get-test 't1) *test*))
  () (t1 4 4) (t 2))
(deftest get-test-2
  (setup (get-test '(t 2)))
  () ((t 2) 4 3))
(deftest get-test-3
  (setup (let ((*test* 't1)) (get-test)))
  () (t1 4 4))
(deftest get-test-4
  (setup (deftest t3 1 1) (get-test))
  () (t3 1 1))
sds's avatar
sds committed
138
(deftest get-test-5
139
  (setup (get-test 't0))
camm's avatar
camm committed
140
  ("No test with name RT-TESTS::T0.") nil)
141 142 143 144 145 146 147 148

(deftest rem-test-1
  (setup (values (rem-test 't1) (pending-tests)))
  () t1 ((t 2)))
(deftest rem-test-2
  (setup (values (rem-test '(t 2)) (pending-tests)))
  () (t 2) (t1))
(deftest rem-test-3
sds's avatar
sds committed
149
  (setup (let ((*test* '(t 2))) (rem-test)) (pending-tests))
150 151 152 153 154 155 156 157 158 159 160 161 162
  () (t1))
(deftest rem-test-4
  (setup (values (rem-test 't0) (pending-tests)))
  () nil (t1 (t 2)))
(deftest rem-test-5
  (setup (rem-all-tests) (rem-test 't0) (pending-tests))
  () ())

(deftest rem-all-tests-1
  (setup (values (rem-all-tests) (pending-tests)))
  () nil nil)
(deftest rem-all-tests-2
  (setup (rem-all-tests) (rem-all-tests) (pending-tests))
sds's avatar
sds committed
163
  () nil)
164 165 166

(deftest do-tests-1
  (setup (let ((*print-case* :downcase))
sds's avatar
sds committed
167
           (values (do-tests) (continue-testing) (do-tests))))
168
  ("Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
169
   " RT-TESTS::T1"
170 171 172 173 174 175 176 177 178 179 180 181
   "Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4."
   "1 out of 2 total tests failed: (T 2)."
   "Doing 1 pending test of 2 tests total."
   "Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4."
   "1 out of 2 total tests failed: (T 2)."
   "Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
182
   " RT-TESTS::T1"
183 184 185 186 187 188 189 190 191 192 193
   "Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4."
   "1 out of 2 total tests failed: (T 2).")
  nil
  nil
  nil)

(deftest do-tests-2
  (setup (rem-test '(t 2))
sds's avatar
sds committed
194 195
         (deftest (t 2) 3 3)
         (values (do-tests) (continue-testing) (do-tests)))
196
  ("Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
197
   " RT-TESTS::T1 (T 2)"
198 199 200 201
   "No tests failed."
   "Doing 0 pending tests of 2 tests total."
   "No tests failed."
   "Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
202
   " RT-TESTS::T1 (T 2)"
203 204 205 206 207 208 209 210 211 212 213 214 215
   "No tests failed.")
  t
  t
  t)
(deftest do-tests-3
  (setup (rem-all-tests) (values (do-tests) (continue-testing)))
  ("Doing 0 pending tests of 0 tests total."
   "No tests failed."
   "Doing 0 pending tests of 0 tests total."
   "No tests failed.")
  t
  t)
(deftest do-tests-4
camm's avatar
camm committed
216
  (setup (normalize (with-output-to-string (s) (do-tests :out s))))
217 218
  ()
  ("Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
219
   " RT-TESTS::T1"
220 221 222 223 224 225
   "Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4."
   "1 out of 2 total tests failed: (T 2)."))
(deftest do-tests-5
camm's avatar
camm committed
226
  (setup (with-temporary-file s (do-tests :out s)))
227 228
  ()
  ("Doing 2 pending tests of 2 tests total."
camm's avatar
camm committed
229
   " RT-TESTS::T1"
230 231 232 233 234 235 236 237 238
   "Test (T 2) failed"
   "Form: 4"
   "Expected value: 3"
   "Actual value: 4."
   "1 out of 2 total tests failed: (T 2)."))

(deftest continue-testing-1
  (setup (deftest temp (continue-testing) 5) (do-test 'temp) (pending-tests))
  () (t1 (t 2) temp))