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

check for functions in the test specification

Browse Source 
svn: r14076
This commit is contained in:
Kathy Gray 2009-03-12 17:23:45 +00:00
parent 940a47a439
commit 422b9414bd
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/test-engine/scheme-tests.ss
View File

@ -17,10 +17,14 @@
(define INEXACT-NUMBERS-FMT
"check-expect cannot compare inexact numbers. Try (check-within test ~a range).")
(define FUNCTION-FMT
"check-expect cannot compare functions.")
(define CHECK-ERROR-STR-FMT
"check-error requires a string for the second argument, representing the expected error message. Given ~s")
(define CHECK-WITHIN-INEXACT-FMT
"check-within requires an inexact number for the range. ~a is not inexact.")
(define CHECK-WITHIN-FUNCTION-FMT
"check-within cannot compare functions.")
(define-for-syntax CHECK-EXPECT-STR
"check-expect requires two expressions. Try (check-expect test expected).")
@ -113,7 +117,8 @@
;; check-values-expected: (-> scheme-val) scheme-val src -> void
(define (check-values-expected test actual src test-info)
(error-check (lambda (v) (if (number? v) (exact? v) #t))
actual INEXACT-NUMBERS-FMT)
actual INEXACT-NUMBERS-FMT #t)
(error-check (lambda (v) (not (procedure? v))) actual FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(run-and-check (lambda (v1 v2 _) (beginner-equal? v1 v2))
(lambda (src v1 v2 _) (make-unequal src v1 v2))
@ -130,7 +135,8 @@
[_ (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]))
(define (check-values-within test actual within src test-info)
(error-check number? within CHECK-WITHIN-INEXACT-FMT)
(error-check number? within CHECK-WITHIN-INEXACT-FMT #t)
(error-check (lambda (v) (not (procedure? v))) actual CHECK-WITHIN-FUNCTION-FMT #f)
(send (send test-info get-info) add-check)
(run-and-check beginner-equal~? make-outofrange test actual within src
test-info
@ -147,7 +153,7 @@
[_ (raise-syntax-error 'check-error CHECK-ERROR-STR stx)]))
(define (check-values-error test error src test-info)
(error-check string? error CHECK-ERROR-STR-FMT)
(error-check string? error CHECK-ERROR-STR-FMT #t)
(send (send test-info get-info) add-check)
(let ([result (with-handlers ([exn?
(lambda (e)
@ -165,9 +171,9 @@
#t)))
(define (error-check pred? actual fmt)
(define (error-check pred? actual fmt fmt-act?)
(unless (pred? actual)
(raise (make-exn:fail:contract (format fmt actual)
(raise (make-exn:fail:contract (if fmt-act? (format fmt actual) fmt)
(current-continuation-marks)))))