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