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

applied Carl's patches

Browse Source 
svn: r5539
This commit is contained in:
Matthias Felleisen 2007-02-02 02:08:45 +00:00
parent 3e62056186
commit 53febf1984
1 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/htdp/testing.scm
View File

@ -47,17 +47,18 @@
(define-syntax (check-expect stx)
(syntax-case stx ()
((_ test actual)
#`(define #,(gensym 'test)
(quasisyntax/loc stx
(define #,(gensym 'test)
(check-values-expected
(lambda () test) actual (make-src #,@(list (syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))))))
(syntax-span stx)))))))
((_ test)
(raise-syntax-error 'check-expect CHECK-EXPECT-STR))
(raise-syntax-error 'check-expect CHECK-EXPECT-STR stx))
((_ test actual extra ...)
(raise-syntax-error 'check-expect CHECK-EXPECT-STR))))
(raise-syntax-error 'check-expect CHECK-EXPECT-STR stx))))
;check-values-expected: (-> scheme-val) scheme-val src -> void
(define (check-values-expected test actual src)
@ -71,19 +72,20 @@
(define-syntax (check-within stx)
(syntax-case stx ()
((_ test actual within)
#`(define #,(gensym 'test-within)
(quasisyntax/loc stx
(define #,(gensym 'test-within)
(check-values-within (lambda () test) actual within
(make-src #,@(list (syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))))))
(syntax-span stx)))))))
((_ test actual)
(raise-syntax-error 'check-within CHECK-WITHIN-STR))
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx))
((_ test)
(raise-syntax-error 'check-within CHECK-WITHIN-STR))
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx))
((_ test actual within extra ...)
(raise-syntax-error 'check-within CHECK-WITHIN-STR))))
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx))))
(define (check-values-within test actual within src)
(error-check number? within CHECK-WITHIN-INEXACT-FMT)
@ -93,14 +95,15 @@
(define-syntax (check-error stx)
(syntax-case stx ()
((_ test error)
#`(define #,(gensym 'test-error)
(quasisyntax/loc stx
(define #,(gensym 'test-error)
(check-values-error (lambda () test) error (make-src #,@(list (syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))))))
(syntax-span stx)))))))
((_ test)
(raise-syntax-error 'check-error CHECK-ERROR-STR))))
(raise-syntax-error 'check-error CHECK-ERROR-STR stx))))
(define (check-values-error test error src)
(error-check string? error CHECK-ERROR-STR-FMT)
@ -272,4 +275,4 @@
" column " (number->string (src-col src))))
)
)