Ticket #658: ro.t.patch

File ro.t.patch, 5.8 KB (added by bobw, 4 years ago)

A patch file to convery from Perl to PIR

  • ro.t

     
    1 #! perl 
    2 # Copyright (C) 2006-2007, Parrot Foundation. 
     1#! parrot 
     2# Copyright (C) 2006-2009, The Perl Foundation. 
    33# $Id$ 
    44 
    5 use strict; 
    6 use warnings; 
    7 use lib qw( . lib ../lib ../../lib ); 
    8 use Test::More; 
    9 use Parrot::Test tests => 8; 
    10  
    115=head1 NAME 
    126 
    137t/pmc/ro.t -- tests read-only value support 
    … …  
    2216 
    2317=cut 
    2418 
    25 my $library = <<'CODE'; 
     19.HLL "perl6" 
     20 
     21.namespace [] 
     22 
    2623.include "except_types.pasm" 
    2724.sub make_readonly 
    2825    .param pmc arg 
    … …  
    3936    zero = 0 
    4037    setprop arg, '_ro', zero 
    4138.end 
    42 CODE 
    4339 
    44 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer set read-only is not writable" ); 
    4540.sub main :main 
     41    .include 'include/test_more.pir' 
     42 
     43    plan(12) 
     44 
     45    integer_set_read_only_is_not_writable() # 1 test 
     46    integer_set_read_only_can_be_read()     # 6 tests 
     47    integer_stays_integer()                 # 1 test 
     48    integer_add()                           # 1 test 
     49    complex_i_add()                         # 1 test 
     50    resizablepmcarray_non_recursive_part()  # 1 test 
     51    objects()                               # 1 test 
     52#    resizablepmcarray_recursive()           # 
     53.end 
     54 
     55.sub integer_set_read_only_is_not_writable 
    4656    .local pmc foo, eh 
    4757 
    4858    foo = new ['Integer'] 
    … …  
    5666    push_eh eh 
    5767    foo = 43 
    5868    pop_eh 
    59     print "no exception caught" 
     69    ok( 0, "integer_set_read_only_is_not_writable" ) 
    6070    end 
    6171 
    6272eh_label: 
     73    .local string message 
    6374    .get_results($P0) 
    64     say "RO exception caught" 
    65     end 
     75    message = $P0['message'] 
     76    is( message, "set_integer_native() in read-only instance of 'Integer'", "integer_set_read_only_is_not_writable" ) 
    6677.end 
    67 CODE 
    68 RO exception caught 
    69 OUTPUT 
    7078 
    71 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer set read-only can be read" ); 
    72 .sub main :main 
     79.sub integer_set_read_only_can_be_read 
    7380    .local pmc foo 
    7481    .local pmc tmp 
    7582 
    … …  
    7784    foo = 42 
    7885 
    7986    make_readonly(foo) 
    80     print foo 
    81     print "\n" 
     87    is(foo, 42, 'foo initialised to 42 is readable after make_readonly') 
    8288    $I0 = foo 
     89    is($I0, 42, 'foo copied to int correctly') 
    8390    $S0 = foo 
    84     print $I0 
    85     print "\n" 
    86     print $S0 
    87     print "\n" 
     91    is($S0, 42, 'foo copied to string correctly') 
    8892 
    8993    tmp = new ['Integer'] 
    9094    add tmp, foo, foo 
    91     print tmp 
    92     print "\n" 
     95    is(tmp, 84, 'foo can be added to foo correctly and stored elsewhere') 
    9396 
    9497    $P0 = foo 
    9598    add foo, foo, foo 
    96     print foo 
    97     print "\n" 
     99    is(foo, 84, 'foo can be added to foo correctly and stored to foo') 
    98100 
    99     print $P0 
    100     print "\n" 
     101    is($P0, 42, 'copied foo retains its value') 
    101102.end 
    102 CODE 
    103 42 
    104 42 
    105 42 
    106 84 
    107 84 
    108 42 
    109 OUTPUT 
    110103 
    111 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer stays Integer" ); 
    112 .sub main :main 
     104.sub integer_stays_integer 
    113105    .local pmc foo 
    114106 
    115107    foo = new ['Integer'] 
    … …  
    117109 
    118110    make_readonly(foo) 
    119111    typeof $S0, foo 
    120     say $S0 
     112    is($S0, 'Integer', 'integer_stays_integer') 
    121113.end 
    122 CODE 
    123 Integer 
    124 OUTPUT 
    125114 
    126 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Integer add" ); 
    127 .sub main :main 
     115.sub integer_add 
    128116    .local pmc foo, eh 
    129117 
    130118    foo = new ['Integer'] 
    … …  
    139127    foo += 16 
    140128    pop_eh 
    141129 
    142     say "no exception caught" 
    143     end 
     130    ok(0, 'integer_add') 
    144131 
    145132eh_label: 
     133    .local string message 
    146134    .get_results($P0) 
    147     say "RO exception caught" 
    148     end 
     135    message = $P0['message'] 
     136    is( message, "i_add_int() in read-only instance of 'Integer'", 'integer_add' ) 
    149137.end 
    150 CODE 
    151 RO exception caught 
    152 OUTPUT 
    153138 
    154 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Complex i_add" ); 
    155 .sub main :main 
     139.sub complex_i_add 
    156140    .local pmc foo, eh 
    157141 
    158142    foo = new ['Complex'] 
    … …  
    167151    push_eh eh 
    168152    add foo, 4 
    169153    pop_eh 
    170     say "no exception caught" 
    171     end 
     154    ok( 0, 'complex_i_add') 
    172155 
    173156eh_label: 
     157    .local string message 
    174158    .get_results($P0) 
    175     say "RO exception caught" 
    176     end 
     159    message = $P0['message'] 
     160    is( message, "i_add_int() in read-only instance of 'Complex'", 'complex_i_add' ) 
     161 
    177162.end 
    178 CODE 
    179 RO exception caught 
    180 OUTPUT 
    181163 
    182 pir_output_is( $library . <<'CODE', <<'OUTPUT', "ResizablePMCArray (non-recursive part)" ); 
    183 .sub main :main 
     164.sub resizablepmcarray_non_recursive_part 
    184165    .local pmc foo, three, four, eh 
    185166 
    186167    foo = new ['ResizablePMCArray'] 
    … …  
    202183    push_eh eh 
    203184    foo[0] = four 
    204185    pop_eh 
    205     say "no exception caught" 
    206     end 
    207186 
     187    ok(0, 'resizablepmcarray_non_recursive_part') 
     188 
    208189eh_label: 
     190    .local string message 
    209191    .get_results($P0) 
    210     say "RO exception caught" 
    211     end 
     192    message = $P0['message'] 
     193    is( message, "set_pmc_keyed_int() in read-only instance of 'ResizablePMCArray'", 'resizablepmcarray_non_recursive_part' ) 
    212194.end 
    213 CODE 
    214 RO exception caught 
    215 OUTPUT 
    216195 
    217 pir_output_is( $library . <<'CODE', <<'OUTPUT', "Objects" ); 
    218 .sub main :main 
     196.sub objects 
    219197    .local pmc fooclass, foo, eh, i 
    220198 
    221199    i = new ['Integer'] 
    … …  
    237215    setattribute foo, 'bar', i 
    238216    pop_eh 
    239217 
    240     say "no exception caught" 
    241     end 
     218    ok( 0, 'objects') 
    242219 
    243220eh_label: 
     221    .local string message 
    244222    .get_results($P0) 
    245     say "RO exception caught" 
    246     end 
     223    message = $P0['message'] 
     224    is( message, "set_attr_str() in read-only instance of 'Foo'", 'objects' ) 
    247225.end 
    248 CODE 
    249 RO exception caught 
    250 OUTPUT 
    251226 
    252 # RT #46821: should this work? 
    253 { 
    254     local $TODO = 1; 
    255     pir_output_unlike( $library . <<'CODE', <<'OUTPUT', "ResizablePMCArray -- Recursive" ); 
    256 .sub main :main 
     227=pod 
     228 
     229.sub resizablepmcarray_recursive 
    257230    .local pmc foo 
    258231    .local pmc three 
    259232    .local pmc tmp 
    … …  
    276249    tmp = foo[0] 
    277250    print tmp 
    278251.end 
    279 CODE 
    280 /NOT OKAY/ 
    281 OUTPUT 
    282 } 
    283252 
    284 # Local Variables: 
    285 #   mode: cperl 
    286 #   cperl-indent-level: 4 
    287 #   fill-column: 100 
    288 # End: 
    289 # vim: expandtab shiftwidth=4: 
     253=cut