X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F03torture.t;h=ba674ce0f537a44ddb3306ddd1aa734003e24659;hb=c1ec81b529918670b355c2e13be49b361d169dd4;hp=05247f08cd6882d59bb0f11dc47f945dc72f1112;hpb=36e403bb6734756c864c7fc84e7d48080cf75965;p=p5sagit%2FDevel-PeekPoke.git

diff --git a/t/03torture.t b/t/03torture.t
index 05247f0..ba674ce 100644
--- a/t/03torture.t
+++ b/t/03torture.t
@@ -1,7 +1,23 @@
 use strict;
 use warnings;
 
-use Test::More;
+# T::M appears to leak, emit the TAP by hand
+#use Test::More 'no_plan';
+
+sub is {
+  my $str = $_[0] eq $_[1] ? 'ok' : 'not ok';
+
+  {
+    lock($::TEST_COUNT);
+    $::TEST_COUNT++;
+    printf STDOUT ("%s %u - %s\n",
+      $str,
+      $::TEST_COUNT,
+      $_[2] || '',
+    );
+  }
+  threads->yield if $INC{'threads.pm'};
+}
 
 use Devel::PeekPoke qw/peek poke peek_address poke_address/;
 use Devel::PeekPoke::Constants qw/PTR_SIZE PTR_PACK_TYPE/;
@@ -12,17 +28,31 @@ my $str_pv_addr = unpack(PTR_PACK_TYPE, pack('p', $str) );
 
 is( peek($str_pv_addr, $len + 1), $str . "\0", 'peek as expected (with NUL termination)' );
 
-for my $poke_size (2 .. $len) {
-  my $replace_chunk = 'a' . ( '0' x ($poke_size-1) );
-  for my $poke_start ( 0 .. ($len - $poke_size) ) {
-    $replace_chunk++;
+for (1 .. ($ENV{AUTOMATED_TESTING} ? 200 : 5 ) ) {
+  for my $poke_size (2 .. $len) {
+    my $replace_chunk = 'a' . ( '0' x ($poke_size-1) );
+    for my $poke_start ( 0 .. ($len - $poke_size) ) {
+      $replace_chunk++;
+
+      my $expecting = $str;
+      substr($expecting, $poke_start, $poke_size, $replace_chunk);
 
-    my $expecting = $str;
-    substr($expecting, $poke_start, $poke_size, $replace_chunk);
+      poke($str_pv_addr+$poke_start, $replace_chunk);
+      is($str, $expecting, 'String matches expectation after poke');
+    }
+  }
+}
 
-    poke($str_pv_addr+$poke_start, $replace_chunk);
-    is($str, $expecting, 'String matches expectation after poke');
+if ($ENV{AUTOMATED_TESTING} and ! $INC{'threads.pm'}) {
+  my $vsz;
+  if (-f "/proc/$$/stat") {
+    my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
+    ($vsz) = map { $_ / 1024 }
+      (split (/\s+/, $proc_stat))[-22];  # go backwards because the %s of the procname can contain anything
   }
+
+  printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
+    if $vsz;
 }
 
-done_testing;
+print "1..$::TEST_COUNT\n" unless $INC{'threads.pm'};