a little better

svn: r15118
This commit is contained in:
Eli Barzilay 2009-06-08 14:48:15 +00:00
parent 6977ddde54
commit f08fb96f88

View File

@ -737,7 +737,6 @@ END-OF-TESTS
(define (read-all str reader [whole? #f]) (define (read-all str reader [whole? #f])
(define i (open-input-string str)) (define i (open-input-string str))
(port-count-lines! i)
(if whole? (if whole?
(reader i) (reader i)
(let loop () (let loop ()
@ -778,15 +777,18 @@ END-OF-TESTS
[ts (regexp-replace* #px"(?m:^;.*\r?\n)" ts "")] [ts (regexp-replace* #px"(?m:^;.*\r?\n)" ts "")]
;; split the tests ;; split the tests
[ts (regexp-split #px"(?:^|\r?\n)-+(?:$|\r?\n)" ts)]) [ts (regexp-split #px"(?:^|\r?\n)-+(?:$|\r?\n)" ts)])
(for ([t ts] #:when (not (regexp-match? #px"^\\s*$" t))) (parameterize ([port-count-lines-enabled #t])
(let ([m (or (regexp-match #px"^(.*)\n\\s*(-\\S+->)\\s*\n(.*)$" t) (for ([t ts] #:when (not (regexp-match? #px"^\\s*$" t)))
(regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$" t))]) (let ([m (or (regexp-match #px"^(.*)\n\\s*(-\\S+->)\\s*\n(.*)$"
(if (not (and m (= 4 (length m)))) t)
(error 'bad-test "~a" t) (regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$"
(let-values ([(x y) t))])
((string->tester (caddr m)) (cadr m) (cadddr m))]) (if (not (and m (= 4 (length m))))
(test #:failure-message (error 'bad-test "~a" t)
(format "bad result in\n ~a\n results:\n ~s != ~s\n" (let-values ([(x y)
(regexp-replace* #rx"\n" t "\n ") ((string->tester (caddr m)) (cadr m) (cadddr m))])
x y) (test #:failure-message
(equal? x y))))))))) (format "bad result in\n ~a\n results:\n ~s != ~s"
(regexp-replace* #rx"\n" t "\n ")
x y)
(equal? x y))))))))))