t/oo/ops.t

   1 #!./parrot
   2 # Copyright (C) 2007-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/oo/ops.t - test OO related ops
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/oo/ops.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests opcodes related to the OO implementation.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'except_types.pasm'
  21     .include 'test_more.pir'
  22
  23     plan(20)
  24
  25     op_addrole_p_p()
  26     op_inspect_p_p()
  27     op_inspect_p_p_s()
  28     op_get_class_p_s()
  29     op_get_class_p_p()
  30     op_addattribute_p_s()
  31     op_new_p_s()
  32     op_can_i_p_s()
  33
  34 .end
  35
  36 .sub op_addrole_p_p
  37     $P0 = new 'Role'
  38     $P1 = new 'Class'
  39
  40     addrole $P1, $P0
  41     $P2 = $P1.'roles'()
  42     $I1 = elements $P2
  43     is ($I1, 1, 'addrole op executed and  verified')
  44
  45 .end
  46
  47 .sub op_inspect_p_p
  48     $P0 = new 'Class'
  49
  50     $P1 = inspect $P0
  51     $I1 = elements $P1
  52     is ($I1, 7, 'inspect op executed and hash count verified')
  53
  54 .end
  55
  56 .sub op_inspect_p_p_s
  57     $P0 = new 'Class'
  58     $P0.'name'('foo')
  59     $P0.'add_attribute'('a')
  60
  61     $P1 = inspect $P0, 'name'
  62     is ($P1, 'foo', 'inspect_p_p_s with name')
  63
  64     $P1 = inspect $P0, 'flags'
  65     $I0 = $P1
  66     $I1 = 1 << 29 # flag 29 is PObj_is_class_FLAG
  67     $I2 = $I0 & $I1
  68     ok ($I2, 'inspect_p_p_s with flags')
  69
  70     $P1 = inspect $P0, 'attributes'
  71     $I0 = elements $P1
  72     is ($I0, 1, 'inspect_p_p_s with attributes')
  73 .end
  74
  75 .sub op_get_class_p_s
  76     $P0 = new 'Hash'
  77     $P4 = new 'String'
  78     $P4 = 'Monkey'
  79     $P0['name'] = $P4
  80
  81     $P1 = new 'Class', $P0
  82     $I0 = isa $P1 , 'Class'
  83     ok ($I0, 'created new class named Monkey')
  84
  85     $P2 = get_class 'Monkey'
  86     $I1 = isa $P2 , 'Class'
  87     ok ($I1, 'get_class found a class')
  88
  89     $P3 = $P2.'inspect'('name')
  90     is ($P3, 'Monkey', 'got name of found class')
  91
  92     null $S0
  93     $P5 = get_class $S0
  94     $I2 = isnull $P5
  95     is ($I2, 1, 'null p gives null p')
  96 .end
  97
  98 .sub op_get_class_p_p
  99     $P0 = new 'Hash'
 100     $P4 = new 'String'
 101     $P4 = 'Ape'
 102     $P0['name'] = $P4
 103
 104     $P1 = new 'Class', $P0
 105     $I0 = isa $P1 , 'Class'
 106     ok ($I0, 'created new class named Ape')
 107
 108     $P2 = get_class [ 'Ape' ]
 109     $I1 = isa $P2 , 'Class'
 110     ok ($I1, 'get_class with a key found a class')
 111
 112     $P3 = $P2.'inspect'('name')
 113     is ($P3, 'Ape', 'got name of found class')
 114
 115     $P3 = get_namespace [ 'Monkey' ]
 116     $P2 = get_class $P3
 117     $I1 = isa $P2 , 'Class'
 118     ok ($I1, 'get_class with a namespace found a class')
 119     is ($P3, 'Monkey', 'got name of found class')
 120
 121     null $P5
 122     $P6 = get_class $P5
 123     $I2 = isnull $P6
 124     is ($I2, 1, 'null s gives null p')
 125 .end
 126
 127 .sub op_addattribute_p_s
 128     .local pmc eh
 129     $P0 = new 'Class'
 130     addattribute $P0, 'foo'
 131
 132     $P1 = $P0.'new'()
 133
 134     $P2 = new 'Integer'
 135     $P2 = 100
 136     setattribute $P1, 'foo', $P2
 137     getattribute $P2, $P1, 'foo'
 138
 139
 140     $P0 = new 'Hash'
 141 try:
 142     eh = new 'ExceptionHandler'
 143     eh.'handle_types'(.EXCEPTION_INVALID_OPERATION)
 144     set_addr eh, catch
 145
 146     push_eh eh
 147     addattribute $P0, 'oops'
 148     $I0 = 1 # add attribute success flag
 149     goto finally
 150
 151 catch:
 152     $I0 = 0 # add attribute failure flag
 153
 154 finally:
 155     pop_eh
 156     is ($P2, 100, 'reading assigned attribute')
 157     nok ($I0,'attempt to add attribute to non-class')
 158
 159 .end
 160
 161 .sub op_new_p_s
 162     $P0 = newclass "Foo"
 163     addattribute $P0, 'foo'
 164
 165     $S0 = "Foo"
 166     $P1 = new $S0
 167
 168     $P2 = new 'Integer'
 169     $P2 = 100
 170     setattribute $P1, 'foo', $P2
 171     getattribute $P2, $P1, 'foo'
 172
 173     is ($P2, 100, 'reading assigned attribute')
 174
 175 .end
 176
 177 .sub op_can_i_p_s
 178     $P0 = newclass "Baz"
 179     $P1 = new $P0
 180
 181     can $I0, $P1, "bar"
 182     ok ($I0, 'PMC has method bar')
 183     $I1 = $P1.'bar'()
 184     ok ($I1, 'called bar method on PMC')
 185 .end
 186
 187 .namespace ["Baz"]
 188 .sub bar :method
 189     .return (1)
 190 .end
 191
 192 # Local Variables:
 193 #   mode: pir
 194 #   fill-column: 100
 195 # End:
 196 # vim: expandtab shiftwidth=4 ft=pir: