2017-08-25 18:34:26 -04:00
|
|
|
! Copyright (C) 2009 Joe Groff.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-04-26 15:58:31 -04:00
|
|
|
USING: accessors pair-methods classes kernel sequences tools.test ;
|
|
|
|
|
IN: pair-methods.tests
|
|
|
|
|
|
|
|
|
|
TUPLE: thang ;
|
|
|
|
|
|
|
|
|
|
TUPLE: foom < thang ;
|
|
|
|
|
TUPLE: barm < foom ;
|
|
|
|
|
|
|
|
|
|
TUPLE: zim < thang ;
|
|
|
|
|
TUPLE: zang < zim ;
|
|
|
|
|
|
|
|
|
|
: class-names ( a b prefix -- string )
|
2011-10-24 22:33:09 -04:00
|
|
|
[ [ class-of name>> ] bi@ "-" glue ] dip prepend ;
|
2009-04-26 15:58:31 -04:00
|
|
|
|
|
|
|
|
PAIR-GENERIC: blibble ( a b -- c )
|
|
|
|
|
|
|
|
|
|
PAIR-M: thang thang blibble
|
|
|
|
|
"vanilla " class-names ;
|
|
|
|
|
|
|
|
|
|
PAIR-M: foom thang blibble
|
|
|
|
|
"chocolate " class-names ;
|
|
|
|
|
|
|
|
|
|
PAIR-M: barm thang blibble
|
|
|
|
|
"strawberry " class-names ;
|
|
|
|
|
|
|
|
|
|
PAIR-M: barm zim blibble
|
|
|
|
|
"coconut " class-names ;
|
|
|
|
|
|
2015-07-03 12:39:59 -04:00
|
|
|
{ "vanilla zang-zim" } [ zim new zang new blibble ] unit-test
|
2009-04-26 15:58:31 -04:00
|
|
|
|
|
|
|
|
! args automatically swap to match most specific method
|
2015-07-03 12:39:59 -04:00
|
|
|
{ "chocolate foom-zim" } [ foom new zim new blibble ] unit-test
|
|
|
|
|
{ "chocolate foom-zim" } [ zim new foom new blibble ] unit-test
|
2009-04-26 15:58:31 -04:00
|
|
|
|
2015-07-03 12:39:59 -04:00
|
|
|
{ "strawberry barm-barm" } [ barm new barm new blibble ] unit-test
|
|
|
|
|
{ "strawberry barm-foom" } [ barm new foom new blibble ] unit-test
|
|
|
|
|
{ "strawberry barm-foom" } [ foom new barm new blibble ] unit-test
|
2009-04-26 15:58:31 -04:00
|
|
|
|
2015-07-03 12:39:59 -04:00
|
|
|
{ "coconut barm-zang" } [ zang new barm new blibble ] unit-test
|
|
|
|
|
{ "coconut barm-zim" } [ barm new zim new blibble ] unit-test
|
2009-04-26 15:58:31 -04:00
|
|
|
|
|
|
|
|
[ 1 2 blibble ] [ no-pair-method? ] must-fail-with
|
