source: project/release/4/operations/tests/run.scm @ 12312

Last change on this file since 12312 was 12312, checked in by felix winkelmann, 12 years ago

ported to chicken-4

File size: 965 bytes
Line 
1(use test)
2(use operations)
3
4(define-predicate pare?)
5(define-settable-operation kar)
6(define-settable-operation kdr)
7
8(define (kons x y)
9  (object 
10   #f
11   ((pare? self) #t)
12   ((kar self) x)
13   ((kdr self) y)
14   (((setter kar) self x2) (set! x x2))
15   (((setter kdr) self y2) (set! y y2)) ) )
16
17(define (funny-kons x y)
18  (let ((k (kons x y)))
19    (join
20     (object 
21      #f
22      ((kar self) (* 2 (kar k))) ) 
23     k) ) )
24
25(define fk1 (funny-kons 9 10))
26
27(test-begin)
28
29(test #f (pare? 33))
30(define p (kons 3 4))
31(test #t (pare? p))
32(test 3 (kar p))
33(test 4 (kdr p))
34(set! (kar p) 100)
35(test 100 (kar p))
36(test #t (operation? kar))
37(test #t (operation? setter))
38(test #t (operation? (setter kar)))
39(test #f (operation? car))
40(test #f (operation? (setter car)))
41(test #t (procedure? kar))
42(test #f (procedure? (object)))
43(test #t (procedure? (object car)))
44(test 1 ((object car) '(1 2)))
45(test #t (pare? fk1))
46(test 18 (kar fk1))
47(test 10 (kdr fk1))
48
49(test-end)
Note: See TracBrowser for help on using the repository browser.