From 5ea6c674b9886c537018e35adb62e6f1b748ffa3 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 27 Nov 2002 18:06:57 +0000 Subject: [PATCH] r3497: *** empty log message *** --- rt-doc.txt | 194 +++++++++++++++++++++++++++++++++++++++++++ rt-test.lisp | 229 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 423 insertions(+) create mode 100644 rt-doc.txt create mode 100644 rt-test.lisp diff --git a/rt-doc.txt b/rt-doc.txt new file mode 100644 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 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))) + +(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)) -- 2.34.1