t/oo/isa.t

   1 #!./parrot
   2 # Copyright (C) 2007-2008, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/isa.t - Test OO inheritance
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/isa.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests OO features related to the isa opcode, comparing for inheritance and
  16 composition.
  17
  18 =cut
  19
  20 .sub main :main
  21     .include 'test_more.pir'
  22
  23     plan(30)
  24
  25     isa_by_string_name()
  26     isa_by_class_object()
  27     subclass_isa_by_string_name()
  28     subclass_isa_by_class_object()
  29     string_isa_and_pmc_isa_have_same_result()
  30     string_register_and_string_pmc_isa_have_same_result()
  31     isa_accepts_rsa()
  32 .end
  33
  34
  35 .sub isa_by_string_name
  36     $P1 = newclass "Foo"
  37     $S1 = typeof $P1
  38
  39     is( 'Class', $S1, 'typeof newclass retval')
  40
  41     $I3 = isa $P1, "Class"
  42     ok( $I3, 'isa newclass retval a Class')
  43
  44     $P2 = new $P1
  45     $S1 = typeof $P2
  46     is ( 'Foo', $S1, 'typeof instance of our class')
  47
  48     $I3 = isa $P2, "Foo"
  49     ok ( $I3, 'isa instance of our class')
  50
  51     $I3 = isa $P2, "Object"
  52     ok ( $I3, 'isa instance of object')
  53 .end
  54
  55 .sub isa_by_class_object
  56     .local pmc foo_class
  57     foo_class = newclass "Foo2"
  58     $S1 = typeof foo_class
  59
  60     is( 'Class', $S1, 'typeof newclass retval')
  61
  62     .local pmc class_class
  63     class_class = get_class "Class"
  64     $I3 = isa foo_class, class_class
  65     ok ($I3, 'isa newclass retval a Class')
  66
  67     $P2 = new foo_class
  68     $S1 = typeof $P2
  69     is ( 'Foo2', $S1, 'typeof new our class?')
  70
  71     $I3 = isa $P2, foo_class
  72     ok ( $I3, 'isa instance of our class')
  73
  74     .local pmc object_class
  75     object_class = get_class "Object"
  76     $I3 = isa $P2, object_class
  77     ok ( $I3, 'isa instance of Object')
  78 .end
  79
  80 .sub subclass_isa_by_string_name
  81     .local pmc foo_class, bar_class
  82     foo_class = newclass "Foo3"
  83     bar_class = subclass "Foo3", "Bar3"
  84
  85     $I3 = isa bar_class, "Class"
  86     ok ($I3, 'does subclass generate class objects')
  87
  88     $P2 = new bar_class
  89     $S1 = typeof $P2
  90     is ('Bar3', $S1, 'does new give us an obj of our type')
  91
  92     $I3 = isa $P2, "Bar3"
  93     ok ($I3, 'does new give us an obj that isa our type')
  94
  95     $I3 = isa $P2, "Foo3"
  96     ok ($I3, 'does new give us an obj that isa our parent type')
  97
  98     $I3 = isa $P2, "Object"
  99     ok ($I3, 'does new give us an obj that isa Object')
 100 .end
 101
 102 .sub subclass_isa_by_class_object
 103     .local pmc foo_class, bar_class, sub_sub_class, my_sub_class
 104     foo_class     = newclass "Foo4"
 105     bar_class     = subclass "Foo4", "Bar4"
 106     sub_sub_class = subclass 'Sub', 'SubSub'
 107     my_sub_class  = subclass 'SubSub', 'MySub'
 108
 109     .local pmc class_class
 110     class_class = get_class "Class"
 111     $I3 = isa bar_class, class_class
 112     ok ($I3, 'is the class of a subclass Class')
 113
 114     $P2 = new bar_class
 115     $S1 = typeof $P2
 116     is ('Bar4', $S1, 'typeof new class our class')
 117
 118     $I3 = isa $P2, bar_class
 119     ok ($I3, 'new class isa our class')
 120
 121     $I3 = isa $P2, foo_class
 122     ok ($I3, 'new class isa our parent class')
 123
 124     .local pmc object_class
 125     object_class = get_class "Object"
 126     $I3 = isa $P2, object_class
 127     ok ($I3, 'new class isa Object')
 128
 129     .local pmc sub_class
 130     sub_class = get_class 'Sub'
 131     $P2       = new sub_sub_class
 132     $I3       = isa $P2, sub_class
 133     ok( $I3, 'new class isa Sub' )
 134
 135     $P2       = new my_sub_class
 136     $I3       = isa $P2, sub_class
 137     ok( $I3, 'new subclass isa Sub' )
 138 .end
 139
 140
 141 .sub string_isa_and_pmc_isa_have_same_result
 142     .local pmc class, obj
 143     class = new 'Class'
 144     obj = class.'new'()
 145     $I0 = isa obj, 'Object'
 146     ok ($I0, 'isa Class instance an Object')
 147
 148     .local pmc cl
 149     cl = new 'String'
 150     cl = 'Object'
 151     $I1 = isa obj, cl
 152     ok ($I1, 'isa String instance an Object')
 153 .end
 154
 155 .sub string_register_and_string_pmc_isa_have_same_result
 156     .local pmc xyzns, xyzclass, xyzobj
 157
 158     xyzns    = get_root_namespace ['foo';'XYZ']
 159     xyzclass = newclass xyzns
 160     xyzobj   = new xyzclass
 161
 162     # prove that it's the correct type
 163     $S0 = xyzobj.'abc'()
 164     is( $S0, 'XYZ::abc', 'sanity check for correct method and type' )
 165
 166     # test two forms of isa
 167     $P0 = new 'String'
 168     $P0 = 'XYZ'
 169     $I0 = isa xyzobj, 'XYZ'
 170     ok( $I0, 'isa given string register should return true when it isa' )
 171
 172     $I0 = isa xyzobj, 'ZYX'
 173     $I0 = not $I0
 174     ok( $I0, '... and false when it is not' )
 175
 176     $I0 = isa xyzobj, $P0
 177     ok( $I0, 'isa given string PMC should return true when it isa' )
 178
 179     $P0 = 'ZYX'
 180     $I0 = isa xyzobj, $P0
 181     $I0 = not $I0
 182     ok( $I0, '... and false when it is not' )
 183 .end
 184
 185 .sub isa_accepts_rsa
 186     $P0 = newclass ['Foo';'Buz']
 187     $P1 = new $P0
 188     $P0 = split "::", "Foo::Buz"
 189     $I0 = isa $P1, $P0
 190     ok($I0, "isa accepts a ResizablePMCArray")
 191  .end
 192
 193 .HLL 'foo'
 194 .namespace ['XYZ']
 195
 196 .sub 'abc' :method
 197     .return( 'XYZ::abc' )
 198 .end
 199
 200 # Local Variables:
 201 #   mode: pir
 202 #   fill-column: 100
 203 # End:
 204 # vim: expandtab shiftwidth=4 ft=pir: