add simple trace tests
svn: r16158
This commit is contained in:
parent
090f5eb474
commit
230fcf49df
53
collects/tests/mzscheme/trace.ss
Normal file
53
collects/tests/mzscheme/trace.ss
Normal file
|
@ -0,0 +1,53 @@
|
||||||
|
(load-relative "loadtest.ss")
|
||||||
|
|
||||||
|
(Section 'trace)
|
||||||
|
|
||||||
|
(require scheme/trace)
|
||||||
|
|
||||||
|
(define-syntax-rule (trace-output expr ...)
|
||||||
|
(let ([out (list)])
|
||||||
|
(parameterize ([current-trace-notify (lambda (e)
|
||||||
|
(set! out (cons e out)))])
|
||||||
|
expr ...
|
||||||
|
(reverse out))))
|
||||||
|
|
||||||
|
(let ([n1 (let ([out (list)])
|
||||||
|
(parameterize ([current-trace-notify (lambda (e)
|
||||||
|
(set! out (cons e out)))])
|
||||||
|
(define (foo x) x)
|
||||||
|
(trace foo)
|
||||||
|
(foo 2)
|
||||||
|
out))])
|
||||||
|
(test (reverse n1) 'test-it (list ">(foo 2)" "<2")))
|
||||||
|
|
||||||
|
(test (trace-output
|
||||||
|
(define (foo x) x)
|
||||||
|
(trace foo)
|
||||||
|
(foo 2))
|
||||||
|
'simple-trace
|
||||||
|
(list ">(foo 2)"
|
||||||
|
"<2"))
|
||||||
|
|
||||||
|
(test (trace-output
|
||||||
|
(define (foo x) (add1 x))
|
||||||
|
(trace foo)
|
||||||
|
(foo 2))
|
||||||
|
'simple-trace
|
||||||
|
(list ">(foo 2)"
|
||||||
|
"<3"))
|
||||||
|
|
||||||
|
(test (trace-output
|
||||||
|
(define (a x) x)
|
||||||
|
(define (b x) (a x))
|
||||||
|
(define (c x) (+ (b x) (b x)))
|
||||||
|
(trace a b c)
|
||||||
|
(c 1))
|
||||||
|
'trace2
|
||||||
|
(list ">(c 1)"
|
||||||
|
"> (b 1)"
|
||||||
|
"> (a 1)"
|
||||||
|
"< 1"
|
||||||
|
"> (b 1)"
|
||||||
|
"> (a 1)"
|
||||||
|
"< 1"
|
||||||
|
"<2"))
|
Loading…
Reference in New Issue
Block a user