t/oo/mro-c3.t

   1 #! parrot
   2 # Copyright (C) 2007, 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(12)
  23
  24     single_parent()
  25     grandparent()
  26     multiple_inheritance()
  27     diamond_inheritance()
  28 .end
  29
  30 .sub method_A :method
  31     .return('Method from A')
  32 .end
  33
  34 .sub method_B :method
  35     .return('Method from B')
  36 .end
  37
  38 .sub method_C :method
  39     .return('Method from C')
  40 .end
  41
  42 .sub method_D :method
  43     .return('Method from D')
  44 .end
  45
  46 .sub single_parent
  47     .local pmc A, B
  48
  49     A = new 'Class'
  50     $P0 = get_global 'method_A'
  51     A.'add_method'('foo', $P0)
  52     A.'add_method'('bar', $P0)
  53
  54     B = new 'Class'
  55     B.'add_parent'(A)
  56     $P0 = get_global 'method_B'
  57     B.'add_method'('foo', $P0)
  58
  59     $P0 = B.'new'()
  60     $S0 = $P0.'foo'()
  61     $S1 = $P0.'bar'()
  62     is($S0, 'Method from B', 'Single Parent - Method foo overloaded in B')
  63     is($S1, 'Method from A', 'Single Parent - Method bar inherited from A')
  64 .end
  65
  66 .sub grandparent
  67     .local pmc A, B, C
  68
  69     A = new 'Class'
  70     $P0 = get_global 'method_A'
  71     A.'add_method'('foo', $P0)
  72     A.'add_method'('bar', $P0)
  73     A.'add_method'('baz', $P0)
  74
  75     B = new 'Class'
  76     B.'add_parent'(A)
  77     $P0 = get_global 'method_B'
  78     B.'add_method'('foo', $P0)
  79     B.'add_method'('bar', $P0)
  80
  81     C = new 'Class'
  82     C.'add_parent'(B)
  83     $P0 = get_global 'method_C'
  84     C.'add_method'('foo', $P0)
  85
  86     $P0 = C.'new'()
  87     $S0 = $P0.'foo'()
  88     $S1 = $P0.'bar'()
  89     $S2 = $P0.'baz'()
  90     is($S0, 'Method from C', 'Grandparent - Method foo overloaded in C')
  91     is($S1, 'Method from B', 'Grandparent - Method bar inherited from B')
  92     is($S2, 'Method from A', 'Grandparent - Method baz inherited from A')
  93 .end
  94
  95 .sub multiple_inheritance
  96     .local pmc A, B, C
  97
  98     A = newclass 'MIA'
  99     $P0 = get_global 'method_A'
 100     A.'add_method'('foo', $P0)
 101     A.'add_method'('bar', $P0)
 102     A.'add_method'('baz', $P0)
 103
 104     B = newclass 'MIB'
 105     $P0 = get_global 'method_B'
 106     B.'add_method'('foo', $P0)
 107     B.'add_method'('bar', $P0)
 108
 109     C = newclass 'MIC'
 110     C.'add_parent'(B)
 111     C.'add_parent'(A)
 112     $P0 = get_global 'method_C'
 113     C.'add_method'('foo', $P0)
 114
 115     $P0 = C.'new'()
 116     $S0 = $P0.'foo'()
 117     $S1 = $P0.'bar'()
 118     $S2 = $P0.'baz'()
 119     is($S0, 'Method from C', 'Multiple Inheritance - Method foo overloaded in C')
 120     is($S1, 'Method from B', 'Multiple Inheritance - Method bar inherited from B')
 121     is($S2, 'Method from A', 'Multiple Inheritance - Method baz inherited from A')
 122 .end
 123
 124 .sub diamond_inheritance
 125     .local pmc A, B, C, D
 126
 127     A = newclass 'DIA'
 128     $P0 = get_global 'method_A'
 129     A.'add_method'('foo', $P0)
 130     A.'add_method'('bar', $P0)
 131     A.'add_method'('baz', $P0)
 132     A.'add_method'('wag', $P0)
 133
 134     B = newclass 'DIB'
 135     B.'add_parent'(A)
 136     $P0 = get_global 'method_B'
 137     B.'add_method'('foo', $P0)
 138     B.'add_method'('bar', $P0)
 139     B.'add_method'('baz', $P0)
 140
 141     C = newclass 'DIC'
 142     C.'add_parent'(A)
 143     $P0 = get_global 'method_C'
 144     C.'add_method'('foo', $P0)
 145     C.'add_method'('bar', $P0)
 146
 147     D = newclass 'DID'
 148     D.'add_parent'(C)
 149     D.'add_parent'(B)
 150     $P0 = get_global 'method_D'
 151     D.'add_method'('foo', $P0)
 152
 153     $P0 = D.'new'()
 154     $S0 = $P0.'foo'()
 155     $S1 = $P0.'bar'()
 156     $S2 = $P0.'baz'()
 157     $S3 = $P0.'wag'()
 158     is($S0, 'Method from D', 'Diamond Inheritance - Method foo overloaded in D')
 159     is($S1, 'Method from C', 'Diamond Inheritance - Method bar inherited from C')
 160     is($S2, 'Method from B', 'Diamond Inheritance - Method baz inherited from B')
 161     is($S3, 'Method from A', 'Diamond Inheritance - Method wag inherited from A')
 162 .end
 163
 164 # Local Variables:
 165 #   mode: pir
 166 #   fill-column: 100
 167 # End:
 168 # vim: expandtab shiftwidth=4 ft=pir: