Ticket #722: capture.t.patch

File capture.t.patch, 12.5 KB (added by bobw, 13 years ago)

  • 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; 
    28 .sub 'test' :main 
    29     .local pmc capt 
    30     capt = new ['Capture'] 
    31 PRE 
     20.namespace [] 
    3221 
    33 my $POST = <<POST; 
     22.include "except_types.pasm" 
     23 
     24.sub main :main 
     25    .include 'test_more.pir' 
     26 
     27    plan(47) 
     28 
     29    new_test() # 1 test 
     30    basic_capture_tests() # 23 tests 
     31    defined_delete_exists() # 16 tests 
     32    hash_list() # 2 tests 
     33    get_integer_not_implemented() # 1 test 
     34    get_number_not_implemented() # 1 test 
     35    keyed_int_delegation() # 2 tests 
     36    list_method_delegation() # 1 test 
     37.end 
     38 
     39.sub new_test 
     40    .local pmc capt, eh 
     41 
     42    eh = new ['ExceptionHandler'] 
     43#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 
     44    set_addr eh, eh_label 
     45 
     46    push_eh eh 
     47      capt = new ['Capture'] 
     48    pop_eh 
     49 
     50    ok(1, 'new works correctly') 
    3451    goto end 
    35   nok: 
    36     print 'not ' 
    37   ok: 
    38     say 'ok' 
    39   end: 
     52 
     53eh_label: 
     54    ok(0, 'new does not work correctly') 
     55 
     56end: 
    4057.end 
    41 POST 
    4258 
    43 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUT', 'new' ); 
    44 CODE 
    45 OUT 
     59.sub basic_capture_tests 
     60    .local pmc capt, intpmc, pval 
     61    .local int ival 
     62    .local num nval 
     63    .local string sval 
    4664 
    47 pir_output_is( <<'CODE', <<'OUTPUT', "Basic capture tests" ); 
    48 .sub main :main 
    49     .local pmc capt 
    5065    capt = new ['Capture'] 
    5166 
    5267    capt[0] = 0 
    5368    capt[1] = 1.5 
    5469    capt[2] = 'two' 
    55     $P0 = new ['Integer'] 
    56     $P0 = 3 
    57     capt[3] = $P0 
     70    intpmc = new ['Integer'] 
     71    intpmc = 3 
     72    capt[3] = intpmc 
    5873 
    5974    push capt, 4 
    6075    push capt, 5.5 
    6176    push capt, 'six' 
    62     $P0 = new ['Integer'] 
    63     $P0 = 7 
    64     push capt, $P0 
     77    intpmc = new ['Integer'] 
     78    intpmc = 7 
     79    push capt, intpmc 
    6580 
    6681    unshift capt, 8 
    6782    unshift capt, 9.5 
    6883    unshift capt, 'ten' 
    69     $P0 = new ['Integer'] 
    70     $P0 = 11 
    71     unshift capt, $P0 
     84    intpmc = new ['Integer'] 
     85    intpmc = 11 
     86    unshift capt, intpmc 
    7287 
    7388    capt['alpha'] = 12 
    7489    capt['beta'] = 13.5 
    7590    capt['gamma'] = 'fourteen' 
    76     $P0 = new ['Integer'] 
    77     $P0 = 15 
    78     capt['delta'] = $P0 
     91    intpmc = new ['Integer'] 
     92    intpmc = 15 
     93    capt['delta'] = intpmc 
    7994 
    80     $I0 = elements capt 
    81     print $I0 
    82     print "\n" 
     95    ival = elements capt 
     96    is(ival, 12, '12 elements count of capture correctly') 
    8397 
    84     $I0 = capt[11] 
    85     print $I0 
    86     print " " 
    87     $P0 = capt[10] 
    88     print $P0 
    89     print " " 
    90     $N0 = capt[9] 
    91     print $N0 
    92     print " " 
    93     $S0 = capt[8] 
    94     say $S0 
     98    ival = capt[11] 
     99    is(ival, 7, 'element 11 of capture is correct') 
    95100 
    96     $I0 = pop capt 
    97     print $I0 
    98     print " " 
    99     $P0 = pop capt 
    100     print $P0 
    101     print " " 
    102     $N0 = pop capt 
    103     print $N0 
    104     print " " 
    105     $S0 = pop capt 
    106     say $S0 
     101    pval = capt[10] 
     102    is(pval, 'six', 'element 10 of capture is correct') 
    107103 
    108     $I0 = elements capt 
    109     print $I0 
    110     print "\n" 
     104    nval = capt[9] 
     105    is(nval, '5.5', 'element 9 of capture is correct') 
    111106 
    112     $I0 = shift capt 
    113     print $I0 
    114     print " " 
    115     $P0 = shift capt 
    116     print $P0 
    117     print " " 
    118     $N0 = shift capt 
    119     print $N0 
    120     print " " 
    121     $S0 = shift capt 
    122     say $S0 
     107    sval = capt[8] 
     108    is(sval, '4', 'element 8 of capture is correct') 
    123109 
    124     $I0 = elements capt 
    125     print $I0 
    126     print "\n" 
     110    ival = pop capt 
     111    is(ival, 7, 'first popped element of capture is correct') 
    127112 
    128   loop: 
    129     $I0 = elements capt 
    130     if $I0 < 1 goto end 
    131     $P0 = pop capt 
    132     say $P0 
    133     goto loop 
    134   end: 
     113    pval = pop capt 
     114    is(pval, 'six', 'second popped element of capture is correct') 
    135115 
    136     $I0 = capt['delta'] 
    137     print $I0 
    138     print " " 
    139     $P0 = capt['gamma'] 
    140     print $P0 
    141     print " " 
    142     $N0 = capt['beta'] 
    143     print $N0 
    144     print " " 
    145     $S0 = capt['alpha'] 
    146     say $S0 
     116    nval = pop capt 
     117    is(nval, '5.5', 'third popped element of capture is correct') 
    147118 
     119    sval = pop capt 
     120    is(sval, '4', 'fourth popped element of capture is correct') 
     121 
     122    ival = elements capt 
     123    is(ival, 8, 'number of element after 4 pops is correct') 
     124 
     125    ival = shift capt 
     126    is(ival, 11, 'first shifted element of is correct') 
     127 
     128    pval = shift capt 
     129    is(pval, 'ten', 'second shifted element of capture is correct') 
     130 
     131    nval = shift capt 
     132    is(nval, '9.5', 'third shifted element of capture is correct') 
     133 
     134    sval = shift capt 
     135    is(sval, '8', 'fourth shifted element of capture is correct') 
     136 
     137    ival = elements capt 
     138    is(ival, 4, 'number of element after 4 shifts is correct') 
     139 
     140    pval = pop capt 
     141    is(pval, 3, 'first popped element of capture is correct') 
     142 
     143    pval = pop capt 
     144    is(pval, 'two', 'second popped element of capture is correct') 
     145 
     146    pval = pop capt 
     147    is(pval, '1.5', 'third popped element of capture is correct') 
     148 
     149    pval = pop capt 
     150    is(pval, '0', 'fourth popped element of capture is correct') 
     151 
     152    ival = capt['delta'] 
     153    is(ival, 15, 'integer keyed element of capture is correct') 
     154 
     155    pval = capt['gamma'] 
     156    is(pval, 'fourteen', 'pmc keyed element of capture is correct') 
     157 
     158    nval = capt['beta'] 
     159    is(nval, 13.5, 'number keyed element of capture is correct') 
     160 
     161    sval = capt['alpha'] 
     162    is(sval, '12', 'string keyed element of capture is correct') 
    148163.end 
    149164 
    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 
     165.sub defined_delete_exists 
     166    .local pmc capt,pval 
     167    .local int defined_bool, exists_bool 
    163168 
    164 pir_output_is( <<'CODE', <<'OUTPUT', "defined, delete, exists" ); 
    165 .sub main :main 
    166     .local pmc capt 
    167169    capt = new ['Capture'] 
    168170 
    169     $I0 = defined capt[2] 
    170     $I1 = exists capt[2] 
    171     print $I0 
    172     print " " 
    173     print $I1 
    174     print "\n" 
     171    defined_bool = defined capt[2] 
     172    is(defined_bool, 0, 'uninitialised indexed element is undefined correctly') 
    175173 
    176     $I0 = defined capt['alpha'] 
    177     $I1 = exists capt['alpha'] 
    178     print $I0 
    179     print " " 
    180     print $I1 
    181     print "\n" 
     174    exists_bool = exists capt[2] 
     175    is(exists_bool, 0, 'uninitialised indexed element does not exist correctly') 
    182176 
     177    defined_bool = defined capt['alpha'] 
     178    is(defined_bool, 0, 'uninitialised keyed element is undefined correctly') 
     179 
     180    exists_bool = exists capt['alpha'] 
     181    is(exists_bool, 0, 'uninitialised keyed element does not exist correctly') 
     182 
    183183    capt[2] = 1 
    184184    capt['alpha'] = 1 
    185     $P0 = new ['Undef'] 
    186     capt['beta'] = $P0 
     185    pval = new ['Undef'] 
     186    capt['beta'] = pval 
    187187 
    188     $I0 = defined capt[2] 
    189     $I1 = exists capt[2] 
    190     print $I0 
    191     print " " 
    192     print $I1 
    193     print "\n" 
     188    defined_bool = defined capt[2] 
     189    is(defined_bool, 1, 'initialised indexed element is defined correctly') 
    194190 
    195     $I0 = defined capt['alpha'] 
    196     $I1 = exists capt['alpha'] 
    197     print $I0 
    198     print " " 
    199     print $I1 
    200     print "\n" 
     191    exists_bool = exists capt[2] 
     192    is(exists_bool, 1, 'initialised indexed element exists correctly') 
    201193 
    202     $I0 = defined capt[1] 
    203     $I1 = exists capt[1] 
    204     print $I0 
    205     print " " 
    206     print $I1 
    207     print "\n" 
     194    defined_bool = defined capt['alpha'] 
     195    is(defined_bool, 1, 'initialised keyed element is defined correctly') 
    208196 
    209     $I0 = defined capt['beta'] 
    210     $I1 = exists capt['beta'] 
    211     print $I0 
    212     print " " 
    213     print $I1 
    214     print "\n" 
     197    exists_bool = exists capt['alpha'] 
     198    is(exists_bool, 1, 'initialised keyed element exists correctly') 
    215199 
     200    defined_bool = defined capt[1] 
     201    is(defined_bool, 0, 'uninitialised indexed element is undefined correctly') 
     202 
     203    exists_bool = exists capt[1] 
     204    is(exists_bool, 0, 'uninitialised indexed element does not exist correctly') 
     205 
     206    defined_bool = defined capt['beta'] 
     207    is(defined_bool, 0, 'null initialised keyed element is undefined correctly') 
     208 
     209    exists_bool = exists capt['beta'] 
     210    is(exists_bool, 1, 'null initialised keyed element exists correctly') 
     211 
    216212    delete capt[2] 
    217213    delete capt['alpha'] 
    218214 
    219     $I0 = defined capt[2] 
    220     $I1 = exists capt[2] 
    221     print $I0 
    222     print " " 
    223     print $I1 
    224     print "\n" 
     215    defined_bool = defined capt[2] 
     216    is(defined_bool, 0, 'deleted indexed element is undefined correctly') 
    225217 
    226     $I0 = defined capt['alpha'] 
    227     $I1 = exists capt['alpha'] 
    228     print $I0 
    229     print " " 
    230     print $I1 
    231     print "\n" 
     218    exists_bool = exists capt[2] 
     219    is(exists_bool, 0, 'deleted indexed element does not exist correctly') 
    232220 
     221    defined_bool = defined capt['alpha'] 
     222    is(defined_bool, 0, 'deleted keyed element is undefined correctly') 
    233223 
     224    exists_bool = exists capt['alpha'] 
     225    is(exists_bool, 0, 'deleted keyed element does not exist correctly') 
    234226.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 
    245227 
    246 pir_output_is( $PRE . <<'CODE'. $POST, <<'OUTPUT', "hash, list" ); 
    247     $P0 = capt.'list'() 
    248     $P1 = capt.'hash'() 
     228.sub hash_list 
     229    .local pmc capt, list_pmc, hash_pmc 
     230    .local string list_type, hash_type 
    249231 
    250     $S0 = typeof $P0 
    251     $S1 = typeof $P1 
     232    capt = new ['Capture'] 
    252233 
    253     say $S0 
    254     say $S1 
    255 CODE 
    256 ResizablePMCArray 
    257 Hash 
    258 OUTPUT 
     234    list_pmc = capt.'list'() 
     235    hash_pmc = capt.'hash'() 
    259236 
    260 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_integer not implemented' ); 
    261     $I0 = capt 
    262 CODE 
    263 /get_integer\(\) not implemented in class 'Capture'/ 
    264 OUT 
     237    list_type = typeof list_pmc 
     238    is(list_type, 'ResizablePMCArray', 'list is correct type') 
    265239 
    266 pir_error_output_like( $PRE . <<'CODE'. $POST, <<'OUT', 'get_number not implemented' ); 
    267     $N0 = capt 
    268 CODE 
    269 /get_number\(\) not implemented in class 'Capture'/ 
    270 OUT 
     240    hash_type = typeof hash_pmc 
     241    is(hash_type, 'Hash', 'hash is correct type') 
     242.end 
    271243 
    272 pir_output_is( <<'CODE', <<'OUTPUT', '*_keyed_int delegation' ); 
    273 .sub main :main 
    274     $P99 = subclass 'Capture', 'Match' 
    275     $P1 = new ['Match'] 
    276     $P1[1] = 1 
    277     $I1 = elements $P1 
    278     print $I1 
    279     print "\n" 
     244.sub get_integer_not_implemented 
     245    .local pmc capt, eh 
     246    .local int ival 
    280247 
    281     $P99 = subclass 'Match', 'Exp' 
    282     $P2 = new ['Exp'] 
    283     $P2[1] = 1 
    284     $I2 = elements $P2 
    285     print $I2 
    286     print "\n" 
     248    eh = new ['ExceptionHandler'] 
     249#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 
     250    set_addr eh, eh_label 
    287251 
     252    capt = new ['Capture'] 
     253 
     254    push_eh eh 
     255      ival = capt 
     256    pop_eh 
     257 
     258    ok(0, 'get_integer_not_implemented') 
     259    goto end 
     260 
     261eh_label: 
     262    .local string message 
     263    .get_results($P0) 
     264    message = $P0['message'] 
     265    is(message, "get_integer() not implemented in class 'Capture'", 'get_integer_not_implemented') 
     266 
     267end: 
    288268.end 
    289 CODE 
    290 2 
    291 2 
    292 OUTPUT 
    293269 
    294 pir_output_is( <<'CODE', <<'OUTPUT', 'list method delegation' ); 
    295 .sub main :main 
    296     $P0 = subclass 'Capture', 'Match' 
    297     addattribute $P0, '$.abc' 
    298     addattribute $P0, '$.xyz' 
    299     $P1 = new ['Match'] 
    300     $P1[1] = 1 
     270.sub get_number_not_implemented 
     271    .local pmc capt, eh 
     272    .local num nval 
    301273 
    302     $P2 = new ['String'] 
    303     setattribute $P1, '$.abc', $P2 
    304     $P2 = new ['String'] 
    305     setattribute $P1, '$.xyz', $P2 
     274    eh = new ['ExceptionHandler'] 
     275#    eh.'handle_types'(.EXCEPTION_UNIMPLEMENTED) 
     276    set_addr eh, eh_label 
    306277 
    307     $P2 = $P1.'list'() 
    308     $P2 = 0 
    309     $I0 = elements $P2 
    310     print $I0 
    311     print "\n" 
     278    capt = new ['Capture'] 
     279 
     280    push_eh eh 
     281      nval = capt 
     282    pop_eh 
     283 
     284    ok(0, 'get_number_not_implemented') 
     285    goto end 
     286 
     287eh_label: 
     288    .local string message 
     289    .get_results($P0) 
     290    message = $P0['message'] 
     291    is(message, "get_number() not implemented in class 'Capture'", 'get_number_not_implemented') 
     292 
     293end: 
    312294.end 
    313 CODE 
    314 0 
    315 OUTPUT 
    316295 
     296.sub keyed_int_delegation 
     297    .local pmc capt, foo, bar, baz 
     298    .local int ival 
     299 
     300    foo = subclass 'Capture', 'Match' 
     301    bar = new ['Match'] 
     302    bar[1] = 1 
     303    ival = elements bar 
     304    is(ival, 2, 'first keyed_int_delegation test correct') 
     305 
     306    foo = subclass 'Match', 'Exp' 
     307    baz = new ['Exp'] 
     308    baz[1] = 1 
     309    ival = elements baz 
     310    is(ival, 2, 'second keyed_int_delegation test correct') 
     311.end 
     312 
     313.sub list_method_delegation 
     314    .local pmc capt, foo, bar, baz 
     315    .local int ival 
     316 
     317    foo = subclass 'Capture', 'Match2' 
     318    addattribute foo, '$.abc' 
     319    addattribute foo, '$.xyz' 
     320    bar = new ['Match2'] 
     321    bar[1] = 1 
     322 
     323    baz = new ['String'] 
     324    setattribute bar, '$.abc', baz 
     325    baz = new ['String'] 
     326    setattribute bar, '$.xyz', baz 
     327 
     328    baz = bar.'list'() 
     329    baz = 0 
     330    ival = elements baz 
     331    is(ival, 0, 'list_method_delegation test correct') 
     332.end 
     333 
    317334# Local Variables: 
    318335#   mode: cperl 
    319336#   cperl-indent-level: 4