Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Karsten Poeck
ansi-test
Commits
1e2c719d
Commit
1e2c719d
authored
Dec 18, 2007
by
camm
Browse files
rt patch applied
parent
6ab3e29c
Changes
2
Show whitespace changes
Inline
Side-by-side
ansi-tests/rt-package.lsp
View file @
1e2c719d
...
@@ -36,6 +36,7 @@
...
@@ -36,6 +36,7 @@
(export (mapcar #'intern
(export (mapcar #'intern
(mapcar #'symbol-name
(mapcar #'symbol-name
'(#:*compile-tests*
'(#:*compile-tests*
#:*do-tests-when-defined*
#:*test*
#:*test*
#:continue-testing
#:continue-testing
#:deftest
#:deftest
...
...
ansi-tests/rt-test.lsp
View file @
1e2c719d
...
@@ -25,18 +25,27 @@
...
@@ -25,18 +25,27 @@
;RT regression tester to test itself. See the documentation of RT for
;RT regression tester to test itself. See the documentation of RT for
;a discusion of how to use this file.
;a discusion of how to use this file.
(in-package :user)
(cl:defpackage :rt-tests
(:use :cl :regression-test))
(in-package :rt-tests)
;; (require "RT")
;; (require "RT")
(use-package :regression-test)
;;
(use-package :regression-test)
(defmacro setup (&rest body)
(defmacro setup (&rest body)
`(do-setup '(progn ., 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)
(defun do-setup (form)
(let ((*test* nil)
(with-blank-tests
(*do-tests-when-defined* nil)
(let ((*do-tests-when-defined* nil)
(regression-test::*entries* (list nil))
(regression-test::*in-test* nil)
(regression-test::*debug* t)
(regression-test::*debug* t)
result)
result)
(deftest t1 4 4)
(deftest t1 4 4)
...
@@ -47,7 +56,7 @@
...
@@ -47,7 +56,7 @@
(setq result
(setq result
(multiple-value-list
(multiple-value-list
(catch 'regression-test::*debug* (eval form))))))
(catch 'regression-test::*debug* (eval form))))))
result))))
result))))
)
(defun normalize (string)
(defun normalize (string)
(with-input-from-string (s string)
(with-input-from-string (s string)
...
@@ -86,7 +95,7 @@
...
@@ -86,7 +95,7 @@
(deftest deftest-1
(deftest deftest-1
(setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
(setup (deftest t1 3 3) (values (get-test 't1) *test* (pending-tests)))
("Redefining test T1") (t1 3 3) t1 (t1 (t 2)))
("Redefining test
RT-TESTS::
T1") (t1 3 3) t1 (t1 (t 2)))
(deftest deftest-2
(deftest deftest-2
(setup (deftest (t 2) 3 3) (get-test '(t 2)))
(setup (deftest (t 2) 3 3) (get-test '(t 2)))
("Redefining test (T 2)") ((t 2) 3 3))
("Redefining test (T 2)") ((t 2) 3 3))
...
@@ -95,7 +104,7 @@
...
@@ -95,7 +104,7 @@
() (2 3 3) 2 (t1 (t 2) 2))
() (2 3 3) 2 (t1 (t 2) 2))
(deftest deftest-4
(deftest deftest-4
(setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3)))
(setup (let ((*do-tests-when-defined* t)) (deftest (temp) 4 3)))
("Test (TEMP) failed"
("Test (
RT-TESTS::
TEMP) failed"
"Form: 4"
"Form: 4"
"Expected value: 3"
"Expected value: 3"
"Actual value: 4.")
"Actual value: 4.")
...
@@ -128,7 +137,7 @@
...
@@ -128,7 +137,7 @@
() (t3 1 1))
() (t3 1 1))
(deftest get-test-5
(deftest get-test-5
(setup (get-test 't0))
(setup (get-test 't0))
("No test with name T0.") nil)
("No test with name
RT-TESTS::
T0.") nil)
(deftest rem-test-1
(deftest rem-test-1
(setup (values (rem-test 't1) (pending-tests)))
(setup (values (rem-test 't1) (pending-tests)))
...
@@ -157,7 +166,7 @@
...
@@ -157,7 +166,7 @@
(setup (let ((*print-case* :downcase))
(setup (let ((*print-case* :downcase))
(values (do-tests) (continue-testing) (do-tests))))
(values (do-tests) (continue-testing) (do-tests))))
("Doing 2 pending tests of 2 tests total."
("Doing 2 pending tests of 2 tests total."
" T1"
"
RT-TESTS::
T1"
"Test (T 2) failed"
"Test (T 2) failed"
"Form: 4"
"Form: 4"
"Expected value: 3"
"Expected value: 3"
...
@@ -170,7 +179,7 @@
...
@@ -170,7 +179,7 @@
"Actual value: 4."
"Actual value: 4."
"1 out of 2 total tests failed: (T 2)."
"1 out of 2 total tests failed: (T 2)."
"Doing 2 pending tests of 2 tests total."
"Doing 2 pending tests of 2 tests total."
" T1"
"
RT-TESTS::
T1"
"Test (T 2) failed"
"Test (T 2) failed"
"Form: 4"
"Form: 4"
"Expected value: 3"
"Expected value: 3"
...
@@ -185,12 +194,12 @@
...
@@ -185,12 +194,12 @@
(deftest (t 2) 3 3)
(deftest (t 2) 3 3)
(values (do-tests) (continue-testing) (do-tests)))
(values (do-tests) (continue-testing) (do-tests)))
("Doing 2 pending tests of 2 tests total."
("Doing 2 pending tests of 2 tests total."
" T1 (T 2)"
"
RT-TESTS::
T1 (T 2)"
"No tests failed."
"No tests failed."
"Doing 0 pending tests of 2 tests total."
"Doing 0 pending tests of 2 tests total."
"No tests failed."
"No tests failed."
"Doing 2 pending tests of 2 tests total."
"Doing 2 pending tests of 2 tests total."
" T1 (T 2)"
"
RT-TESTS::
T1 (T 2)"
"No tests failed.")
"No tests failed.")
t
t
t
t
...
@@ -204,20 +213,20 @@
...
@@ -204,20 +213,20 @@
t
t
t)
t)
(deftest do-tests-4
(deftest do-tests-4
(setup (normalize (with-output-to-string (s) (do-tests s))))
(setup (normalize (with-output-to-string (s) (do-tests
:out
s))))
()
()
("Doing 2 pending tests of 2 tests total."
("Doing 2 pending tests of 2 tests total."
" T1"
"
RT-TESTS::
T1"
"Test (T 2) failed"
"Test (T 2) failed"
"Form: 4"
"Form: 4"
"Expected value: 3"
"Expected value: 3"
"Actual value: 4."
"Actual value: 4."
"1 out of 2 total tests failed: (T 2)."))
"1 out of 2 total tests failed: (T 2)."))
(deftest do-tests-5
(deftest do-tests-5
(setup (with-temporary-file s (do-tests s)))
(setup (with-temporary-file s (do-tests
:out
s)))
()
()
("Doing 2 pending tests of 2 tests total."
("Doing 2 pending tests of 2 tests total."
" T1"
"
RT-TESTS::
T1"
"Test (T 2) failed"
"Test (T 2) failed"
"Form: 4"
"Form: 4"
"Expected value: 3"
"Expected value: 3"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment