t/oo/mro-c3.t

   1 #!./parrot
   2 # Copyright (C) 2007-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/mro-c3.t - test the C3 Method Resolution Order for Parrot OO
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/mro-c3.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the C3 Method Resolution order for the OO implementation.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21
  22     plan(13)
  23
  24     single_parent()
  25     grandparent()
  26     multiple_inheritance()
  27     diamond_inheritance()
  28     merge_two_pairs()
  29 .end
  30
  31 .sub method_A :method :nsentry('method_A')
  32     .return('Method from A')
  33 .end
  34
  35 .sub method_B :method :nsentry('method_B')
  36     .return('Method from B')
  37 .end
  38
  39 .sub method_C :method :nsentry('method_C')
  40     .return('Method from C')
  41 .end
  42
  43 .sub method_D :method :nsentry('method_D')
  44     .return('Method from D')
  45 .end
  46
  47 .sub single_parent
  48     .local pmc A, B
  49
  50     A = new 'Class'
  51     $P0 = get_global 'method_A'
  52     A.'add_method'('foo', $P0)
  53     A.'add_method'('bar', $P0)
  54
  55     B = new 'Class'
  56     B.'add_parent'(A)
  57     $P0 = get_global 'method_B'
  58     B.'add_method'('foo', $P0)
  59
  60     $P0 = B.'new'()
  61     $S0 = $P0.'foo'()
  62     $S1 = $P0.'bar'()
  63     is($S0, 'Method from B', 'Single Parent - Method foo overloaded in B')
  64     is($S1, 'Method from A', 'Single Parent - Method bar inherited from A')
  65 .end
  66
  67 .sub grandparent
  68     .local pmc A, B, C
  69
  70     A = new 'Class'
  71     $P0 = get_global 'method_A'
  72     A.'add_method'('foo', $P0)
  73     A.'add_method'('bar', $P0)
  74     A.'add_method'('baz', $P0)
  75
  76     B = new 'Class'
  77     B.'add_parent'(A)
  78     $P0 = get_global 'method_B'
  79     B.'add_method'('foo', $P0)
  80     B.'add_method'('bar', $P0)
  81
  82     C = new 'Class'
  83     C.'add_parent'(B)
  84     $P0 = get_global 'method_C'
  85     C.'add_method'('foo', $P0)
  86
  87     $P0 = C.'new'()
  88     $S0 = $P0.'foo'()
  89     $S1 = $P0.'bar'()
  90     $S2 = $P0.'baz'()
  91     is($S0, 'Method from C', 'Grandparent - Method foo overloaded in C')
  92     is($S1, 'Method from B', 'Grandparent - Method bar inherited from B')
  93     is($S2, 'Method from A', 'Grandparent - Method baz inherited from A')
  94 .end
  95
  96 .sub multiple_inheritance
  97     .local pmc A, B, C
  98
  99     A = newclass 'MIA'
 100     $P0 = get_global 'method_A'
 101     A.'add_method'('foo', $P0)
 102     A.'add_method'('bar', $P0)
 103     A.'add_method'('baz', $P0)
 104
 105     B = newclass 'MIB'
 106     $P0 = get_global 'method_B'
 107     B.'add_method'('foo', $P0)
 108     B.'add_method'('bar', $P0)
 109
 110     C = newclass 'MIC'
 111     C.'add_parent'(B)
 112     C.'add_parent'(A)
 113     $P0 = get_global 'method_C'
 114     C.'add_method'('foo', $P0)
 115
 116     $P0 = C.'new'()
 117     $S0 = $P0.'foo'()
 118     $S1 = $P0.'bar'()
 119     $S2 = $P0.'baz'()
 120     is($S0, 'Method from C', 'Multiple Inheritance - Method foo overloaded in C')
 121     is($S1, 'Method from B', 'Multiple Inheritance - Method bar inherited from B')
 122     is($S2, 'Method from A', 'Multiple Inheritance - Method baz inherited from A')
 123 .end
 124
 125 .sub diamond_inheritance
 126     .local pmc A, B, C, D
 127
 128     A = newclass 'DIA'
 129     $P0 = get_global 'method_A'
 130     A.'add_method'('foo', $P0)
 131     A.'add_method'('bar', $P0)
 132     A.'add_method'('baz', $P0)
 133     A.'add_method'('wag', $P0)
 134
 135     B = newclass 'DIB'
 136     B.'add_parent'(A)
 137     $P0 = get_global 'method_B'
 138     B.'add_method'('foo', $P0)
 139     B.'add_method'('bar', $P0)
 140     B.'add_method'('baz', $P0)
 141
 142     C = newclass 'DIC'
 143     C.'add_parent'(A)
 144     $P0 = get_global 'method_C'
 145     C.'add_method'('foo', $P0)
 146     C.'add_method'('bar', $P0)
 147
 148     D = newclass 'DID'
 149     D.'add_parent'(C)
 150     D.'add_parent'(B)
 151     $P0 = get_global 'method_D'
 152     D.'add_method'('foo', $P0)
 153
 154     $P0 = D.'new'()
 155     $S0 = $P0.'foo'()
 156     $S1 = $P0.'bar'()
 157     $S2 = $P0.'baz'()
 158     $S3 = $P0.'wag'()
 159     is($S0, 'Method from D', 'Diamond Inheritance - Method foo overloaded in D')
 160     is($S1, 'Method from C', 'Diamond Inheritance - Method bar inherited from C')
 161     is($S2, 'Method from B', 'Diamond Inheritance - Method baz inherited from B')
 162     is($S3, 'Method from A', 'Diamond Inheritance - Method wag inherited from A')
 163 .end
 164
 165 # See TT#1426
 166 .sub merge_two_pairs
 167     .local pmc C, A, B
 168
 169     push_eh test_fail
 170
 171     C = newclass 'TPC'
 172     $P0 = get_global 'method_C'
 173     C.'add_method'('bar', $P0)
 174
 175     B = newclass 'TPB'
 176     B.'add_parent'(C)
 177     $P0 = get_global 'method_B'
 178     B.'add_method'('bar', $P0)
 179
 180     A = newclass 'TPA'
 181     A.'add_parent'(C)
 182     A.'add_parent'(B)
 183     $P0 = get_global 'method_A'
 184     A.'add_method'('foo', $P0)
 185
 186
 187     $P0 = A.'new'()
 188     $S0 = $P0.'bar'()
 189     is($S0, 'Method from B', 'Merge Two Pairs - Method A.bar added from B')
 190
 191     .return ()
 192
 193 test_fail:
 194     pop_eh
 195     todo(0, 'Merge Two Pairs - Method A.bar added from B', 'See TT#1426')
 196 .end
 197 # Local Variables:
 198 #   mode: pir
 199 #   fill-column: 100
 200 # End:
 201 # vim: expandtab shiftwidth=4 ft=pir: