extra/pair-methods/pair-methods-tests.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors pair-methods classes kernel sequences tools.test ;
   4 IN: pair-methods.tests
   5
   6 TUPLE: thang ;
   7
   8 TUPLE: foom < thang ;
   9 TUPLE: barm < foom ;
  10
  11 TUPLE: zim < thang ;
  12 TUPLE: zang < zim ;
  13
  14 : class-names ( a b prefix -- string )
  15     [ [ class-of name>> ] bi@ "-" glue ] dip prepend ;
  16
  17 PAIR-GENERIC: blibble ( a b -- c )
  18
  19 PAIR-M: thang thang blibble
  20     "vanilla " class-names ;
  21
  22 PAIR-M: foom thang blibble
  23     "chocolate " class-names ;
  24
  25 PAIR-M: barm thang blibble
  26     "strawberry " class-names ;
  27
  28 PAIR-M: barm zim blibble
  29     "coconut " class-names ;
  30
  31 { "vanilla zang-zim" } [ zim new zang new blibble ] unit-test
  32
  33 ! args automatically swap to match most specific method
  34 { "chocolate foom-zim" } [ foom new zim  new blibble ] unit-test
  35 { "chocolate foom-zim" } [ zim  new foom new blibble ] unit-test
  36
  37 { "strawberry barm-barm" } [ barm new barm new blibble ] unit-test
  38 { "strawberry barm-foom" } [ barm new foom new blibble ] unit-test
  39 { "strawberry barm-foom" } [ foom new barm new blibble ] unit-test
  40
  41 { "coconut barm-zang" } [ zang new barm new blibble ] unit-test
  42 { "coconut barm-zim" } [ barm new zim  new blibble ] unit-test
  43
  44 [ 1 2 blibble ] [ no-pair-method? ] must-fail-with