t/pmc/ro.t

   1 #! perl
   2 # Copyright (C) 2006-2007, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 17;
  10
  11 =head1 NAME
  12
  13 t/pmc/ro.t -- tests read-only value support
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/ro.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests automatically generated read-only PMC support.
  22
  23 =cut
  24
  25 my $library = <<'CODE';
  26 .sub make_readonly
  27     .param pmc arg
  28     .local pmc one
  29     one = new 'Integer'
  30     one = 1
  31     setprop arg, '_ro', one
  32 .end
  33
  34 .sub make_writable
  35     .param pmc arg
  36     .local pmc zero
  37     zero = new 'Integer'
  38     zero = 0
  39     setprop arg, '_ro', zero
  40 .end
  41 CODE
  42
  43 pir_error_output_unlike( $library . <<'CODE', <<'OUTPUT', "Integer set read-only is not writable" );
  44 .sub main :main
  45     .local pmc foo
  46
  47     foo = new 'Integer'
  48     foo = 42
  49
  50     make_readonly(foo)
  51     foo = 43
  52     print "NOT OKAY"
  53 .end
  54 CODE
  55 /NOT OKAY/
  56 OUTPUT
  57
  58 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer set read-only can be read" );
  59 .sub main :main
  60     .local pmc foo
  61     .local pmc tmp
  62
  63     foo = new 'Integer'
  64     foo = 42
  65
  66     make_readonly(foo)
  67     print foo
  68     print "\n"
  69     $I0 = foo
  70     $S0 = foo
  71     print $I0
  72     print "\n"
  73     print $S0
  74     print "\n"
  75
  76     tmp = new 'Integer'
  77     add tmp, foo, foo
  78     print tmp
  79     print "\n"
  80
  81     $P0 = foo
  82     n_add foo, foo, foo
  83     print foo
  84     print "\n"
  85
  86     print $P0
  87     print "\n"
  88 .end
  89 CODE
  90 42
  91 42
  92 42
  93 84
  94 84
  95 42
  96 OUTPUT
  97
  98 pir_error_output_unlike( <<"CODE", <<'OUTPUT', "PerlInteger" );
  99 $library
 100 .sub main :main
 101     .local pmc foo
 102
 103     foo = new 'PerlInteger'
 104     foo = 42
 105
 106     make_readonly(foo)
 107     foo = 43
 108     print "NOT OKAY"
 109 .end
 110 CODE
 111 /NOT OKAY/
 112 OUTPUT
 113
 114 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer stays Integer" );
 115 .sub main :main
 116     .local pmc foo
 117
 118     foo = new 'Integer'
 119     foo = 42
 120
 121     make_readonly(foo)
 122     typeof $S0, foo
 123     print $S0
 124     print "\n"
 125 .end
 126 CODE
 127 Integer
 128 OUTPUT
 129
 130 pir_error_output_unlike( $library . <<'CODE', <<'OUTPUT', "Integer add" );
 131 .sub main :main
 132     .local pmc foo
 133
 134     foo = new 'Integer'
 135     foo = 42
 136
 137     make_readonly(foo)
 138     add foo, 16, foo
 139     print "NOT OKAY\n"
 140 .end
 141 CODE
 142 /NOT OKAY/
 143 OUTPUT
 144
 145 pir_error_output_unlike( $library . <<'CODE', <<'OUTPUT', "Complex i_add" );
 146 .sub main :main
 147     .local pmc foo
 148
 149     foo = new 'Complex'
 150     foo[0] = 1.0
 151     foo[1] = 1.0
 152     make_readonly(foo)
 153     add foo, foo, 4
 154     print "NOT OKAY\n"
 155 .end
 156 CODE
 157 /NOT OKAY/
 158 OUTPUT
 159
 160 {
 161
 162     # The ROTest dynpmc has opposite of normal logic for set/get integer
 163     # and 'reader' and 'writer' NCI methods.
 164     # The values are [should work with read-only, is todo test].
 165     my %tests = (
 166
 167         # these first two tests would test overriding of the default
 168         # read-onlyness notion of vtable methods
 169         q{value = 42}  => [ 1, 0 ],
 170         q{$I0 = value} => [ 0, 0 ],
 171
 172         # these make sure NCI methods check does-write flags
 173         # 'writer' is marked as writing; 'reader' is not.
 174         q{$I0 = value.'reader'()} => [ 1, 0 ],
 175         q{$I0 = value.'writer'(42)} => [ 0, 0 ],
 176     );
 177     for my $test ( keys %tests ) {
 178         my $code = $library . <<"CODE";
 179 .loadlib 'rotest'
 180 .sub main :main
 181     .local pmc value
 182     value = new 'ROTest'
 183     #READONLYTEST
 184     $test
 185     print "reached end\\n"
 186 .end
 187 CODE
 188         {
 189             my ( $readonly, $todo ) = @{ $tests{$test} };
 190
 191             # first make sure it works without the make_readonly
 192             pir_output_is( $code, "reached end\n", "ROTest (dry run) ($test)" );
 193             local $TODO = $todo;
 194             $code =~ s/#READONLYTEST/make_readonly(value)/;
 195             if ($readonly) {
 196                 pir_output_is( $code, "reached end\n", "ROTest (read-only/okay) ($test)" );
 197             }
 198             else {
 199                 pir_error_output_isnt( $code, "reached end\n", "ROTest (read-only/fail) ($test)" );
 200             }
 201         }
 202     }
 203 }
 204
 205 pir_error_output_unlike(
 206     $library . <<'CODE', <<'OUTPUT', "ResizablePMCArray (non-recursive part)" );
 207 .sub main :main
 208     .local pmc foo
 209     .local pmc three
 210     .local pmc four
 211
 212     foo = new 'ResizablePMCArray'
 213     three = new 'Integer'
 214     three = 3
 215     four = new 'Integer'
 216     four = 4
 217
 218     foo = 3
 219     foo[0] = three
 220     foo[1] = three
 221     foo[2] = three
 222     make_readonly(foo)
 223
 224     foo[0] = four
 225     print "NOT OKAY\n"
 226 .end
 227 CODE
 228 /NOT OKAY/
 229 OUTPUT
 230
 231 pir_error_output_unlike( $library . <<'CODE', <<'OUTPUT', "Objects" );
 232 .sub main :main
 233     .local pmc fooclass
 234     .local pmc foo
 235
 236     $P0 = new 'Integer'
 237     $P0 = 1
 238
 239     fooclass = newclass 'Foo'
 240     addattribute fooclass, 'bar'
 241     foo = new 'Foo'
 242     setattribute foo, 'bar', $P0
 243     make_readonly(foo)
 244     inc $P0
 245     setattribute foo, 'bar', $P0
 246     print "NOT OKAY\n"
 247 .end
 248 CODE
 249 /NOT OKAY/
 250 OUTPUT
 251
 252 # RT#46821: should this work?
 253 {
 254     local $TODO = 1;
 255     pir_output_unlike( $library . <<'CODE', <<'OUTPUT', "ResizablePMCArray -- Recursive" );
 256 .sub main :main
 257     .local pmc foo
 258     .local pmc three
 259     .local pmc tmp
 260
 261     foo = new 'ResizablePMCArray'
 262     three = new 'Integer'
 263     three = 3
 264
 265     foo = 1
 266     foo[0] = three
 267
 268     print "before make_readonly\n"
 269     make_readonly(foo)
 270     print "after\n"
 271
 272     # three = 4 # should fail -- is that what we want
 273     tmp = foo[0]
 274     tmp = 4
 275     print "NOT OKAY\n"
 276     tmp = foo[0]
 277     print tmp
 278 .end
 279 CODE
 280 /NOT OKAY/
 281 OUTPUT
 282 }
 283
 284 # Local Variables:
 285 #   mode: cperl
 286 #   cperl-indent-level: 4
 287 #   fill-column: 100
 288 # End:
 289 # vim: expandtab shiftwidth=4: