core/classes/maybe/maybe-tests.factor

   1 ! Copyright (C) 2011 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors classes classes.algebra classes.algebra.private
   4 classes.maybe eval generic.single kernel math slots tools.test ;
   5 IN: classes.maybe.tests
   6
   7 { t } [ 3 maybe{ integer } instance? ] unit-test
   8 { t } [ f maybe{ integer } instance? ] unit-test
   9 { f } [ 3.0 maybe{ integer } instance? ] unit-test
  10
  11 TUPLE: maybe-integer-container { something maybe{ integer } } ;
  12
  13 { f } [ maybe-integer-container new something>> ] unit-test
  14 { 3 } [ maybe-integer-container new 3 >>something something>> ] unit-test
  15 [ maybe-integer-container new 3.0 >>something ] [ bad-slot-value? ] must-fail-with
  16
  17 TUPLE: self-pointer { next maybe{ self-pointer } } ;
  18
  19 { T{ self-pointer { next T{ self-pointer } } } }
  20 [ self-pointer new self-pointer new >>next ] unit-test
  21
  22 { t } [ f maybe{ POSTPONE: f } instance? ] unit-test
  23
  24 PREDICATE: natural < maybe{ integer }
  25     0 > ;
  26
  27 { f } [ -1 natural? ] unit-test
  28 { f } [ 0 natural? ] unit-test
  29 { t } [ 1 natural? ] unit-test
  30
  31 { t } [ f maybe{ maybe{ integer } } instance? ] unit-test
  32 { t } [ 3 maybe{ maybe{ integer } } instance? ] unit-test
  33 { f } [ 3.03 maybe{ maybe{ integer } } instance? ] unit-test
  34
  35 INTERSECTION: only-f maybe{ integer } POSTPONE: f ;
  36
  37 { t } [ f only-f instance? ] unit-test
  38 { f } [ t only-f instance? ] unit-test
  39 { f } [ 30 only-f instance? ] unit-test
  40
  41 UNION: ?integer-float maybe{ integer } maybe{ float } ;
  42
  43 { t } [ 30 ?integer-float instance? ] unit-test
  44 { t } [ 30.0 ?integer-float instance? ] unit-test
  45 { t } [ f ?integer-float instance? ] unit-test
  46 { f } [ t ?integer-float instance? ] unit-test
  47
  48 TUPLE: foo ;
  49 GENERIC: lol ( obj -- string )
  50 M: maybe{ foo } lol drop "lol" ;
  51
  52 { "lol" } [ foo new lol ] unit-test
  53 { "lol" } [ f lol ] unit-test
  54 [ 3 lol ] [ no-method? ] must-fail-with
  55
  56 TUPLE: foo2 a ;
  57 GENERIC: lol2 ( obj -- string )
  58 M: maybe{ foo } lol2 drop "lol2" ;
  59 M: f lol2 drop "lol22" ;
  60
  61 { "lol2" } [ foo new lol2 ] unit-test
  62 { "lol22" } [ f lol2 ] unit-test
  63 [ 3 lol2 ] [ no-method? ] must-fail-with
  64
  65 [ "IN: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
  66 [ error>> not-an-instance? ] must-fail-with