Merge branch 'master' of git://factorcode.org/git/factor
[factor/jcg.git] / extra / multi-methods / tests / syntax.factor
blob597a1cebebd636980f5181949b114e42a1a175a1
1 IN: multi-methods.tests
2 USING: multi-methods tools.test math sequences namespaces system
3 kernel strings definitions prettyprint debugger arrays
4 hashtables continuations classes assocs accessors ;
6 GENERIC: first-test
8 [ t ] [ \ first-test generic? ] unit-test
10 MIXIN: thing
12 SINGLETON: paper    INSTANCE: paper thing
13 SINGLETON: scissors INSTANCE: scissors thing
14 SINGLETON: rock     INSTANCE: rock thing
16 GENERIC: beats?
18 METHOD: beats? { paper scissors } t ;
19 METHOD: beats? { scissors rock } t ;
20 METHOD: beats? { rock paper } t ;
21 METHOD: beats? { thing thing } f ;
23 : play ( obj1 obj2 -- ? ) beats? 2nip ;
25 [ { } 3 play ] must-fail
26 [ t ] [ error get no-method? ] unit-test
27 [ ] [ error get error. ] unit-test
28 [ { { } 3 } ] [ error get arguments>> ] unit-test
29 [ t ] [ paper scissors play ] unit-test
30 [ f ] [ scissors paper play ] unit-test
32 [ t ] [ { beats? paper scissors } method-spec? ] unit-test
33 [ ] [ { beats? paper scissors } see ] unit-test
35 SYMBOL: some-var
37 GENERIC: hook-test
39 METHOD: hook-test { array { some-var array } } reverse ;
40 METHOD: hook-test { { some-var array } } class ;
41 METHOD: hook-test { hashtable { some-var number } } assoc-size ;
43 { 1 2 3 } some-var set
44 [ { f t t } ] [ { t t f } hook-test ] unit-test
45 [ fixnum ] [ 3 hook-test ] unit-test
46 5.0 some-var set
47 [ 0 ] [ H{ } hook-test ] unit-test
49 "error" some-var set
50 [ H{ } hook-test ] must-fail
51 [ t ] [ error get no-method? ] unit-test
52 [ { H{ } "error" } ] [ error get arguments>> ] unit-test
54 MIXIN: busted
56 TUPLE: busted-1 ;
57 TUPLE: busted-2 ; INSTANCE: busted-2 busted
58 TUPLE: busted-3 ;
60 GENERIC: busted-sort
62 METHOD: busted-sort { busted-1 busted-2 } ;
63 METHOD: busted-sort { busted-2 busted-3 } ;
64 METHOD: busted-sort { busted busted } ;