t/pmc/ro.t

   1 #!./parrot
   2 # Copyright (C) 2006-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/ro.t -- tests read-only value support
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/ro.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests automatically generated read-only PMC support.
  16
  17 =cut
  18
  19 .namespace []
  20
  21 .include "except_types.pasm"
  22
  23 .sub make_readonly
  24     .param pmc arg
  25     .local pmc one
  26     one = new ['Integer']
  27     one = 1
  28     setprop arg, '_ro', one
  29 .end
  30
  31 .sub make_writable
  32     .param pmc arg
  33     .local pmc zero
  34     zero = new ['Integer']
  35     zero = 0
  36     setprop arg, '_ro', zero
  37 .end
  38
  39 .sub main :main
  40     .include 'test_more.pir'
  41
  42     plan(13)
  43
  44     integer_set_read_only_is_not_writable() # 1 test
  45     integer_set_read_only_can_be_read()     # 6 tests
  46     integer_stays_integer()                 # 1 test
  47     integer_add()                           # 1 test
  48     complex_i_add()                         # 1 test
  49     resizablepmcarray_non_recursive_part()  # 1 test
  50     objects()                               # 1 test
  51     resizablepmcarray_recursive()           # 1 test
  52 .end
  53
  54 .sub integer_set_read_only_is_not_writable
  55     .local pmc foo, eh
  56
  57     foo = new ['Integer']
  58     foo = 42
  59
  60     eh = new ['ExceptionHandler']
  61     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS)
  62     set_addr eh, eh_label
  63
  64     make_readonly(foo)
  65     push_eh eh
  66     foo = 43
  67     pop_eh
  68     ok( 0, "integer_set_read_only_is_not_writable" )
  69     goto end
  70
  71   eh_label:
  72     .local string message
  73     .get_results($P0)
  74     message = $P0['message']
  75     is( message, "set_integer_native() in read-only instance of 'Integer'", "integer_set_read_only_is_not_writable" )
  76   end:
  77 .end
  78
  79 .sub integer_set_read_only_can_be_read
  80     .local pmc foo
  81     .local pmc tmp
  82
  83     foo = new ['Integer']
  84     foo = 42
  85
  86     make_readonly(foo)
  87     is(foo, 42, 'foo initialised to 42 is readable after make_readonly')
  88     $I0 = foo
  89     is($I0, 42, 'foo copied to int correctly')
  90     $S0 = foo
  91     is($S0, 42, 'foo copied to string correctly')
  92
  93     tmp = new ['Integer']
  94     add tmp, foo, foo
  95     is(tmp, 84, 'foo can be added to foo correctly and stored elsewhere')
  96
  97     $P0 = foo
  98     add foo, foo, foo
  99     is(foo, 84, 'foo can be added to foo correctly and stored to foo')
 100
 101     is($P0, 42, 'copied foo retains its value')
 102 .end
 103
 104 .sub integer_stays_integer
 105     .local pmc foo
 106
 107     foo = new ['Integer']
 108     foo = 42
 109
 110     make_readonly(foo)
 111     typeof $S0, foo
 112     is($S0, 'Integer', 'integer_stays_integer')
 113 .end
 114
 115 .sub integer_add
 116     .local pmc foo, eh
 117
 118     foo = new ['Integer']
 119     foo = 42
 120
 121     eh = new ['ExceptionHandler']
 122     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS)
 123     set_addr eh, eh_label
 124
 125     make_readonly(foo)
 126     push_eh eh
 127     foo += 16
 128     pop_eh
 129
 130     ok(0, 'integer_add')
 131     goto end
 132
 133   eh_label:
 134     .local string message
 135     .get_results($P0)
 136     message = $P0['message']
 137     is( message, "i_add_int() in read-only instance of 'Integer'", 'integer_add' )
 138   end:
 139 .end
 140
 141 .sub complex_i_add
 142     .local pmc foo, eh
 143
 144     foo = new ['Complex']
 145     foo[0] = 1.0
 146     foo[1] = 1.0
 147
 148     eh = new ['ExceptionHandler']
 149     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS)
 150     set_addr eh, eh_label
 151
 152     make_readonly(foo)
 153     push_eh eh
 154     add foo, 4
 155     pop_eh
 156     ok( 0, 'complex_i_add')
 157     goto end
 158
 159   eh_label:
 160     .local string message
 161     .get_results($P0)
 162     message = $P0['message']
 163     is( message, "i_add_int() in read-only instance of 'Complex'", 'complex_i_add' )
 164   end:
 165 .end
 166
 167 .sub resizablepmcarray_non_recursive_part
 168     .local pmc foo, three, four, eh
 169
 170     foo = new ['ResizablePMCArray']
 171     three = new ['Integer']
 172     three = 3
 173     four = new ['Integer']
 174     four = 4
 175
 176     eh = new ['ExceptionHandler']
 177     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS)
 178     set_addr eh, eh_label
 179
 180     foo = 3
 181     foo[0] = three
 182     foo[1] = three
 183     foo[2] = three
 184     make_readonly(foo)
 185
 186     push_eh eh
 187     foo[0] = four
 188     pop_eh
 189
 190     ok(0, 'resizablepmcarray_non_recursive_part')
 191     goto end
 192
 193   eh_label:
 194     .local string message
 195     .get_results($P0)
 196     message = $P0['message']
 197     is( message, "set_pmc_keyed_int() in read-only instance of 'ResizablePMCArray'", 'resizablepmcarray_non_recursive_part' )
 198   end:
 199 .end
 200
 201 .sub objects
 202     .local pmc fooclass, foo, eh, i
 203
 204     i = new ['Integer']
 205     i = 1
 206
 207     eh = new ['ExceptionHandler']
 208     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS)
 209     set_addr eh, eh_label
 210
 211     fooclass = newclass 'Foo'
 212     addattribute fooclass, 'bar'
 213     foo = new ['Foo']
 214     setattribute foo, 'bar', i
 215     make_readonly(foo)
 216     inc i
 217
 218     push_eh eh
 219     setattribute foo, 'bar', i
 220     pop_eh
 221
 222     ok( 0, 'objects')
 223     goto end
 224
 225   eh_label:
 226     .local string message
 227     .get_results($P0)
 228     message = $P0['message']
 229     is( message, "set_attr_str() in read-only instance of 'Foo'", 'objects' )
 230   end:
 231 .end
 232
 233 .sub resizablepmcarray_recursive
 234     .local pmc foo
 235     .local pmc three
 236     .local pmc four
 237
 238     foo = new ['ResizablePMCArray']
 239     three = new ['Integer']
 240     three = 3
 241
 242     foo = 1
 243     foo[0] = three
 244
 245     make_readonly(foo)
 246
 247     four = foo[0]
 248     four = 4
 249     four = foo[0]
 250     is(four, 4, 'TT #1036 - readonly should be shallow')
 251 .end
 252
 253
 254
 255 # Local Variables:
 256 #   mode: pir
 257 #   fill-column: 100
 258 # End:
 259 # vim: expandtab shiftwidth=4 ft=pir: