Ticket #801: capture.t_to_pir.patch

File capture.t_to_pir.patch, 8.3 KB (added by flh, 5 years ago)

Rewrite capture.t

  • t/pmc/capture.t

     
    1 #!perl 
     1#! parrot 
    22# Copyright (C) 2001-2008, Parrot Foundation. 
    33# $Id$ 
    44 
    5 use strict; 
    6 use warnings; 
    7 use lib qw( . lib ../lib ../../lib ); 
    8  
    9 use Test::More; 
    10 use Parrot::Test tests => 8; 
    11  
    125=head1 NAME 
    136 
    147t/pmc/capture.t - Test the Capture PMC 
     
    2417 
    2518=cut 
    2619 
    27 my $PRE = <<PRE; 
     20.const int TESTS = 47 
     21 
    2822.sub 'test' :main 
    29     .local pmc capt 
    30     capt = new ['Capture'] 
    31 PRE 
     23    .include 'test_more.pir' 
    3224 
    33 my $POST = <<POST; 
    34     goto end 
    35   nok: 
    36     print 'not ' 
    37   ok: 
    38     say 'ok' 
    39   end: 
     25    plan(TESTS) 
     26 
     27    test_new_capture() 
     28    basic_capture_tests() 
     29    test_defined_delete_exists() 
     30    test_hash_list() 
     31    test_get_integer() 
     32    test_get_number() 
     33    test_keyed_int_delegation() 
     34    test_list_delegation() 
    4035.end 
    41 POST 
    4236 
    43 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', 'new' ); 
    44 CODE 
    45 OUT 
     37.sub 'test_new_capture' 
     38    .local pmc capt 
    4639 
    47 pir_output_is( <<'CODE', <<'OUTPUT', "Basic capture tests" ); 
    48 .sub main :main 
     40    capt = new ['Capture'] 
     41    ok(1, 'new Capture') 
     42.end 
     43 
     44.sub 'basic_capture_tests' 
    4945    .local pmc capt 
     46 
    5047    capt = new ['Capture'] 
    5148 
    5249    capt[0] = 0 
     
    7875    capt['delta'] = $P0 
    7976 
    8077    $I0 = elements capt 
    81     print $I0 
    82     print "\n" 
     78    is($I0, 12, 'elements') 
    8379 
    8480    $I0 = capt[11] 
    85     print $I0 
    86     print " " 
     81    is($I0, 7, 'get_integer_keyed_int') 
     82     
    8783    $P0 = capt[10] 
    88     print $P0 
    89     print " " 
     84    is($P0, 'six', 'get_pmc_keyed_int') 
     85 
    9086    $N0 = capt[9] 
    91     print $N0 
    92     print " " 
     87    is($N0, 5.5, 'get_number_keyed_int') 
     88 
    9389    $S0 = capt[8] 
    94     say $S0 
     90    is($S0, '4', 'get_string_keyed_int') 
    9591 
    9692    $I0 = pop capt 
    97     print $I0 
    98     print " " 
     93    is($I0, 7, 'pop an integer') 
     94 
    9995    $P0 = pop capt 
    100     print $P0 
    101     print " " 
     96    is($P0, 'six', 'pop a PMC') 
     97 
    10298    $N0 = pop capt 
    103     print $N0 
    104     print " " 
     99    is($N0, 5.5, 'pop a number') 
     100 
    105101    $S0 = pop capt 
    106     say $S0 
     102    is($S0, '4', 'pop a string') 
    107103 
    108104    $I0 = elements capt 
    109     print $I0 
    110     print "\n" 
     105    is($I0, 8, 'elements after pop') 
    111106 
    112107    $I0 = shift capt 
    113     print $I0 
    114     print " " 
     108    is($I0, 11, 'shift an integer') 
     109     
    115110    $P0 = shift capt 
    116     print $P0 
    117     print " " 
     111    is($P0, 'ten', 'shift a PMC') 
     112     
    118113    $N0 = shift capt 
    119     print $N0 
    120     print " " 
     114    is($N0, 9.5, 'shift a number') 
     115     
    121116    $S0 = shift capt 
    122     say $S0 
     117    is($S0, '8', 'shift a string') 
    123118 
    124119    $I0 = elements capt 
    125     print $I0 
    126     print "\n" 
     120    is($I0, 4, 'elements after shift') 
    127121 
    128   loop: 
    129     $I0 = elements capt 
    130     if $I0 < 1 goto end 
    131122    $P0 = pop capt 
    132     say $P0 
    133     goto loop 
    134   end: 
     123    is($P0, 3, 'pop 1 out of 4') 
    135124 
     125    $P0 = pop capt 
     126    is($P0, 'two', 'pop 2 out of 4') 
     127 
     128    $P0 = pop capt 
     129    is($P0, 1.5, 'pop 3 out of 4') 
     130 
     131    $P0 = pop capt 
     132    is($P0, 0, 'pop 4 out of 4') 
     133 
    136134    $I0 = capt['delta'] 
    137     print $I0 
    138     print " " 
     135    is($I0, 15, 'get_integer_keyed_str') 
     136 
    139137    $P0 = capt['gamma'] 
    140     print $P0 
    141     print " " 
     138    is($P0, 'fourteen', 'get_pmc_keyed_str') 
     139     
    142140    $N0 = capt['beta'] 
    143     print $N0 
    144     print " " 
    145     $S0 = capt['alpha'] 
    146     say $S0 
     141    is($N0, 13.5, 'get_number_keyed_str') 
    147142 
     143    $S0 = capt['alpha'] 
     144    is($S0, '12', 'get_string_keyed_str') 
    148145.end 
    149146 
    150 CODE 
    151 12 
    152 7 six 5.5 4 
    153 7 six 5.5 4 
    154 8 
    155 11 ten 9.5 8 
    156 4 
    157 3 
    158 two 
    159 1.5 
    160 0 
    161 15 fourteen 13.5 12 
    162 OUTPUT 
    163  
    164 pir_output_is( <<'CODE', <<'OUTPUT', "defined, delete, exists" ); 
    165 .sub main :main 
     147.sub 'test_defined_delete_exists' 
    166148    .local pmc capt 
    167149    capt = new ['Capture'] 
    168150 
    169151    $I0 = defined capt[2] 
     152    nok($I0, 'defined_i initially false') 
     153 
    170154    $I1 = exists capt[2] 
    171     print $I0 
    172     print " " 
    173     print $I1 
    174     print "\n" 
     155    nok($I1, 'exists_i initially false') 
    175156 
    176157    $I0 = defined capt['alpha'] 
     158    nok($I0, 'defined_s initially false') 
     159 
    177160    $I1 = exists capt['alpha'] 
    178     print $I0 
    179     print " " 
    180     print $I1 
    181     print "\n" 
     161    nok($I1, 'exists_s initially false') 
    182162 
    183163    capt[2] = 1 
    184164    capt['alpha'] = 1 
     
    186166    capt['beta'] = $P0 
    187167 
    188168    $I0 = defined capt[2] 
     169    ok($I0, 'defined_i true after set') 
     170 
    189171    $I1 = exists capt[2] 
    190     print $I0 
    191     print " " 
    192     print $I1 
    193     print "\n" 
     172    ok($I1, 'exists_i true after set') 
    194173 
    195174    $I0 = defined capt['alpha'] 
     175    ok($I0, 'defined_s true after set') 
     176 
    196177    $I1 = exists capt['alpha'] 
    197     print $I0 
    198     print " " 
    199     print $I1 
    200     print "\n" 
     178    ok($I1, 'exists_s true after set') 
    201179 
    202180    $I0 = defined capt[1] 
     181    nok($I0, 'defined_i - no intermediate element created') 
     182 
    203183    $I1 = exists capt[1] 
    204     print $I0 
    205     print " " 
    206     print $I1 
    207     print "\n" 
     184    nok($I1, 'exists_i - no intermediate element created') 
    208185 
    209186    $I0 = defined capt['beta'] 
     187    nok($I0, 'defined_s checks for Undef values...') 
     188 
    210189    $I1 = exists capt['beta'] 
    211     print $I0 
    212     print " " 
    213     print $I1 
    214     print "\n" 
     190    ok($I1, 'but exists_s does not care') 
    215191 
    216192    delete capt[2] 
    217193    delete capt['alpha'] 
    218194 
    219195    $I0 = defined capt[2] 
     196    nok($I0, 'defined_i false after delete') 
    220197    $I1 = exists capt[2] 
    221     print $I0 
    222     print " " 
    223     print $I1 
    224     print "\n" 
     198    nok($I1, 'exists_i false after delete') 
    225199 
    226200    $I0 = defined capt['alpha'] 
     201    nok($I0, 'defined_s false after delete') 
    227202    $I1 = exists capt['alpha'] 
    228     print $I0 
    229     print " " 
    230     print $I1 
    231     print "\n" 
     203    nok($I1, 'exists_s false after delete') 
     204.end 
    232205 
     206.sub 'test_hash_list' 
     207    .local pmc capt 
    233208 
    234 .end 
    235 CODE 
    236 0 0 
    237 0 0 
    238 1 1 
    239 1 1 
    240 0 0 
    241 0 1 
    242 0 0 
    243 0 0 
    244 OUTPUT 
     209    capt = new ['Capture'] 
    245210 
    246 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUTPUT', "hash, list" ); 
    247211    $P0 = capt.'list'() 
    248212    $P1 = capt.'hash'() 
    249213 
    250     $S0 = typeof $P0 
    251     $S1 = typeof $P1 
     214    isa_ok($P0, 'ResizablePMCArray', "capt.'list'") 
     215    isa_ok($P1, 'Hash', "capt.'hash'") 
     216.end 
    252217 
    253     say $S0 
    254     say $S1 
    255 CODE 
    256 ResizablePMCArray 
    257 Hash 
    258 OUTPUT 
     218.sub 'test_get_integer' 
     219    .local pmc capt 
    259220 
    260 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_integer not implemented' ); 
     221    capt = new ['Capture'] 
     222    push_eh test_get_integer_catch 
    261223    $I0 = capt 
    262 CODE 
    263 /get_integer\(\) not implemented in class 'Capture'/ 
    264 OUT 
    265224 
    266 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_number not implemented' ); 
     225    nok(1, 'get_integer not implemented') 
     226    .return () 
     227 
     228  test_get_integer_catch: 
     229    .local pmc exception 
     230    .local string message 
     231    .get_results (exception) 
     232 
     233    message = exception['message'] 
     234    like(message, ':s get_integer\(\) not implemented', 'get_integer not implemented') 
     235    .return () 
     236.end 
     237 
     238.sub 'test_get_number' 
     239    .local pmc capt 
     240 
     241    capt = new ['Capture'] 
     242    push_eh test_get_number_catch 
    267243    $N0 = capt 
    268 CODE 
    269 /get_number\(\) not implemented in class 'Capture'/ 
    270 OUT 
    271244 
    272 pir_output_is( <<'CODE', <<'OUTPUT', '*_keyed_int delegation' ); 
    273 .sub main :main 
    274     $P99 = subclass 'Capture', 'Match' 
     245    nok(1, 'get_number not implemented') 
     246    .return () 
     247 
     248  test_get_number_catch: 
     249    .local pmc exception 
     250    .local string message 
     251    .get_results (exception) 
     252 
     253    message = exception['message'] 
     254    like(message, ':s get_number\(\) not implemented', 'get_number not implemented') 
     255    .return () 
     256.end 
     257 
     258 
     259.sub 'test_keyed_int_delegation' 
     260    $P99 = subclass ['Capture'], ['Match'] 
    275261    $P1 = new ['Match'] 
    276262    $P1[1] = 1 
    277263    $I1 = elements $P1 
    278     print $I1 
    279     print "\n" 
     264    is($I1, 2, 'elements - delegated to parent class') 
    280265 
    281     $P99 = subclass 'Match', 'Exp' 
     266    $P99 = subclass ['Match'], ['Exp'] 
    282267    $P2 = new ['Exp'] 
    283268    $P2[1] = 1 
    284269    $I2 = elements $P2 
    285     print $I2 
    286     print "\n" 
    287  
     270    is($I2, 2, 'elements - delegated twice') 
    288271.end 
    289 CODE 
    290 2 
    291 2 
    292 OUTPUT 
    293272 
    294 pir_output_is( <<'CODE', <<'OUTPUT', 'list method delegation' ); 
    295 .sub main :main 
    296     $P0 = subclass 'Capture', 'Match' 
     273.sub 'test_list_delegation' 
     274    $P0 = subclass ['Capture'], ['Match2'] 
    297275    addattribute $P0, '$.abc' 
    298276    addattribute $P0, '$.xyz' 
    299     $P1 = new ['Match'] 
     277    $P1 = new ['Match2'] 
    300278    $P1[1] = 1 
    301279 
    302280    $P2 = new ['String'] 
     
    307285    $P2 = $P1.'list'() 
    308286    $P2 = 0 
    309287    $I0 = elements $P2 
    310     print $I0 
    311     print "\n" 
     288    is($I0, 0, 'list method delegation') 
    312289.end 
    313 CODE 
    314 0 
    315 OUTPUT 
    316290 
    317291# Local Variables: 
    318 #   mode: cperl 
    319 #   cperl-indent-level: 4 
     292#   mode: pir 
    320293#   fill-column: 100 
    321294# End: 
    322 # vim: expandtab shiftwidth=4: 
     295# vim: expandtab shiftwidth=4 ft=pir: