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

all check-forms working sans popup

Browse Source 
svn: r9586
This commit is contained in:
John Clements 2008-05-02 05:52:10 +00:00
parent 0fe4de70ac
commit 8ee6d5a308
2 changed files with 31 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/stepper/internal-docs.txt
View File

@ -86,9 +86,10 @@ stepper-hint :
[ 'from-splice-box ] : expression was expanded from a scheme splice
box (inside an xml box)
[ 'comes-from-recur ] : expression was expanded from a 'recur'
[ 'comes-from-check-expect ] : expression was expanded from a 'check-expect',
or this identifier (use or binding) was created by the expansion of a 'check-expect'.
[ 'comes-from-check-expect ] : expression was expanded from a 'check-expect'
[ 'comes-from-check-within ] : ... from a 'check-within'
[ 'comes-from-check-error ] : ... from a 'check-error'
stepper-define-type:
this is attached to the right-hand sides of defines to indicate what
kind of define they came from.

27
collects/stepper/private/macro-unwind.ss
View File

@ -90,6 +90,8 @@
[(comes-from-local) unwind-local]
[(comes-from-recur) unwind-recur]
[(comes-from-check-expect) unwind-check-expect]
[(comes-from-check-within) unwind-check-within]
[(comes-from-check-error) unwind-check-error]
;;[(comes-from-begin) unwind-begin]
[else fall-through])])
(process stx settings))))
@ -307,4 +309,29 @@
(with-syntax ([expected (unwind (third (stepper-syntax-property stx 'stepper-args-of-call)) settings)])
#`(check-expect actual expected))]
[any #`(c-e any) #;#`(check-expect )]))
(define (unwind-check-within stx settings)
(kernel-syntax-case (fall-through stx settings) #f
[(c-e (lambda () a1) a2 a3 a4 a5)
#`(check-within a1 a2 a3)]
[(dots1 actual dots2)
(and (eq? (syntax->datum #'dots1) '...)
(eq? (syntax->datum #'dots2) '...))
(let ([args-of-call (stepper-syntax-property stx 'stepper-args-of-call)])
(with-syntax ([expected (unwind (third args-of-call) settings)]
[within (unwind (fourth args-of-call) settings)])
#`(check-within actual expected within)))]
[any #`(c-e any) #;#`(check-expect )]))
(define (unwind-check-error stx settings)
(kernel-syntax-case (fall-through stx settings) #f
[(c-e (lambda () a1) a2 a3 a4)
#`(check-error a1 a2)]
[(dots1 actual dots2)
(and (eq? (syntax->datum #'dots1) '...)
(eq? (syntax->datum #'dots2) '...))
(let ([args-of-call (stepper-syntax-property stx 'stepper-args-of-call)])
(with-syntax ([expected (unwind (third args-of-call) settings)])
#`(check-error actual expected)))]
[any #`(c-e any) #;#`(check-expect )]))
)