/core/classes/intersection/intersection-tests.factor

 1USING: kernel tools.test generic generic.standard classes math
 2accessors classes.intersection slots math.order ;
 3IN: classes.intersection.tests
 4
 5TUPLE: a ;
 6TUPLE: a1 < a ; TUPLE: a2 < a ; TUPLE: a3 < a2 ;
 7MIXIN: b
 8INSTANCE: a3 b
 9INSTANCE: a1 b
10INTERSECTION: c a2 b ;
11
12GENERIC: x ( a -- b )
13
14M: c x drop c ;
15M: a x drop a ;
16
17[ a ] [ T{ a } x ] unit-test
18[ a ] [ T{ a1 } x ] unit-test
19[ a ] [ T{ a2 } x ] unit-test
20
21[ t ] [ T{ a3 } c? ] unit-test
22[ t ] [ T{ a3 } \ x effective-method M\ c x eq? nip ] unit-test
23[ c ] [ T{ a3 } x ] unit-test
24
25! More complex case
26TUPLE: t1 ;
27TUPLE: t2 < t1 ; TUPLE: t3 < t1 ;
28TUPLE: t4 < t2 ; TUPLE: t5 < t2 ;
29
30UNION: m t4 t5 t3 ;
31INTERSECTION: i t2 m ;
32
33GENERIC: g ( a -- b )
34
35M: i g drop i ;
36M: t4 g drop t4 ;
37
38[ t4 ] [ T{ t4 } g ] unit-test
39[ i ] [ T{ t5 } g ] unit-test
40
41PREDICATE: odd-integer < integer odd? ;
42
43! [ TUPLE: omg { a intersection{ fixnum odd-integer } initial: 2 } ;" eval( -- ) ]
44! [ bad-initial-value? ] must-fail-with
45
46TUPLE: omg { a intersection{ fixnum odd-integer } initial: 1 } ;
47
48[ 1 ] [ omg new a>> ] unit-test
49[ 3 ] [ omg new 3 >>a a>> ] unit-test
50[ omg new 1.2 >>a a>> ] [ bad-slot-value? ] must-fail-with
51
52PREDICATE: odd/float-between-10-20 < union{ odd-integer float }
53    10 20 between? ;
54
55[ t ] [ 17 odd/float-between-10-20? ] unit-test
56[ t ] [ 17.4 odd/float-between-10-20? ] unit-test
57[ f ] [ 18 odd/float-between-10-20? ] unit-test
58[ f ] [ 5 odd/float-between-10-20? ] unit-test
59[ f ] [ 5.75 odd/float-between-10-20? ] unit-test