source: project/release/4/procedure-decoration/trunk/tests/run.scm @ 16076

Last change on this file since 16076 was 16076, checked in by Kon Lovett, 11 years ago

Save.

File size: 1.2 KB
Line 
1;;;; procedure-decoration-test.scm
2
3(use test)
4(use procedure-decoration)
5
6;;;
7
8(test-group "Become? yes"
9  (define (test-proc) #t)
10  (define-procedure-extender docstring procedure-documentation documented-procedure?)
11
12  (test-assert (not (documented-procedure? test-proc)))
13  (test-assert (set! (procedure-documentation test-proc) "test-proc is foo"))
14  (test-assert (documented-procedure? test-proc))
15  (test "test-proc is foo" (procedure-documentation test-proc))
16  (test-assert (test-proc))
17)
18
19(test-group "Become? no"
20  (define (test-proc) #t)
21  (define dctr)
22  (define decr-test-proc)
23
24  (test-assert
25    (set! dctr
26     (make-procedure-decorator (lambda (obj) (and (pair? obj) (eq? 'foo (car obj))))
27                               (lambda (_ new) (cons 'foo new))
28                               cdr)))
29
30  (test-assert (not (decorated-procedure? test-proc dctr)))
31  (test-assert (set! decr-test-proc (decorate-procedure test-proc dctr "test-proc is foo")))
32  (test-assert "Procedure did not \"become\"" (not (eq? test-proc decr-test-proc)))
33  (test-assert (decorated-procedure? decr-test-proc dctr))
34  (test "test-proc is foo" (procedure-decoration decr-test-proc dctr))
35  (test-assert (test-proc))
36  (test-assert (decr-test-proc))
37)
Note: See TracBrowser for help on using the repository browser.