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

change the way multiple-value results are compared in r6rs test suite

Browse Source 
svn: r10888
This commit is contained in:
Matthew Flatt 2008-07-24 00:23:05 +00:00
parent 5a5f52d99c
commit 643b24c3b7
1 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/tests/r6rs/test.sls
View File

@ -19,6 +19,9 @@
(define-record-type expected-exception
(fields))
(define-record-type multiple-results
(fields values))
(define-syntax test
(syntax-rules ()
[(_ expr expected)
@ -55,8 +58,8 @@
[(_ expr val ...)
(test (call-with-values
(lambda () expr)
list)
(list val ...))]))
(lambda results (make-multiple-results results)))
(make-multiple-results (list val ...)))]))
(define-syntax test/output
(syntax-rules ()
@ -106,14 +109,24 @@
(if (file-exists? "tmp-catch-out")
(delete-file "tmp-catch-out")))))
(define (same-result? got expected)
(cond
[(and (real? expected) (nan? expected))
(and (real? got) (nan? got))]
[(expected-exception? expected)
(expected-exception? got)]
[(multiple-results? expected)
(and (multiple-results? got)
(= (length (multiple-results-values expected))
(length (multiple-results-values got)))
(for-all same-result?
(multiple-results-values expected)
(multiple-results-values got)))]
[else (equal? got expected)]))
(define (run-test expr got expected)
(set! checked (+ 1 checked))
(unless (if (and (real? expected)
(nan? expected))
(and (real? got) (nan? got))
(or (equal? got expected)
(and (expected-exception? expected)
(expected-exception? got))))
(unless (same-result? got expected)
(set! failures
(cons (list expr got expected)
failures))))