t/library/protoobject.t

   1 #!./parrot
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/library/protoobject.t - testing Protoobject.pir
   8
   9 =head1 SYNOPSIS
  10
  11         % prove t/library/protoobject.t
  12
  13 =head1 DESCRIPTION
  14
  15 This test exercises the protoobject/Protomaker implementations.
  16
  17 =cut
  18
  19 .sub main :main
  20     load_bytecode 'Protoobject.pbc'
  21
  22     .include 'test_more.pir'
  23     plan(13)
  24
  25     test_basic_load()
  26     test_type_of_protoobject()
  27     test_type_of_ns_based_protoobject()
  28     test_protoobject_symbol_1()
  29     test_protoobject_symbol_2()
  30     test_protoobject_symbol_for_classes()
  31     test_new_subclass_for_classes()
  32     test_new_subclass_with_attrs()
  33     test_method_new_on_protoobject()
  34 .end
  35
  36
  37 .sub test_basic_load
  38     $P0 = get_hll_global 'Protomaker'
  39     $S0 = typeof $P0
  40     is($S0, 'Protomaker', 'basic load')
  41 .end
  42
  43
  44 .sub test_type_of_protoobject
  45     $P0 = get_hll_global 'Protomaker'
  46     $P1 = newclass 'XYZ'
  47     $P2 = $P0.'new_proto'($P1)
  48
  49     $S0 = typeof $P2
  50     is($S0, 'XYZ', 'type of protoobject')
  51 .end
  52
  53
  54 .sub test_type_of_ns_based_protoobject
  55     $P0 = get_hll_global 'Protomaker'
  56     $P1 = newclass ['Foo';'Bar1']
  57     $P2 = $P0.'new_proto'($P1)
  58
  59     $S0 = typeof $P2
  60     is($S0, 'Foo;Bar1', 'type of ns-based protoobject')
  61 .end
  62
  63
  64 .sub test_protoobject_symbol_1
  65     $P0 = get_hll_global 'Protomaker'
  66     $P1 = newclass ['Foo';'Bar2']
  67     $P2 = $P0.'new_proto'($P1)
  68
  69     $P2 = get_hll_global ['Foo'], 'Bar2'
  70     $S0 = typeof $P2
  71     is($S0, 'Foo;Bar2', 'protoobject symbol 1')
  72 .end
  73
  74
  75 .sub test_protoobject_symbol_2
  76     $P0 = get_hll_global 'Protomaker'
  77     $P1 = newclass 'Foo'
  78     $P2 = $P0.'new_proto'($P1)
  79
  80     $P2 = get_hll_global 'Foo'
  81     $S0 = typeof $P2
  82     is($S0, 'Foo', 'protoobject symbol 2')
  83 .end
  84
  85
  86 .sub test_protoobject_symbol_for_classes
  87     $P0 = get_hll_global 'Protomaker'
  88     $P1 = newclass 'Foo::Bar3'
  89     $P2 = $P0.'new_proto'($P1)
  90
  91     $P2 = get_hll_global ['Foo'], 'Bar3'
  92     $S0 = typeof $P2
  93     is($S0, 'Foo::Bar3', 'protoobject symbol for :: classes')
  94 .end
  95
  96
  97 .sub test_new_subclass_for_classes
  98     $P0 = get_hll_global 'Protomaker'
  99     $P1 = get_class 'Hash'
 100     $P0.'new_subclass'($P1, 'Foo::Bar4')
 101
 102     $P2 = new 'Foo::Bar4'
 103     $S0 = typeof $P2
 104     is($S0, 'Foo::Bar4', 'new_subclass for :: classes')
 105
 106     $P2 = get_hll_global ['Foo'], 'Bar4'
 107     $S0 = typeof $P2
 108     is($S0, 'Foo::Bar4', 'new_subclass for :: classes')
 109 .end
 110
 111
 112 .sub test_new_subclass_with_attrs
 113     .local pmc protomaker, hashclass, attrs
 114     protomaker = get_hll_global 'Protomaker'
 115     hashclass = get_class 'Hash'
 116     attrs = split ' ', '$a $b $c $d'
 117     protomaker.'new_subclass'(hashclass, 'Foo::Bar', attrs :flat)
 118
 119     .local pmc object, it
 120     object = new 'Foo::Bar'
 121     it = iter attrs
 122   iter_loop:
 123     unless it goto iter_end
 124     $P0 = shift it
 125     $S0 = $P0
 126     setattribute object, $S0, $P0
 127     $P1 = getattribute object, $S0
 128     is($P1, $P0,'new_subclass with attrs')
 129     goto iter_loop
 130   iter_end:
 131 .end
 132
 133
 134 .sub test_method_new_on_protoobject
 135     $P0 = newclass 'Foo1'
 136
 137     .local pmc protomaker
 138     protomaker = get_hll_global 'Protomaker'
 139     protomaker.'new_proto'('Foo1')
 140
 141     $P0 = get_hll_global 'Foo1'
 142     $P1 = $P0.'new'()
 143     $S0 = typeof $P1
 144     is($S0, 'Foo1', 'method "new" on protoobject')
 145 .end
 146
 147
 148 # Local Variables:
 149 #   mode: pir
 150 #   fill-column: 100
 151 # End:
 152 # vim: expandtab shiftwidth=4 ft=pir: