core/classes/intersection/intersection-tests.factor

   1 USING: kernel tools.test generic generic.standard classes math
   2 accessors classes.intersection slots math.order ;
   3 IN: classes.intersection.tests
   4
   5 TUPLE: a ;
   6 TUPLE: a1 < a ; TUPLE: a2 < a ; TUPLE: a3 < a2 ;
   7 MIXIN: b
   8 INSTANCE: a3 b
   9 INSTANCE: a1 b
  10 INTERSECTION: c a2 b ;
  11
  12 GENERIC: x ( a -- b )
  13
  14 M: c x drop c ;
  15 M: 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
  26 TUPLE: t1 ;
  27 TUPLE: t2 < t1 ; TUPLE: t3 < t1 ;
  28 TUPLE: t4 < t2 ; TUPLE: t5 < t2 ;
  29
  30 UNION: m t4 t5 t3 ;
  31 INTERSECTION: i t2 m ;
  32
  33 GENERIC: g ( a -- b )
  34
  35 M: i g drop i ;
  36 M: t4 g drop t4 ;
  37
  38 { t4 } [ T{ t4 } g ] unit-test
  39 { i } [ T{ t5 } g ] unit-test
  40
  41 PREDICATE: odd-integer < integer odd? ;
  42
  43 ! [ TUPLE: omg { a intersection{ fixnum odd-integer } initial: 2 } ;" eval( -- ) ]
  44 ! [ bad-initial-value? ] must-fail-with
  45
  46 TUPLE: 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
  52 PREDICATE: 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