Ticket #950: gc.t.patch

File gc.t.patch, 13.4 KB (added by jrtayloriv, 12 years ago)

  • t/op/gc.t

     
    1 #!perl 
     1#! parrot 
    22# Copyright (C) 2001-2009, Parrot 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 => 18; 
    10  
    115=head1 NAME 
    126 
    13 t/op/gc.t - Garbage Collection 
     7t/op/gc.t - Garbage collection 
    148 
    159=head1 SYNOPSIS 
    1610 
    17         % prove t/op/gc.t 
     11    % prove t/op/gc.t 
    1812 
    1913=head1 DESCRIPTION 
    2014 
    … …  
    2317 
    2418=cut 
    2519 
    26 pir_output_is( <<'CODE', '1', "sweep 1" ); 
    2720.include 'interpinfo.pasm' 
    28 .sub main :main 
    29       $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS  # How many GC mark runs have we done already? 
    30       sweep 1 
    31       $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be one more now 
    32       $I3 = $I2 - $I1 
    33       print $I3 
    34 .end 
    35 CODE 
    3621 
    37 pir_output_is( <<'CODE', '0', "sweep 0" ); 
    38 .include 'interpinfo.pasm' 
    3922.sub main :main 
    40       $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already? 
    41       sweep 0 
    42       $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be same 
    43       $I3 = $I2 - $I1 
    44       print $I3 
    45 .end 
    46 CODE 
     23    .include 'test_more.pir' 
     24    plan(10) 
    4725 
    48 pasm_output_is( <<'CODE', '1', "sweep 0, with object that need destroy" ); 
    49       new P0, 'Undef' 
    50       interpinfo I1, 2   # How many GC mark runs have we done already? 
    51       needs_destroy P0 
    52       sweep 0 
    53       interpinfo I2, 2   # Should be one more now 
    54       sub I3, I2, I1 
    55       print I3 
    56       end 
    57 CODE 
     26    sweep_1() 
     27    sweep_0() 
     28    sweep_0_need_destroy_obj() 
     29    sweep_0_need_destroy_destroy_obj() 
     30    collect_count() 
     31    collect_toggle() 
     32    collect_toggle_nested() 
    5833 
    59 pasm_output_is( <<'CODE', '10', "sweep 0, with object that need destroy/destroy" ); 
    60       new P0, 'Undef' 
    61       needs_destroy P0 
    62       interpinfo I1, 2   # How many GC mark runs have we done already? 
    63       new P0, 'Undef'    # kill object 
    64       sweep 0 
    65       interpinfo I2, 2   # Should be one more now 
    66       sub I3, I2, I1 
    67       sweep 0 
    68       interpinfo I4, 2   # Should be same as last 
    69       sub I5, I4, I2 
    70       print I3           # These create PMCs that need early GC, so we need 
    71       print I5           # to put them after the second sweep op. 
    72       end 
    73 CODE 
     34    # END_OF_TESTS 
    7435 
    75 pir_output_is( <<'CODE', '1', "collect" ); 
    76 .include 'interpinfo.pasm' 
    77 .sub main :main 
    78       $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS   # How many garbage collections have we done already? 
    79       collect 
    80       $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS  # Should be one more now 
    81       $I3 = $I2 - $I1 
    82       print $I3 
    8336.end 
    84 CODE 
    8537 
    86 pasm_output_is( <<'CODE', <<'OUTPUT', "collectoff/on" ); 
    87       interpinfo I1, 3 
    88       collectoff 
    89       collect 
    90       interpinfo I2, 3 
    91       sub I3, I2, I1 
    92       print I3 
    93       print "\n" 
    94  
    95       collecton 
    96       collect 
    97       interpinfo I4, 3 
    98       sub I6, I4, I2 
    99       print I6 
    100       print "\n" 
    101  
    102       end 
    103 CODE 
    104 0 
    105 1 
    106 OUTPUT 
    107  
    108 pasm_output_is( <<'CODE', <<'OUTPUT', "Nested collectoff/collecton" ); 
    109       interpinfo I1, 3 
    110       collectoff 
    111       collectoff 
    112       collecton 
    113       collect           # This shouldn't do anything...    #' 
    114       interpinfo I2, 3 
    115       sub I3, I2, I1 
    116       print I3 
    117       print "\n" 
    118  
    119       collecton 
    120       collect           # ... but this should 
    121       interpinfo I4, 3 
    122       sub I6, I4, I2 
    123       print I6 
    124       print "\n" 
    125  
    126       end 
    127 CODE 
    128 0 
    129 1 
    130 OUTPUT 
    131  
    132 pir_output_is( <<'CODE', <<OUTPUT, "vanishing singleton PMC" ); 
    133 .sub main :main 
    134     $P16 = new 'Env' 
    135     $P16['Foo'] = 'bar' 
    136     $I16 = 100 
    137     $I17 = 0 
    138  
    139     loop: 
    140         sweep 1 
    141         _rand() 
    142         $I17 += 1 
    143         if $I17 <= $I16 goto loop 
    144         say "ok" 
     38.sub sweep_1 
     39    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS  # How many GC mark runs have we done already? 
     40    sweep 1 
     41    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be one more now 
     42    $I3 = $I2 - $I1 
     43    is($I3,1) 
    14544.end 
    14645 
    147 .sub _rand 
    148     $P16 = new 'Env' 
    149     $P5 = $P16['Foo'] 
    150     if $P5 != 'bar' goto err 
    151     .return() 
    152     err: 
    153         say "singleton destroyed .Env = ." 
    154         $P16 = new 'Env' 
    155         $S16 = typeof $P16 
    156         say $S16 
    157 .end 
    15846 
    159 CODE 
    160 ok 
    161 OUTPUT 
    16247 
    163 pir_output_is( <<'CODE', <<OUTPUT, "vanishing return continuation in method calls" ); 
    164 .sub main :main 
    165     .local pmc o, cl 
    166     cl = newclass "Foo" 
    167  
    168     new o, "Foo" 
    169     print "ok\n" 
    170     end 
     48.sub sweep_0 
     49    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already? 
     50    sweep 0 
     51    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be same 
     52    $I3 = $I2 - $I1 
     53    is($I3,0) 
    17154.end 
    17255 
    173 .namespace ["Foo"] 
    174 .sub init :vtable :method 
    175     print "init\n" 
    176     sweep 1 
    177     new $P6, 'String' 
    178     set $P6, "hi" 
    179     self."do_inc"() 
    180     sweep 1 
    181 .end 
    18256 
    183 .sub do_inc :method 
    184     sweep 1 
    185     inc self 
    186     sweep 1 
    187     print "back from _inc\n" 
     57# sweep 0, with object that needs destroy/destroy 
     58.sub sweep_0_need_destroy_obj 
     59    $P0 = new 'Undef' 
     60    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already? 
     61    needs_destroy $P0 
     62    sweep 0 
     63    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be one more now 
     64    $I3 = $I2 - $I1 
     65    is($I3,1) 
    18866.end 
    18967 
    190 .sub __increment :method 
    191     print "inc\n" 
    192     sweep 1 
    193 .end 
    194 CODE 
    195 init 
    196 inc 
    197 back from _inc 
    198 ok 
    199 OUTPUT 
    200  
    201 pasm_output_is( <<'CODE', <<OUTPUT, "failing if regsave is not marked" ); 
    202     newclass P9, "Source" 
    203     newclass P10, "Source::Buffer" 
    204     new P12, "Source" 
    205  
    206     set S20, P12 
    207     print S20 
    208     set S20, P12 
    209     print S20 
    210     end 
    211  
    212 .namespace ["Source"] 
    213 .pcc_sub __get_string:  # buffer 
    214     get_params "0", P2 
    215     getprop P12, "buffer", P2 
    216     sweep 1 
    217     unless_null P12, buffer_ok 
    218     new P12, "Source::Buffer" 
    219     new P14, 'String' 
    220     set P14, "hello\n" 
    221     setprop P12, "buf", P14 
    222     setprop P2, "buffer", P12 
    223 buffer_ok: 
    224     set_returns "0", P12 
    225     returncc 
    226  
    227 .namespace ["Source::Buffer"] 
    228 .pcc_sub __get_string: 
    229     get_params "0", P2 
    230     sweep 1 
    231     getprop P12, "buf", P2 
    232     set S16, P12 
    233     set_returns "0", S16 
    234     returncc 
    235 CODE 
    236 hello 
    237 hello 
    238 OUTPUT 
    239  
    240 # this is a stripped down version of imcc/t/syn/pcc_16 
    241 # s. also src/pmc/retcontinuation.pmc 
    242 pasm_output_is( <<'CODE', <<OUTPUT, "coro context and invalid return continuations" ); 
    243 .pcc_sub main: 
    244     .const 'Sub' P0 = "co1" 
    245     set I20, 0 
    246 l: 
    247     get_results '' 
    248     set_args '' 
    249     invokecc P0 
    250     inc I20 
    251     lt I20, 3, l 
    252     print "done\n" 
    253     end 
    254 .pcc_sub co1: 
    255     get_params '' 
    256     set P17, P1 
    257 col: 
    258     print "coro\n" 
    259     sweep 1 
    260     yield 
    261     branch col 
    262  
    263 CODE 
    264 coro 
    265 coro 
    266 coro 
    267 done 
    268 OUTPUT 
    269  
    270 pir_output_is( <<'CODE', <<OUTPUT, "Recursion and exceptions" ); 
    271  
    272 # this did segfault with GC_DEBUG 
    273  
    274 .sub main :main 
    275     .local pmc n 
    276     $P0 = getinterp 
    277     $P0."recursion_limit"(10) 
    278     newclass $P0, "b" 
    279     $P0 = new "b" 
    280     $P1 = new 'Integer' 
    281     $P1 = 0 
    282     n = $P0."b11"($P1) 
    283     print "ok 1\n" 
    284     print n 
    285     print "\n" 
    286 .end 
    287 .namespace ["b"] 
    288 .sub b11 :method 
    289     .param pmc n 
    290     .local pmc n1 
    291     # new_pad -1 
    292     # store_lex -1, "n", n 
    293     n1 = new 'Integer' 
    294     n1 = n + 1 
    295     push_eh catch 
    296     n = self."b11"(n1) 
    297     # store_lex -1, "n", n 
    298     pop_eh 
    299 catch: 
    300     # n = find_lex "n" 
    301     .return(n) 
    302 .end 
    303 CODE 
    304 ok 1 
    305 9 
    306 OUTPUT 
    307  
    308 pasm_output_is( <<'CODE', <<OUTPUT, "write barrier 1" ); 
    309     null I2 
    310     set I3, 100 
    311 lp3: 
    312     null I0 
    313     set I1, 1000 
    314     new P1, 'ResizablePMCArray' 
    315 lp1: 
    316     new P2, 'ResizablePMCArray' 
    317     new P0, 'Integer' 
    318     set P0, I0 
    319     set P2[0], P0 
    320     set P1[I0], P2 
    321     if I0, not_0 
    322     needs_destroy P0 
    323     # force marking past P2[0] 
     68# sweep 0, with object that needs destroy/destroy 
     69.sub sweep_0_need_destroy_destroy_obj 
     70    $P0 = new 'Undef' 
     71    needs_destroy $P0 
     72    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already? 
     73    $P0 = new 'Undef'  #kill object 
    32474    sweep 0 
    325 not_0: 
    326     new P3, 'Undef' 
    327     new P4, 'Undef' 
    328     inc I0 
    329     lt I0, I1, lp1 
    330  
    331     null I0 
    332     # trace 1 
    333 lp2: 
    334     set P2, P1[I0] 
    335     set P2, P2[0] 
    336     eq P2, I0, ok 
    337     print "nok\n" 
    338     print "I0: " 
    339     print I0 
    340     print " P2: " 
    341     print P2 
    342     print " type: " 
    343     typeof S0, P2 
    344     print S0 
    345     print " I2: " 
    346     print I2 
    347     print "\n" 
    348     exit 1 
    349 ok: 
    350     inc I0 
    351     lt I0, I1, lp2 
    352     inc I2 
    353     lt I2, I3, lp3 
    354     print "ok\n" 
    355     end 
    356 CODE 
    357 ok 
    358 OUTPUT 
    359  
    360 pasm_output_is( <<'CODE', <<OUTPUT, "write barrier 2 - hash" ); 
    361     null I2 
    362     set I3, 100 
    363 lp3: 
    364     null I0 
    365     set I1, 100 
    366     new P1, 'Hash' 
    367 lp1: 
    368     new P2, 'Hash' 
    369     new P0, 'Integer' 
    370     set P0, I0 
    371     set S0, I0 
    372     set P2["first"], P0 
    373     set P1[S0], P2 
    374     if I0, not_0 
    375     new P0, 'Integer' 
    376     needs_destroy P0 
    377     null P0 
    378     # force full sweep 
     75    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be one more now 
     76    $I3 = $I2 - $I1 
    37977    sweep 0 
    380 not_0: 
    381     new P3, 'Undef' 
    382     new P4, 'Undef' 
    383     inc I0 
    384     lt I0, I1, lp1 
     78    $I4 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be same as last 
     79    $I5 = $I4 - $I2 
     80    is($I3,1) 
     81    is($I5,0) 
     82.end 
    38583 
    386     null I0 
    387     # trace 1 
    388 lp2: 
    389     set S0, I0 
    390     set P2, P1[S0] 
    391     set P2, P2["first"] 
    392     eq P2, I0, ok 
    393     print "nok\n" 
    394     print "I0: " 
    395     print I0 
    396     print " P2: " 
    397     print P2 
    398     print " type: " 
    399     typeof S0, P2 
    400     print S0 
    401     print " I2: " 
    402     print I2 
    403     print "\n" 
    404     exit 1 
    405 ok: 
    406     inc I0 
    407     lt I0, I1, lp2 
    408     inc I2 
    409     lt I2, I3, lp3 
    410     print "ok\n" 
    411     end 
    412 CODE 
    413 ok 
    414 OUTPUT 
    415  
    416 pir_output_is( <<'CODE', <<'OUTPUT', "verify pmc proxy object marking" ); 
    417 .sub main :main 
    418     .local pmc cl, s, t 
    419     cl = subclass "String", "X" 
    420     addattribute cl, "o3" 
    421     addattribute cl, "o4" 
    422     s = new "X" 
    423     $P0 = new 'String' 
    424     $S0 = "ok" . " 3\n" 
    425     $P0 = $S0 
    426     setattribute s, "o3", $P0 
    427     $P0 = new 'String' 
    428     $S0 = "ok" . " 4\n" 
    429     $P0 = $S0 
    430     setattribute s, "o4", $P0 
    431     null $P0 
    432     null $S0 
    433     null cl 
    434     sweep 1 
    435     s = "ok 1\n" 
    436     print s 
    437     .local int i 
    438     i = 0 
    439 lp: 
    440     t = new "X" 
    441     inc i 
    442     if i < 1000 goto lp 
    443     t = "ok 2\n" 
    444     print s 
    445     print t 
    446     $P0 = getattribute s, "o3" 
    447     print $P0 
    448     $P0 = getattribute s, "o4" 
    449     print $P0 
     84.sub collect_count 
     85    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS   # How many garbage collections have we done already? 
     86    collect 
     87    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS  # Should be one more now 
     88    $I3 = $I2 - $I1 
     89    is($I3,1) 
    45090.end 
    451 CODE 
    452 ok 1 
    453 ok 1 
    454 ok 2 
    455 ok 3 
    456 ok 4 
    457 OUTPUT 
    45891 
    459 pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 1" ); 
    460 .sub main :main 
    461     .local pmc a, reg, nil 
    462     reg = new 'AddrRegistry' 
    463     a = new 'String' 
    464     null nil 
    465     $I0 = reg[a] 
    466     if $I0 == 0 goto ok1 
    467     print "not " 
    468 ok1: 
    469     print "ok 1\n" 
    470     reg[a] = nil 
    471     $I0 = reg[a] 
    472     if $I0 == 1 goto ok2 
    473     print "not " 
    474 ok2: 
    475     print "ok 2\n" 
    476     reg[a] = nil 
    477     $I0 = reg[a] 
    478     if $I0 == 2 goto ok3 
    479     print "not " 
    480 ok3: 
    481     print "ok 3\n" 
     92.sub collect_toggle 
     93    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS # How many garbage collections have we done already? 
     94    collectoff 
     95    collect 
     96    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS 
     97    $I3 = $I2 - $I1 
     98    is($I3,0) 
    48299 
    483     delete reg[a] 
    484     $I0 = reg[a] 
    485     if $I0 == 1 goto ok4 
    486     print "not " 
    487 ok4: 
    488     print "ok 4\n" 
    489     delete reg[a] 
    490     $I0 = reg[a] 
    491     if $I0 == 0 goto ok5 
    492     print "not " 
    493 ok5: 
    494     print "ok 5\n" 
     100    collecton 
     101    collect 
     102    $I4 = interpinfo .INTERPINFO_GC_COLLECT_RUNS 
     103    $I6 = $I4 - $I2 
     104    is($I6,1) 
    495105.end 
    496 CODE 
    497 ok 1 
    498 ok 2 
    499 ok 3 
    500 ok 4 
    501 ok 5 
    502 OUTPUT 
    503106 
    504 pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 2" ); 
    505 .sub main :main 
    506     .local pmc a, b, reg, nil 
    507     null nil 
    508     reg = new 'AddrRegistry' 
    509     a = new 'String' 
    510     b = new 'String' 
    511     $I0 = elements reg 
    512     print $I0 
    513     reg[a] = nil 
    514     $I0 = elements reg 
    515     print $I0 
    516     reg[a] = nil 
    517     $I0 = elements reg 
    518     print $I0 
    519     reg[b] = nil 
    520     $I0 = elements reg 
    521     print $I0 
    522     print "\n" 
    523 .end 
    524 CODE 
    525 0112 
    526 OUTPUT 
     107.sub collect_toggle_nested 
     108    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS # How many garbage collections have we done already? 
     109    collectoff 
     110    collectoff 
     111    collecton 
     112    collect           # This shouldn't do anything...    #' 
     113    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS 
     114    $I3 = $I2 - $I1 
     115    is($I3,0) 
    527116 
    528 pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 2" ); 
    529 .sub main :main 
    530     .local pmc a, b, c, reg, nil, it 
    531     null nil 
    532     reg = new 'AddrRegistry' 
    533     a = new 'String' 
    534     a = "k1" 
    535     b = new 'String' 
    536     b = "k2" 
    537     c = new 'String' 
    538     c = "k3" 
    539     reg[a] = nil 
    540     reg[b] = nil 
    541     reg[c] = nil 
     117    collecton 
     118    collect           # ... but this should 
     119    $I4 = interpinfo .INTERPINFO_GC_COLLECT_RUNS 
     120    $I6 = $I4 - $I2 
     121    is($I6,1) 
    542122 
    543     $P1 = new ['ResizablePMCArray'] 
    544     it = iter reg 
    545 loop: 
    546     unless it goto done 
    547     $P0 = shift it 
    548     $S0 = $P0 
    549     push $P1, $S0 
    550     goto loop 
    551 done: 
    552     $P1.'sort'() 
    553     $S1 = join '', $P1 
    554     print $S1 
    555     print "\n" 
    556123.end 
    557 CODE 
    558 k1k2k3 
    559 OUTPUT 
    560124 
    561 =head1 SEE ALSO 
    562125 
    563 F<examples/benchmarks/primes.c>, 
    564 F<examples/benchmarks/primes.pasm>, 
    565 F<examples/benchmarks/primes.pl>, 
    566 F<examples/benchmarks/primes2_i.pasm>, 
    567 F<examples/benchmarks/primes2.c>, 
    568 F<examples/benchmarks/primes2.py>. 
    569  
    570 =cut 
    571  
    572126# Local Variables: 
    573127#   mode: cperl 
    574128#   cperl-indent-level: 4 
    575129#   fill-column: 100 
    576130# End: 
    577 # vim: expandtab shiftwidth=4: 
     131# vim: expandtab shiftwidth=4 filetype=pir: