t/op/gc-active-buffers.t

   1 #!./parrot
   2 # Copyright (C) 2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/gc-active-buffers.t - Test that buffers are freed as soon as possible
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/op/gc-active-buffers.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests that unused buffers (strings) are freed in the first GC run. See
  16 TT1603 - http://trac.parrot.org/parrot/ticket/1603
  17
  18 =cut
  19
  20 .include 'interpinfo.pasm'
  21
  22 .sub _main :main
  23     .include 'test_more.pir'
  24
  25     plan(1)
  26
  27     sweep 1
  28     $I0 = interpinfo .INTERPINFO_ACTIVE_BUFFERS
  29
  30     .local int count
  31     count= 1000
  32   loop:
  33         unless count goto done
  34
  35         # original test form TT1603
  36         $P0 = new 'CodeString'
  37         $P0.'emit'("a")
  38         $S0 = $P0
  39
  40         # another way to trigger the problem
  41         $S1 = "abc"
  42         $S2 = substr $S1, 0, 1
  43
  44         dec count
  45     goto loop
  46   done:
  47
  48     sweep 1
  49     $I1 = interpinfo .INTERPINFO_ACTIVE_BUFFERS
  50
  51     $I2 = $I1 - $I0
  52     $S0 = $I2
  53     $S0 .= " additional active buffers (which should be <= 100)"
  54     $I3 = isle $I2, 100
  55     ok($I3, $S0)
  56  .end
  57
  58 # Local Variables:
  59 #   mode: pir
  60 #   fill-column: 100
  61 # End:
  62 # vim: expandtab shiftwidth=4 ft=pir: