t/oo/isa.t

   1 #! parrot
   2 # Copyright (C) 2007-2008, The Perl 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 'include/test_more.pir'
  22
  23     plan(22)
  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 .end
  31
  32
  33 .sub isa_by_string_name
  34     $P1 = newclass "Foo"
  35     $S1 = typeof $P1
  36
  37     is( 'Class', $S1, 'typeof newclass retval')
  38
  39     $I3 = isa $P1, "Class"
  40     ok( $I3, 'isa newclass retval a Class')
  41
  42     $P2 = new $P1
  43     $S1 = typeof $P2
  44     is ( 'Foo', $S1, 'typeof instance of our class')
  45
  46     $I3 = isa $P2, "Foo"
  47     ok ( $I3, 'isa instance of our class')
  48
  49     $I3 = isa $P2, "Object"
  50     ok ( $I3, 'isa instance of object')
  51 .end
  52
  53 .sub isa_by_class_object
  54     .local pmc foo_class
  55     foo_class = newclass "Foo2"
  56     $S1 = typeof foo_class
  57
  58     is( 'Class', $S1, 'typeof newclass retval')
  59
  60     .local pmc class_class
  61     class_class = get_class "Class"
  62     $I3 = isa foo_class, class_class
  63     ok ($I3, 'isa newclass retval a Class')
  64
  65     $P2 = new foo_class
  66     $S1 = typeof $P2
  67     is ( 'Foo2', $S1, 'typeof new our class?')
  68
  69     $I3 = isa $P2, foo_class
  70     ok ( $I3, 'isa instance of our class')
  71
  72     .local pmc object_class
  73     object_class = get_class "Object"
  74     $I3 = isa $P2, object_class
  75     ok ( $I3, 'isa instance of Object')
  76 .end
  77
  78 .sub subclass_isa_by_string_name
  79     .local pmc foo_class, bar_class
  80     foo_class = newclass "Foo3"
  81     bar_class = subclass "Foo3", "Bar3"
  82
  83     $I3 = isa bar_class, "Class"
  84     ok ($I3, 'does subclass generate class objects')
  85
  86     $P2 = new bar_class
  87     $S1 = typeof $P2
  88     is ('Bar3', $S1, 'does new give us an obj of our type')
  89
  90     $I3 = isa $P2, "Bar3"
  91     ok ($I3, 'does new give us an obj that isa our type')
  92
  93     $I3 = isa $P2, "Foo3"
  94     ok ($I3, 'does new give us an obj that isa our parent type')
  95
  96     $I3 = isa $P2, "Object"
  97     ok ($I3, 'does new give us an obj that isa Object')
  98 .end
  99
 100 .sub subclass_isa_by_class_object
 101     .local pmc foo_class, bar_class
 102     foo_class = newclass "Foo4"
 103     bar_class = subclass "Foo4", "Bar4"
 104
 105     .local pmc class_class
 106     class_class = get_class "Class"
 107     $I3 = isa bar_class, class_class
 108     ok ($I3, 'is the class of a subclass Class')
 109
 110     $P2 = new bar_class
 111     $S1 = typeof $P2
 112     is ('Bar4', $S1, 'typeof new class our class')
 113
 114     $I3 = isa $P2, bar_class
 115     ok ($I3, 'new class isa our class')
 116
 117     $I3 = isa $P2, foo_class
 118     ok ($I3, 'new class isa our parent class')
 119
 120     .local pmc object_class
 121     object_class = get_class "Object"
 122     $I3 = isa $P2, object_class
 123     ok ($I3, 'new class isa Object')
 124 .end
 125
 126
 127 .sub string_isa_and_pmc_isa_have_same_result
 128     .local pmc class, obj
 129     class = new 'Class'
 130     obj = class.'new'()
 131     $I0 = isa obj, 'Object'
 132     ok ($I0, 'isa Class instance an Object')
 133
 134     .local pmc cl
 135     cl = new 'String'
 136     cl = 'Object'
 137     $I1 = isa obj, cl
 138     ok ($I1, 'isa String instance an Object')
 139 .end
 140
 141 # Local Variables:
 142 #   mode: pir
 143 #   fill-column: 100
 144 # End:
 145 # vim: expandtab shiftwidth=4 ft=pir: