source: project/release/3/advice/tests/run.scm @ 7842

Last change on this file since 7842 was 7842, checked in by felix winkelmann, 13 years ago

merged with mainline rev. 7838

File size: 725 bytes
Line 
1;;;; advice tests
2
3(use advice test)
4
5(define (foo x)
6  (print "foo: " x)
7  (values x (* x 2)))
8
9(define (bing args)
10  (print "bing: " args) )
11
12(define (bong args)
13  (print "bong: " args) )
14
15(define ((oink n) old args)
16  (print "--> oink #" n ": " args)
17  (let ((r (receive (old (add1 (car args))))))
18    (print "<-- oink #" n)
19    (apply values r)))
20
21(define id1 (advise 'before foo bing))
22(define id2 (advise 'after foo bong))
23(define id3 (advise 'around foo (oink 1)))
24
25(test-begin)
26(advise 'around foo (oink 2))
27(test '(35 70) (receive (foo 33)))
28(unadvise foo id2)
29(test '(102 204) (receive (foo 100)))
30(unadvise foo #f 'around)
31(test '(3 6) (receive (foo 3)))
32(unadvise foo)
33(test '(9 18) (receive (foo 9)))
34(test-end)
Note: See TracBrowser for help on using the repository browser.