stepper-syntax-properties

svn: r9575
This commit is contained in:
John Clements 2008-05-01 22:35:09 +00:00
parent 9326b8cfbc
commit 245a658fec

View File

@ -53,22 +53,32 @@
[(_ test actual) [(_ test actual)
(not (eq? (syntax-local-context) 'expression)) (not (eq? (syntax-local-context) 'expression))
(quasisyntax/loc stx (quasisyntax/loc stx
(define #,(gensym 'test) (define #,(stepper-syntax-property #`#,(gensym 'test) 'stepper-hint 'comes-from-check-expect)
#,(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))])
(when test-info (when test-info
(insert-test test-info (insert-test test-info
(lambda () (lambda ()
(check-values-expected #,(stepper-syntax-property
(lambda () test) (quasisyntax/loc stx
actual (check-values-expected
(list #,@(list #`(quote #,(syntax-source stx)) (lambda () test)
(syntax-line stx) actual
(syntax-column stx) #,(stepper-syntax-property
(syntax-position stx) #`(list #,@(list #`(quote #,(syntax-source stx))
(syntax-span stx))) (syntax-line stx)
#,(stepper-syntax-property #`test-info `stepper-no-lifting-info #t)))))) (syntax-column stx)
(syntax-position stx)
(syntax-span stx)))
'stepper-skip-completely
#t)
#,(stepper-syntax-property
(stepper-syntax-property #`test-info `stepper-no-lifting-info #t)
'stepper-hint
'comes-from-check-expect)))
'stepper-hint
'comes-from-check-expect)))))
`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)