--- /dev/null
+;-*-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.
+
+(in-package :cl-user)
+(require :rt)
+(use-package :rt)
+
+(defmacro setup (&rest body)
+ `(do-setup '(progn ., body)))
+
+(defun do-setup (form)
+ (let ((*test* nil)
+ (*do-tests-when-defined* nil)
+ (rt::*entries* (list nil))
+ (rt::*in-test* nil)
+ (rt::*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 'rt::*debug* (eval form))))))
+ result))))
+
+(defun normalize (string)
+ (with-input-from-string (s string)
+ (normalize-stream s)))
+\f
+(defvar *file-name* nil)
+
+(defun get-file-name ()
+ (loop (if *file-name* (return *file-name*))
+ (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))))
+
+(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)
+ (normalize-stream in))
+ (delete-file f)))
+
+(defun normalize-stream (s)
+ (let ((l nil))
+ (loop (push (read-line s nil s) l)
+ (when (eq (car l) s)
+ (setq l (nreverse (cdr l)))
+ (return nil)))
+ (delete "" l :test #'equal)))
+
+(rem-all-tests)
+
+(deftest deftest-1
+ (setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
+ ("Redefining test T1") (t1 3 3) t1 (t1 (t 2)))
+(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)))
+ ("Test (TEMP) failed"
+ "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))
+(deftest get-test-5
+ (setup (get-test 't0))
+ ("No test with name T0.") nil)
+
+(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
+ (setup (let ((*test* '(t 2))) (rem-test)) (pending-tests))
+ () (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))
+ () nil)
+
+(deftest do-tests-1
+ (setup (let ((*print-case* :downcase))
+ (values (do-tests) (continue-testing) (do-tests))))
+ ("Doing 2 pending tests of 2 tests total."
+ " T1"
+ "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."
+ " T1"
+ "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))
+ (deftest (t 2) 3 3)
+ (values (do-tests) (continue-testing) (do-tests)))
+ ("Doing 2 pending tests of 2 tests total."
+ " T1 (T 2)"
+ "No tests failed."
+ "Doing 0 pending tests of 2 tests total."
+ "No tests failed."
+ "Doing 2 pending tests of 2 tests total."
+ " T1 (T 2)"
+ "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
+ (setup (normalize (with-output-to-string (s) (do-tests s))))
+ ()
+ ("Doing 2 pending tests of 2 tests total."
+ " T1"
+ "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
+ (setup (with-temporary-file s (do-tests s)))
+ ()
+ ("Doing 2 pending tests of 2 tests total."
+ " T1"
+ "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))
projects / rt.git / blobdiff