1 ! (c)2009 Joe Groff bsd license
2 USING: accessors classes.tuple compiler.units kernel qw roles sequences
4 FROM: roles => TUPLE: ;
9 ROLE: instrument tone ;
10 ROLE: tuning-fork <{ fork instrument } volume ;
12 TUPLE: utensil handle ;
14 ! role consumption and tuple inheritance can be mixed
15 TUPLE: foon <{ utensil fork spoon } ;
16 TUPLE: tuning-spork <{ utensil spoon tuning-fork } ;
19 [ t ] [ fork role? ] unit-test
20 [ f ] [ foon role? ] unit-test
22 ! roles aren't tuple classes by themselves and can't be instantiated
23 [ f ] [ fork tuple-class? ] unit-test
24 [ fork new ] must-fail
26 ! tuples which consume roles fall under their class
27 [ t ] [ foon new fork? ] unit-test
28 [ t ] [ foon new spoon? ] unit-test
29 [ f ] [ foon new tuning-fork? ] unit-test
30 [ f ] [ foon new instrument? ] unit-test
32 [ t ] [ tuning-spork new fork? ] unit-test
33 [ t ] [ tuning-spork new spoon? ] unit-test
34 [ t ] [ tuning-spork new tuning-fork? ] unit-test
35 [ t ] [ tuning-spork new instrument? ] unit-test
37 ! consumed role slots are placed in tuples in order
38 [ qw{ handle tines bowl } ] [ foon all-slots [ name>> ] map ] unit-test
39 [ qw{ handle bowl tines tone volume } ] [ tuning-spork all-slots [ name>> ] map ] unit-test
41 ! can't combine roles whose slots overlap
45 [ [ spong { spoon bong } { } define-tuple-class-with-roles ] with-compilation-unit ]
46 [ role-slot-overlap? ] must-fail-with
48 [ [ spong { spoon bong } { } define-role ] with-compilation-unit ]
49 [ role-slot-overlap? ] must-fail-with
51 ! can't try to inherit multiple tuple classes
55 [ knife { utensil tool } { } define-tuple-class-with-roles ]
56 [ multiple-inheritance-attempted? ] must-fail-with
58 ! make sure method dispatch works
59 GENERIC: poke ( pokee poker -- result )
60 GENERIC: scoop ( scoopee scooper -- result )
61 GENERIC: tune ( tunee tuner -- result )
63 M: fork poke drop " got poked" append ;
64 M: spoon scoop drop " got scooped" append ;
65 M: instrument tune drop " got tuned" append ;
67 [ "potato got poked" "potato got scooped" "potato got tuned" ]
68 [ "potato" tuning-spork new [ poke ] [ scoop ] [ tune ] 2tri ] unit-test