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

use the test expression as the source for the whole expression, so it is all shown as uncovered until executed

Browse Source 
svn: r13158
This commit is contained in:
Eli Barzilay 2009-01-15 23:53:51 +00:00
parent 822a536b7f
commit cac38f95cb
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -51,8 +51,8 @@
;; check-expect-maker : syntax? syntax? (listof syntax?) symbol? -> syntax?
;; the common part of all three test forms.
(define-for-syntax (check-expect-maker stx checker-proc-stx embedded-stxes
hint-tag)
(define-for-syntax (check-expect-maker
stx checker-proc-stx test-expr embedded-stxes hint-tag)
(define bogus-name
(stepper-syntax-property #`#,(gensym 'test) 'stepper-hide-completed #t))
(define src-info
@ -62,7 +62,7 @@
(syntax-column stx)
(syntax-position stx)
(syntax-span stx)))))
(quasisyntax/loc stx
(quasisyntax/loc test-expr
(define #,bogus-name
#,(stepper-syntax-property
#`(let ([test-info (namespace-variable-value
@ -76,6 +76,7 @@
['stepper-use-val-as-final #t])
(quasisyntax/loc stx
(#,checker-proc-stx
(lambda () #,test-expr)
#,@embedded-stxes
#,src-info
#,(with-stepper-syntax-properties
@ -99,8 +100,7 @@
(raise-syntax-error 'check-expect CHECK-EXPECT-DEFN-STR stx))
(syntax-case stx ()
[(_ test actual)
(check-expect-maker stx #'check-values-expected
(list #`(lambda () test) #`actual)
(check-expect-maker stx #'check-values-expected #`test (list #`actual)
'comes-from-check-expect)]
[_ (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)]))
@ -119,8 +119,7 @@
(raise-syntax-error 'check-within CHECK-WITHIN-DEFN-STR stx))
(syntax-case stx ()
[(_ test actual within)
(check-expect-maker stx #'check-values-within
(list #`(lambda () test) #`actual #`within)
(check-expect-maker stx #'check-values-within #`test (list #`actual #`within)
'comes-from-check-within)]
[_ (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]))
@ -137,8 +136,7 @@
(raise-syntax-error 'check-error CHECK-ERROR-DEFN-STR stx))
(syntax-case stx ()
[(_ test error)
(check-expect-maker stx #'check-values-error
(list #'(lambda () test) #`error)
(check-expect-maker stx #'check-values-error #`test (list #`error)
'comes-from-check-error)]
[_ (raise-syntax-error 'check-error CHECK-ERROR-STR stx)]))