suzanne.soy/rackunit
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix the SchemeUnit test suite so it runs without error following changed introduced in r18618.

Browse Source 
svn: r18659

original commit: f655a38eada83091bc0e26c45758658cff6c9c33
This commit is contained in:
Noel Welsh 2010-03-29 12:58:13 +00:00
parent 1ee3af576b
commit 9f08727396
3 changed files with 28 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/tests/schemeunit/all-schemeunit-tests.ss
View File

@ -41,6 +41,7 @@
format-tests format-tests
)) ))
;; These tests fail. The are intended to do this so a human can manually check the output they produce. They should not be run by DrDr as they will generate bogus warnings.
(define success-and-failure-tests (define success-and-failure-tests
(test-suite (test-suite
"Successes and Failures" "Successes and Failures"

5
collects/tests/schemeunit/run-tests.ss
View File

@ -4,6 +4,7 @@
schemeunit/text-ui schemeunit/text-ui
"all-schemeunit-tests.ss") "all-schemeunit-tests.ss")
;(run-tests all-schemeunit-tests) (run-tests all-schemeunit-tests)
(run-tests success-and-failure-tests) ;; Don't run the failing tests by default. Switch the comments if you want to inspect the visual appearance of failing test's output.
;(run-tests success-and-failure-tests)

41
collects/tests/schemeunit/text-ui-test.ss
View File

@ -1,5 +1,5 @@
;;; ;;;
;;; Time-stamp: <2008-07-31 10:11:42 noel> ;;; Time-stamp: <2010-03-29 13:56:54 noel>
;;; ;;;
;;; Copyright (C) 2005 by Noel Welsh. ;;; Copyright (C) 2005 by Noel Welsh.
;;; ;;;
@ -48,12 +48,22 @@
expr ...) expr ...)
(get-output-string p))])) (get-output-string p))]))
(define-syntax with-error-to-string
(syntax-rules ()
[(with-error-to-string expr ...)
(let ([p (open-output-string)])
(parameterize ([current-error-port p])
expr ...)
(get-output-string p))]))
(define-runtime-path here ".") (define-runtime-path here ".")
;; with-silent-output (() -> any) -> any ;; with-silent-output (() -> any) -> any
(define (with-silent-output thunk) (define (with-silent-output thunk)
(let ((op (open-output-string))) (let ([out (open-output-string)]
(parameterize ((current-output-port op)) [err (open-output-string)])
(parameterize ([current-output-port out]
[current-error-port err])
(thunk)))) (thunk))))
(define (failing-test) (define (failing-test)
@ -99,7 +109,7 @@
(test-case (test-case
"Binary check displays actual and expected in failure error message" "Binary check displays actual and expected in failure error message"
(let ((op (with-output-to-string (failing-test)))) (let ((op (with-error-to-string (failing-test))))
(check string-contains (check string-contains
op op
"expected") "expected")
@ -109,14 +119,14 @@
(test-case (test-case
"Binary check doesn't display params" "Binary check doesn't display params"
(let ((op (with-output-to-string (failing-test)))) (let ((op (with-error-to-string (failing-test))))
(check (lambda (out str) (not (string-contains out str))) (check (lambda (out str) (not (string-contains out str)))
op op
"params"))) "params")))
(test-case (test-case
"Binary check output is pretty printed" "Binary check output is pretty printed"
(let ([op (with-output-to-string (failing-binary-test/complex-params))]) (let ([op (with-error-to-string (failing-binary-test/complex-params))])
(check string-contains (check string-contains
op op
"((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) "((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)
@ -125,7 +135,7 @@
(test-case (test-case
"Non-binary check output is pretty printed" "Non-binary check output is pretty printed"
(let ([op (with-output-to-string (failing-test/complex-params))]) (let ([op (with-error-to-string (failing-test/complex-params))])
(check string-contains (check string-contains
op op
"((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) "((0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)
@ -135,14 +145,14 @@
(test-case (test-case
"Location trimmed when file is under current directory" "Location trimmed when file is under current directory"
(parameterize ((current-directory here)) (parameterize ((current-directory here))
(let ((op (with-output-to-string (failing-test)))) (let ((op (with-error-to-string (failing-test))))
(check string-contains (check string-contains
op op
"location: text-ui-test.ss")))) "location: text-ui-test.ss"))))
(test-case (test-case
"Name and location displayed before actual/expected" "Name and location displayed before actual/expected"
(let ((op (with-output-to-string (failing-test)))) (let ((op (with-error-to-string (failing-test))))
(let ((name-idx (string-contains op "name:")) (let ((name-idx (string-contains op "name:"))
(loc-idx (string-contains op "location:")) (loc-idx (string-contains op "location:"))
(actual-idx (string-contains op "actual:")) (actual-idx (string-contains op "actual:"))
@ -153,14 +163,11 @@
(test-case (test-case
"Quiet mode is quiet" "Quiet mode is quiet"
(let ((op1 (with-output-to-string (quiet-failing-test))) (let ((op1 (with-error-to-string (quiet-failing-test)))
(op2 (with-output-to-string (quiet-error-test)))) (op2 (with-error-to-string (quiet-error-test))))
(check string=? (check string=? op1 "")
op1 (check string=? op2 "")))
"0 success(es) 1 failure(s) 0 error(s) 1 test(s) run\n")
(check string=?
op2
"0 success(es) 0 failure(s) 1 error(s) 1 test(s) run\n")))
(test-case (test-case
"Number of unsuccessful tests returned" "Number of unsuccessful tests returned"
(check-equal? (with-silent-output failing-test) 1) (check-equal? (with-silent-output failing-test) 1)