r3497: *** empty log message ***

diff --git a/rt-doc.txt b/rt-doc.txt
new file mode 100644 (file)
index 0000000..8c07b8d
--- /dev/null
+++ b/rt-doc.txt
@@ -0,0 +1,194 @@
+
+#|----------------------------------------------------------------------------|
+ | 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 brief documentation for the
+   RT regression tester.  A more complete discussion can be found in
+   the article in Lisp Pointers.)
+
+The functions, macros, and variables that make up the RT regression tester are
+in a package called "RT".  The ten exported symbols are documented below.  If
+you want to refer to these symbols without a package prefix, you have to `use'
+the package.
+
+The basic unit of concern of RT is the test.  Each test has an identifying name
+and a body that specifies the action of the test.  Functions are provided for
+defining, redefining, removing, and performing individual tests and the test
+suite as a whole.  In addition, information is maintained about which tests have
+succeeded and which have failed.
+
+
+<> deftest NAME FORM &rest VALUES
+
+Individual tests are defined using the macro DEFTEST.  The identifying NAME is
+typically a number or symbol, but can be any Lisp form.  If the test suite
+already contains a test with the same (EQUAL) NAME, then this test is redefined
+and a warning message printed.  (This warning is important to alert the user
+when a test suite definition file contains two tests with the same name.)  When
+the test is a new one, it is added to the end of the suite.  In either case,
+NAME is returned as the value of DEFTEST and stored in the variable *TEST*.
+
+(deftest t-1 (floor 15/7) 2 1/7) => t-1
+
+(deftest (t 2) (list 1) (1)) => (t 2)
+
+(deftest bad (1+ 1) 1) => bad
+
+(deftest good (1+ 1) 2) => good
+
+The FORM can be any kind of Lisp form.  The zero or more VALUES can be any kind
+of Lisp objects.  The test is performed by evaluating FORM and comparing the
+results with the VALUES.  The test succeeds if and only if FORM produces the
+correct number of results and each one is EQUAL to the corresponding VALUE.
+
+
+<> *test* NAME-OF-CURRENT-TEST
+
+The variable *TEST* contains the name of the test most recently defined or
+performed.  It is set by DEFTEST and DO-TEST.
+
+
+<> do-test &optional (NAME *TEST*)
+
+The function DO-TEST performs the test identified by NAME, which defaults to
+*TEST*.  Before running the test, DO-TEST stores NAME in the variable *TEST*.
+If the test succeeds, DO-TEST returns NAME as its value.  If the test fails,
+DO-TEST returns NIL, after printing an error report on *STANDARD-OUTPUT*.  The
+following examples show the results of performing two of the tests defined
+above.
+
+(do-test '(t 2)) => (t 2)
+
+(do-test 'bad) => nil ; after printing:
+Test BAD failed
+Form: (1+ 1)
+Expected value: 1
+Actual value: 2.
+
+
+<> *do-tests-when-defined*  default value  NIL
+
+If the value of this variable is non-null, each test is performed at the moment
+that it is defined.  This is helpful when interactively constructing a suite of
+tests.  However, when loading a test suite for later use, performing tests as
+they are defined is not liable to be helpful.
+
+
+<> get-test &optional (NAME *TEST*)
+
+This function returns the NAME, FORM, and VALUES of the specified test.
+
+(get-test '(t 2)) => ((t 2) (list 1) (1))
+
+
+<> rem-test &optional (NAME *TEST*)
+
+If the indicated test is in the test suite, this function removes it and returns
+NAME.  Otherwise, NIL is returned.
+
+
+<> rem-all-tests
+
+This function reinitializes RT by removing every test from the test suite and
+returns NIL.  Generally, it is advisable for the whole test suite to apply to
+some one system.  When switching from testing one system to testing another, it
+is wise to remove all the old tests before beginning to define new ones.
+
+
+<> do-tests &optional (OUT *STANDARD-OUTPUT*)
+
+This function uses DO-TEST to run each of the tests in the test suite and prints
+a report of the results on OUT, which can either be an output stream or the name
+of a file.  If OUT is omitted, it defaults to *STANDARD-OUTPUT*.  DO-TESTS
+returns T if every test succeeded and NIL if any test failed.
+
+As illustrated below, the first line of the report produced by DO-TEST shows how
+many tests need to be performed.  The last line shows how many tests failed and
+lists their names.  While the tests are being performed, DO-TESTS prints the
+names of the successful tests and the error reports from the unsuccessful tests.
+
+(do-tests "report.txt") => nil
+; the file "report.txt" contains:
+Doing 4 pending tests of 4 tests total.
+ T-1 (T 2)
+Test BAD failed
+Form: (1+ 1)
+Expected value: 1
+Actual value: 2.
+ GOOD
+1 out of 4 total tests failed: BAD.
+
+It is best if the individual tests in the suite are totally independent of each
+other.  However, should the need arise for some interdependence, you can rely on
+the fact that DO-TESTS will run tests in the order they were originally defined.
+
+
+<> pending-tests
+
+When a test is defined or redefined, it is marked as pending.  In addition,
+DO-TEST marks the test to be run as pending before running it and DO-TESTS marks
+every test as pending before running any of them.  The only time a test is
+marked as not pending is when it completes successfully.  The function
+PENDING-TESTS returns a list of the names of the currently pending tests.
+
+(pending-tests) => (bad)
+
+
+<> continue-testing
+
+This function is identical to DO-TESTS except that it only runs the tests that
+are pending and always writes its output on *STANDARD-OUTPUT*.
+
+(continue-testing) => nil ; after printing:
+Doing 1 pending test out of 4 total tests.
+Test BAD failed
+Form: (1+ 1)
+Expected value: 1
+Actual value: 2.
+1 out of 4 total tests failed: BAD.
+
+CONTINUE-TESTING has a special meaning if called at a breakpoint generated while
+a test is being performed.  The failure of a test to return the correct value
+does not trigger an error break.  However, there are many kinds of things that
+can go wrong while a test is being performed (e.g., dividing by zero) that will
+cause breaks.
+
+If CONTINUE-TESTING is evaluated in a break generated during testing, it aborts
+the current test (which remains pending) and forces the processing of tests to
+continue.  Note that in such a breakpoint, *TEST* is bound to the name of the
+test being performed and (GET-TEST) can be used to look at the test.
+
+When building a system, it is advisable to start constructing a test suite for
+it as soon as possible.  Since individual tests are rather weak, a comprehensive
+test suite requires large numbers of tests.  However, these can be accumulated
+over time.  In particular, whenever a bug is found by some means other than
+testing, it is wise to add a test that would have found the bug and therefore
+will ensure that the bug will not reappear.
+
+Every time the system is changed, the entire test suite should be run to make
+sure that no unintended changes have occurred.  Typically, some tests will fail.
+Sometimes, this merely means that tests have to be changed to reflect changes in
+the system's specification.  Other times, it indicates bugs that have to be
+tracked down and fixed.  During this phase, CONTINUE-TESTING is useful for
+focusing on the tests that are failing.  However, for safety sake, it is always
+wise to reinitialize RT, redefine the entire test suite, and run DO-TESTS one
+more time after you think all of the tests are working.
+

diff --git a/rt-test.lisp b/rt-test.lisp
new file mode 100644 (file)
index 0000000..c045aa1
--- /dev/null
+++ b/rt-test.lisp
@@ -0,0 +1,229 @@
+;-*-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))