t/oo/composition.t

   1 #! parrot
   2 # Copyright (C) 2007, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/compositon.t - test role composition
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/compositon.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests role composition in the OO implementation.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'except_types.pasm'
  21     .include 'test_more.pir'
  22     plan(45)
  23
  24     role_with_no_methods()
  25     role_with_one_method_no_methods_in_class()
  26     two_roles_and_a_class_a_method_each_no_conflict()
  27     two_roles_that_conflict()
  28     role_that_conflicts_with_a_class_method()
  29     conflict_resolution_by_exclusion()
  30     conflict_resolution_by_aliasing_and_exclude()
  31     conflict_resolution_by_resolve()
  32     role_that_does_a_role()
  33     conflict_from_indirect_role()
  34     multi_composition()
  35 .end
  36
  37 .sub badger :method
  38     .return('Badger!')
  39 .end
  40 .sub badger2 :method
  41     .return('Second Badger!')
  42 .end
  43 .sub mushroom :method
  44     .return('Mushroom!')
  45 .end
  46 .sub snake :method
  47     .return('Snake!')
  48 .end
  49 .sub fire
  50     .return("You're FIRED!")
  51 .end
  52 .sub fire2
  53     .return('BURNINATION!')
  54 .end
  55 .sub give_payrise
  56     .return('You all get a pay rise of 0.0005%.')
  57 .end
  58
  59 .sub role_with_no_methods
  60     $P0 = new 'Role'
  61     $P1 = new 'Class'
  62
  63     $P1.'add_role'($P0)
  64     ok(1, 'added role')
  65
  66     $P2 = $P1.'roles'()
  67     $I0 = elements $P2
  68     is($I0, 1, 'roles list has the role')
  69
  70     $P2 = $P1.'new'()
  71     ok(1, 'instantiated class with composed role')
  72 .end
  73
  74 .sub role_with_one_method_no_methods_in_class
  75     $P0 = new 'Role'
  76     $P1 = new 'Class'
  77
  78     $P2 = get_global "badger"
  79     $P0.'add_method'("badger", $P2)
  80     ok(1, 'added method to a role')
  81
  82     $P1.'add_role'($P0)
  83     ok(1, 'composed role into the class')
  84
  85     $P2 = $P1.'roles'()
  86     $I0 = elements $P2
  87     is($I0, 1, 'roles list has the role')
  88
  89     $P2 = $P1.'new'()
  90     ok(1, 'instantiated class with composed role')
  91
  92     $S0 = $P2.'badger'()
  93     is($S0, 'Badger!', 'called method composed from role')
  94 .end
  95
  96 .sub two_roles_and_a_class_a_method_each_no_conflict
  97     $P0 = new 'Role'
  98     $P1 = new 'Role'
  99     $P2 = new 'Class'
 100
 101     $P3 = get_global "snake"
 102     $P2.'add_method'("snake", $P3)
 103     ok(1, 'class has a method')
 104
 105     $P3 = get_global "badger"
 106     $P0.'add_method'("badger", $P3)
 107     $P2.'add_role'($P0)
 108     ok(1, 'composed first role into the class')
 109
 110     $P3 = get_global "mushroom"
 111     $P1.'add_method'("mushroom", $P3)
 112     $P2.'add_role'($P1)
 113     ok(1, 'composed second role into the class')
 114
 115     $P3 = $P2.'new'()
 116     ok(1, 'instantiated class')
 117
 118     $S0 = $P3.'badger'()
 119     is($S0, 'Badger!', 'called method from first role')
 120
 121     $S1 = $P3.'mushroom'()
 122     is($S1, 'Mushroom!', 'called method from second role')
 123
 124     $S2 = $P3.'snake'()
 125     is($S2, 'Snake!', 'called method from class')
 126 .end
 127
 128 .sub two_roles_that_conflict
 129     .local pmc eh
 130     $P0 = new 'Role'
 131     $P1 = new 'Role'
 132     $P2 = new 'Class'
 133
 134     $P3 = get_global "badger"
 135     $P0.'add_method'("badger", $P3)
 136     $P2.'add_role'($P0)
 137     ok(1, 'composed first role into the class')
 138
 139     $P3 = get_global "badger2"
 140     $P1.'add_method'("badger", $P3)
 141
 142   try:
 143     eh = new 'ExceptionHandler'
 144     eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT)
 145     set_addr eh, catch
 146
 147     push_eh eh
 148     $P2.'add_role'($P1)
 149     $I0 = 1
 150     goto finally
 151
 152   catch:
 153     $I0 = 0
 154
 155   finally:
 156     pop_eh
 157     nok($I0, 'composition failed due to conflict')
 158 .end
 159
 160 .sub role_that_conflicts_with_a_class_method
 161     .local pmc eh
 162     $P0 = new 'Role'
 163     $P1 = new 'Class'
 164
 165     $P2 = get_global "badger"
 166     $P1.'add_method'("badger", $P2)
 167     ok(1, 'class has a method')
 168
 169     $P2 = get_global "badger2"
 170     $P0.'add_method'("badger", $P2)
 171
 172   try:
 173     eh = new 'ExceptionHandler'
 174     eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT)
 175     set_addr eh, catch
 176
 177     push_eh eh
 178     $P1.'add_role'($P0)
 179     $I0 = 1
 180     goto finally
 181
 182   catch:
 183     $I0 = 0
 184
 185   finally:
 186     pop_eh
 187     nok($I0, 'composition failed due to conflict')
 188 .end
 189
 190 .sub conflict_resolution_by_exclusion
 191     $P0 = new 'Role'
 192     $P1 = new 'Class'
 193
 194     $P2 = get_global "badger"
 195     $P1.'add_method'("badger", $P2)
 196     ok(1, 'class has a method')
 197
 198     $P2 = get_global "badger2"
 199     $P0.'add_method'("badger", $P2)
 200     $P2 = get_global "snake"
 201     $P0.'add_method'("snake", $P2)
 202     $P3 = new 'ResizableStringArray'
 203     push $P3, "badger"
 204     $P1.'add_role'($P0, 'exclude_method' => $P3)
 205     ok(1, 'composition worked due to exclusion')
 206
 207     $P2 = $P1.'new'()
 208     $S0 = $P2.'badger'()
 209     is($S0, 'Badger!', 'called method from class')
 210
 211     $S1 = $P2.'snake'()
 212     is($S1, 'Snake!', "called method from role that wasn't excluded")
 213 .end
 214
 215 .sub conflict_resolution_by_aliasing_and_exclude
 216     $P0 = new 'Role'
 217     $P1 = new 'Class'
 218
 219     $P2 = get_global 'badger'
 220     $P1.'add_method'('badger', $P2)
 221     ok(1, 'class has a method')
 222
 223     $P2 = get_global 'badger2'
 224     $P0.'add_method'('badger', $P2)
 225     $P2 = get_global 'snake'
 226     $P0.'add_method'('snake', $P2)
 227     $P3 = new 'Hash'
 228     $P3['badger'] = 'role_badger'
 229     $P4 = new 'ResizableStringArray'
 230     $P4[0] = 'badger'
 231     $P1.'add_role'($P0, 'alias_method' => $P3, 'exclude_method' => $P4)
 232     ok(1, 'composition worked due to aliasing and exclude')
 233
 234     $P2 = $P1.'new'()
 235     $S0 = $P2.'badger'()
 236     is($S0, 'Badger!', 'called method from class')
 237
 238     $S1 = $P2.'snake'()
 239     is($S1, 'Snake!', "called method from role that wasn't aliased")
 240
 241     $S2 = $P2.'role_badger'()
 242     is($S2, 'Second Badger!', 'called method from role that was aliased')
 243 .end
 244
 245 .sub conflict_resolution_by_resolve
 246     $P0 = new 'Role'
 247     $P1 = new 'Class'
 248
 249     $P3 = new 'ResizableStringArray'
 250     push $P3, 'badger'
 251     $P1.'resolve_method'($P3)
 252     ok(1, 'set resolve list')
 253
 254     $P4 = $P1.'resolve_method'()
 255     $S0 = $P4[0]
 256     is($S0, 'badger', 'got resolve list and it matched')
 257
 258     $P2 = get_global 'badger'
 259     $P1.'add_method'('badger', $P2)
 260     ok(1, 'class has a method')
 261
 262     $P2 = get_global 'badger2'
 263     $P0.'add_method'('badger', $P2)
 264     $P2 = get_global 'snake'
 265     $P0.'add_method'('snake', $P2)
 266     $P1.'add_role'($P0)
 267     ok(1, 'composition worked due to resolve')
 268
 269     $P2 = $P1.'new'()
 270     $S1 = $P2.'badger'()
 271     is($S1, 'Badger!', 'called method from class')
 272
 273     $S2 = $P2.'snake'()
 274     is($S2, 'Snake!', "called method from role that wasn't resolved")
 275 .end
 276
 277 .sub role_that_does_a_role
 278     .local pmc PHB, Manage, FirePeople
 279
 280     FirePeople = new 'Role'
 281     $P0 = get_global 'fire'
 282     FirePeople.'add_method'("fire", $P0)
 283
 284     Manage = new 'Role'
 285     $P0 = get_global 'give_payrise'
 286     Manage.'add_method'("give_payrise", $P0)
 287     Manage.'add_role'(FirePeople)
 288     ok(1, 'adding one role to another happens')
 289
 290     PHB = new 'Class'
 291     PHB.'add_role'(Manage)
 292     ok(1, 'added one rule that does another role to the class')
 293
 294     $P0 = PHB.'new'()
 295     $S0 = $P0.'give_payrise'()
 296     is($S0, 'You all get a pay rise of 0.0005%.', 'called method from direct role')
 297
 298     $S1 = $P0.'fire'()
 299     is($S1, "You're FIRED!", 'called method from indirect role')
 300 .end
 301
 302 .sub conflict_from_indirect_role
 303     .local pmc eh, BurninatorBoss, Manage, FirePeople, Burninator
 304
 305     FirePeople = new 'Role'
 306     $P0 = get_global 'fire'
 307     FirePeople.'add_method'('fire', $P0)
 308
 309     Manage = new 'Role'
 310     $P0 = get_global 'give_payrise'
 311     FirePeople.'add_method'('give_payrise', $P0)
 312     Manage.'add_role'(FirePeople)
 313
 314     Burninator = new 'Role'
 315     $P0 = get_global 'fire2'
 316     Burninator.'add_method'('fire', $P0)
 317     ok(1, 'all roles created')
 318
 319     BurninatorBoss = new 'Class'
 320     BurninatorBoss.'add_role'(Manage)
 321     ok(1, 'added first role with indirect role')
 322
 323   try:
 324     eh = new 'ExceptionHandler'
 325     eh.'handle_types'(.EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT)
 326     set_addr eh, catch
 327
 328     push_eh eh
 329     BurninatorBoss.'add_role'(Burninator)
 330     $I0 = 1
 331     goto finally
 332
 333   catch:
 334     $I0 = 0
 335
 336   finally:
 337     pop_eh
 338     nok($I0, 'second role conflicts with method from indirect role')
 339 .end
 340
 341 .sub 'multi_composition'
 342     .local pmc R, C
 343     R = new 'Role'
 344     $P0 = get_global 'mctest_2'
 345     R.'add_method'("mctest", $P0)
 346     C = new 'Class'
 347     $P0 = get_global 'mctest_1'
 348     C.'add_method'("mctest", $P0)
 349     C.'add_role'(R)
 350     ok(1, 'a multi in the class prevents a role conflict')
 351
 352     $P0 = inspect C, 'methods'
 353     $I0 = elements $P0
 354     is($I0, 1, 'class had still one method after composition')
 355     $P0 = $P0['mctest']
 356     $I0 = isa $P0, 'MultiSub'
 357     is($I0, 1, 'method was a multi sub')
 358     $I0 = elements $P0
 359     is($I0, 2, 'multi holds both candidates')
 360 .end
 361 .sub 'mctest_1' :multi()
 362 .end
 363 .sub 'mctest_2'
 364 .end
 365
 366 # Local Variables:
 367 #   mode: pir
 368 #   fill-column: 100
 369 # End:
 370 # vim: expandtab shiftwidth=4 ft=pir: