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

a fix to the way check-expect expands to play better with test coverage

Browse Source 
svn: r13232
This commit is contained in:
Robby Findler 2009-01-19 21:24:21 +00:00
parent 62993e9df3
commit 146e8733cc
1 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,8 +62,7 @@
(syntax-column stx) (syntax-column stx)
(syntax-position stx) (syntax-position stx)
(syntax-span stx))))) (syntax-span 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
'test~object #f builder (current-namespace))]) 'test~object #f builder (current-namespace))])
@ -71,24 +70,26 @@
(insert-test test-info (insert-test test-info
(lambda () (lambda ()
#,(with-stepper-syntax-properties #,(with-stepper-syntax-properties
(['stepper-hint hint-tag] (['stepper-hint hint-tag]
['stepper-hide-reduction #t] ['stepper-hide-reduction #t]
['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) (car (list
#,@embedded-stxes (lambda () #,test-expr)
#,src-info #,(syntax/loc stx (void))))
#,(with-stepper-syntax-properties #,@embedded-stxes
(['stepper-no-lifting-info #t] #,src-info
['stepper-hide-reduction #t]) #,(with-stepper-syntax-properties
#'test-info)))))))) (['stepper-no-lifting-info #t]
['stepper-hide-reduction #t])
#'test-info))))))))
'stepper-skipto 'stepper-skipto
(append skipto/third ;; let (append skipto/third ;; let
skipto/third skipto/second ;; unless (it expands into a begin) skipto/third skipto/second ;; unless (it expands into a begin)
skipto/cdr skipto/third ;; application of insert-test skipto/cdr skipto/third ;; application of insert-test
'(syntax-e cdr cdr syntax-e car) ;; lambda '(syntax-e cdr cdr syntax-e car) ;; lambda
))))) ))))
(define-for-syntax (check-context?) (define-for-syntax (check-context?)
(let ([c (syntax-local-context)]) (let ([c (syntax-local-context)])