t/03torture.t

   1 use strict;
   2 use warnings;
   3
   4 # T::M appears to leak, emit the TAP by hand
   5 #use Test::More 'no_plan';
   6
   7 my $tests = 0;
   8 sub is {
   9   $tests++;
  10   printf("%s %u - %s\n",
  11     ( $_[0] eq $_[1] ? 'ok' : 'not ok' ),
  12     $tests,
  13     $_[2] || '',
  14   );
  15 }
  16
  17 use Devel::PeekPoke qw/peek poke peek_address poke_address/;
  18 use Devel::PeekPoke::Constants qw/PTR_SIZE PTR_PACK_TYPE/;
  19
  20 my $str = 'for mutilation and mayhem';
  21 my $len = length($str);
  22 my $str_pv_addr = unpack(PTR_PACK_TYPE, pack('p', $str) );
  23
  24 is( peek($str_pv_addr, $len + 1), $str . "\0", 'peek as expected (with NUL termination)' );
  25
  26 for (1 .. ($ENV{AUTOMATED_TESTING} ? 300 : 20) ) {
  27   for my $poke_size (2 .. $len) {
  28     my $replace_chunk = 'a' . ( '0' x ($poke_size-1) );
  29     for my $poke_start ( 0 .. ($len - $poke_size) ) {
  30       $replace_chunk++;
  31
  32       my $expecting = $str;
  33       substr($expecting, $poke_start, $poke_size, $replace_chunk);
  34
  35       poke($str_pv_addr+$poke_start, $replace_chunk);
  36       is($str, $expecting, 'String matches expectation after poke');
  37     }
  38   }
  39 }
  40
  41 if ($ENV{AUTOMATED_TESTING}) {
  42   my $vsz;
  43   if (-f "/proc/$$/stat") {
  44     my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
  45     ($vsz) = map { $_ / 1024 }
  46       (split (/\s+/, $proc_stat))[-22];  # go backwards because the %s of the procname can contain anything
  47   }
  48
  49   printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
  50     if $vsz;
  51 }
  52
  53 print "1..$tests\n";