t/dynpmc/rotest.t

   1 #! perl
   2 # Copyright (C) 2006-2007, Parrot 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 => 8;
  10
  11 =head1 NAME
  12
  13 t/dynpmc/rotest.t -- tests read-only value support through the ROTest dynpmc
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/dynpmc/rotest.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests automatically generated read-only PMC support.
  22
  23 =cut
  24
  25 my $library = <<'CODE';
  26 .include "except_types.pasm"
  27 .sub make_readonly
  28     .param pmc arg
  29     .local pmc one
  30     one = new 'Integer'
  31     one = 1
  32     setprop arg, '_ro', one
  33 .end
  34
  35 .sub make_writable
  36     .param pmc arg
  37     .local pmc zero
  38     zero = new 'Integer'
  39     zero = 0
  40     setprop arg, '_ro', zero
  41 .end
  42 CODE
  43
  44 {
  45
  46     # The ROTest dynpmc has opposite of normal logic for set/get integer
  47     # and 'reader' and 'writer' NCI methods.
  48     # The values are [should work with read-only, is todo test].
  49     my %tests = (
  50
  51         # these first two tests would test overriding of the default
  52         # read-onlyness notion of vtables
  53         q{value = 42}  => [ 1, 0 ],
  54         q{$I0 = value} => [ 0, 0 ],
  55
  56         # these make sure NCI methods check does-write flags
  57         # 'writer' is marked as writing; 'reader' is not.
  58         q{$I0 = value.'reader'()} => [ 1, 0 ],
  59         q{$I0 = value.'writer'(42)} => [ 0, 0 ],
  60     );
  61     for my $test ( keys %tests ) {
  62         my $code = $library . <<"CODE";
  63 .loadlib 'rotest'
  64 .sub main :main
  65     .local pmc value, eh
  66     value = new 'ROTest'
  67     eh = new 'ExceptionHandler'
  68     eh.'handle_types'(.EXCEPTION_WRITE_TO_CONSTCLASS, .EXCEPTION_METHOD_NOT_FOUND)
  69     set_addr eh, eh_label
  70
  71     #READONLYTEST
  72     push_eh eh
  73     $test
  74     pop_eh
  75     say "reached end"
  76     end
  77
  78 eh_label:
  79     .get_results(\$P0)
  80     say "RO or method not found exception caught"
  81     end
  82 .end
  83 CODE
  84         {
  85             my ( $readonly, $todo ) = @{ $tests{$test} };
  86
  87             # first make sure it works without the make_readonly
  88             pir_output_is( $code, "reached end\n", "ROTest (dry run) ($test)" );
  89             local $TODO = $todo;
  90             $code =~ s/#READONLYTEST/make_readonly(value)/;
  91             if ($readonly) {
  92                 pir_output_is( $code, "reached end\n", "ROTest (read-only/okay) ($test)" );
  93             }
  94             else {
  95                 pir_output_is( $code, "RO or method not found exception caught\n", "ROTest (read-only/fail) ($test)" );
  96             }
  97         }
  98     }
  99 }
 100
 101 # Local Variables:
 102 #   mode: cperl
 103 #   cperl-indent-level: 4
 104 #   fill-column: 100
 105 # End:
 106 # vim: expandtab shiftwidth=4: