Re: [Gcl-devel] Patch for RT to pass its own test suite, use own package for tests

[Camm Maguire]

Greetings, and thanks for your submission!  I am testing it now with
the gcl ansi test suite, and if all is well, will commit it into cvs
head shortly.

Take care,

"Joseph Oswald" <address@hidden> writes:

> In my own work with RT, I was frustrated by its inability to pass it's
> own test suite, failing approximately half of its tests.
> Also, I felt bad about it populating the USER package.
> 
> Attached are two diffs, correcting these problems. I apologize if this
> is not the proper submission style---I'm not very experienced in this
> open-source contribution thing.
> 
> --Joe Oswald
> address@hidden
> 
> *** rt-package.lsp    2007/12/13 18:37:38     1.1
> --- rt-package.lsp    2007/12/13 18:38:01
> ***************
> *** 36,41 ****
> --- 36,42 ----
>        (export (mapcar #'intern
>                    (mapcar #'symbol-name
>                            '(#:*compile-tests*
> +                            #:*do-tests-when-defined*
>                              #:*test*
>                              #:continue-testing
>                              #:deftest
> 
> *** rt-test.lsp       2007/12/13 17:27:01     1.1
> --- rt-test.lsp       2007/12/13 18:43:23     1.3
> ***************
> *** 25,53 ****
>   ;RT regression tester to test itself.  See the documentation of RT for
>   ;a discusion of how to use this file.
>   
> ! (in-package :user)
>   ;; (require "RT")
> ! (use-package :regression-test)
>   
>   (defmacro setup (&rest body)
>     `(do-setup '(progn ., body)))
>   
>   (defun do-setup (form)
> !   (let ((*test* nil)
> !     (*do-tests-when-defined* nil)
> !     (regression-test::*entries* (list nil))
> !     (regression-test::*in-test* nil)
> !     (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))))
>   
>   (defun normalize (string)
>     (with-input-from-string (s string)
> --- 25,62 ----
>   ;RT regression tester to test itself.  See the documentation of RT for
>   ;a discusion of how to use this file.
>   
> ! (cl:defpackage :rt-tests
> !   (:use :cl :regression-test))
> ! 
> ! (in-package :rt-tests)
>   ;; (require "RT")
> ! ;;(use-package :regression-test)
>   
>   (defmacro setup (&rest body)
>     `(do-setup '(progn ., body)))
>   
> + (defmacro with-blank-tests (&body body)
> +   `(let ((regression-test::*entries* (list nil))
> +      (regression-test::*entries-table* (make-hash-table :test #'equal))
> +      (*test* nil)
> +      (regression-test::*in-test* nil))
> +     (let ((regression-test::*entries-tail* regression-test::*entries*))
> +       ,@body)))
> + 
>   (defun do-setup (form)
> !   (with-blank-tests
> !       (let ((*do-tests-when-defined* nil)
> !         (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)))))
>   
>   (defun normalize (string)
>     (with-input-from-string (s string)
> ***************
> *** 86,92 ****
>   
>   (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))
> --- 95,101 ----
>   
>   (deftest deftest-1
>     (setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
> !   ("Redefining test RT-TESTS::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))
> ***************
> *** 95,101 ****
>     () (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.")
> --- 104,110 ----
>     () (2 3 3) 2 (t1 (t 2) 2))
>   (deftest deftest-4
>     (setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3)))
> !   ("Test (RT-TESTS::TEMP) failed"
>      "Form: 4"
>      "Expected value: 3"
>      "Actual value: 4.")
> ***************
> *** 128,134 ****
>     () (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)))
> --- 137,143 ----
>     () (t3 1 1))
>   (deftest get-test-5 
>     (setup (get-test 't0))
> !   ("No test with name RT-TESTS::T0.") nil)
>   
>   (deftest rem-test-1
>     (setup (values (rem-test 't1) (pending-tests)))
> ***************
> *** 157,163 ****
>     (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"
> --- 166,172 ----
>     (setup (let ((*print-case* :downcase))
>          (values (do-tests) (continue-testing) (do-tests))))
>     ("Doing 2 pending tests of 2 tests total."
> !    " RT-TESTS::T1"
>      "Test (T 2) failed"
>      "Form: 4"
>      "Expected value: 3"
> ***************
> *** 170,176 ****
>      "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"
> --- 179,185 ----
>      "Actual value: 4."
>      "1 out of 2 total tests failed: (T 2)."
>      "Doing 2 pending tests of 2 tests total."
> !    " RT-TESTS::T1"
>      "Test (T 2) failed"
>      "Form: 4"
>      "Expected value: 3"
> ***************
> *** 185,196 ****
>        (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
> --- 194,205 ----
>        (deftest (t 2) 3 3)
>        (values (do-tests) (continue-testing) (do-tests)))
>     ("Doing 2 pending tests of 2 tests total."
> !    " RT-TESTS::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."
> !    " RT-TESTS::T1 (T 2)"
>      "No tests failed.")
>     t
>     t
> ***************
> *** 204,223 ****
>     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"
> --- 213,232 ----
>     t
>     t)
>   (deftest do-tests-4
> !   (setup (normalize (with-output-to-string (s) (do-tests :out s))))
>     ()
>     ("Doing 2 pending tests of 2 tests total."
> !    " RT-TESTS::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 :out s)))
>     ()
>     ("Doing 2 pending tests of 2 tests total."
> !    " RT-TESTS::T1"
>      "Test (T 2) failed"
>      "Form: 4"
>      "Expected value: 3"
> _______________________________________________
> Gcl-devel mailing list
> address@hidden
> http://lists.gnu.org/mailman/listinfo/gcl-devel

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah