t/op/gc-leaky-box.t

   1 #!./parrot
   2 # Copyright (C) 2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/gc-leaky-box.t - test for memory leaks in the Garbage Collector
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/op/gc-leaky-box.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests that we actually do a GC mark and sweep after a large number of PMC's have
  16 been created. Test suggested by chromatic++ . Also includes tests for
  17 TT1465 - http://trac.parrot.org/parrot/ticket/1465 .
  18
  19 =cut
  20
  21 # 20:57 <chromatic> For every million PMCs allocated, see that the GC has performed a mark/sweep.
  22
  23 .include 'interpinfo.pasm'
  24
  25 .sub _main :main
  26     .include 'test_more.pir'
  27
  28     plan(3)
  29
  30     $S0 = interpinfo .INTERPINFO_GC_SYS_NAME
  31     if $S0 == "inf" goto dont_run_hanging_tests
  32
  33     test_gc_mark_sweep()
  34
  35     goto test_end
  36   dont_run_hanging_tests:
  37     ok(1, "#TODO - Test disabled on gc_inf")
  38     ok(1, "#TODO - Test disabled on gc_inf")
  39     ok(1, "#TODO - Test disabled on gc_inf")
  40   test_end:
  41 .end
  42
  43 .sub test_gc_mark_sweep
  44     .local int counter
  45
  46     counter = 0
  47   loop:
  48     $P0 = box 0
  49     inc counter
  50     if counter < 2e6 goto loop
  51
  52     $I1 = interpinfo.INTERPINFO_GC_COLLECT_RUNS
  53     $I2 = interpinfo.INTERPINFO_GC_MARK_RUNS
  54     $I3 = interpinfo.INTERPINFO_TOTAL_MEM_ALLOC
  55
  56     $S1 = $I1
  57     $S0 = "performed " . $S1
  58     $S0 .= " (which should be >=1) GC collect runs"
  59     ok($I1,$S0)
  60
  61     $S1 = $I2
  62     $S0 = "performed " . $S1
  63     $S0 .= " (which should be >=1) GC mark runs"
  64     ok($I2,$S0)
  65
  66     $S1 = $I3
  67     $S0 = "allocated " . $S1
  68     $S0 .= " (which should be <= 2_000_000) bytes of memory"
  69     $I4 = isle $I3, 2000000
  70     ok($I4,$S0)
  71 .end
  72
  73 # Local Variables:
  74 #   mode: pir
  75 #   fill-column: 100
  76 # End:
  77 # vim: expandtab shiftwidth=4 ft=pir: