Trim unused imports
[p5sagit/Devel-PeekPoke.git] / t / 03torture.t
CommitLineData
36e403bb 1use strict;
2use warnings;
3
9b733ba1 4# T::M appears to leak, emit the TAP by hand
5#use Test::More 'no_plan';
6
9b733ba1 7sub is {
24538b08 8 my $str = $_[0] eq $_[1] ? 'ok' : 'not ok';
9
10 {
11 lock($::TEST_COUNT);
12 $::TEST_COUNT++;
13 printf STDOUT ("%s %u - %s\n",
14 $str,
15 $::TEST_COUNT,
16 $_[2] || '',
17 );
8c3de1b7 18 if ($str ne 'ok') {
19 printf STDERR ("# Failed test #%d at %s line %d
20# %s
21# ne
22# %s
23" , $::TEST_COUNT, (caller(0))[1,2],
24 , (map { unpack 'H*', $_ } @_[0,1])
25 );
26 }
27
24538b08 28 }
29 threads->yield if $INC{'threads.pm'};
9b733ba1 30}
36e403bb 31
4946632a 32use Devel::PeekPoke qw/peek poke/;
36e403bb 33use Devel::PeekPoke::Constants qw/PTR_SIZE PTR_PACK_TYPE/;
34
35my $str = 'for mutilation and mayhem';
36my $len = length($str);
37my $str_pv_addr = unpack(PTR_PACK_TYPE, pack('p', $str) );
38
39is( peek($str_pv_addr, $len + 1), $str . "\0", 'peek as expected (with NUL termination)' );
40
c1ec81b5 41for (1 .. ($ENV{AUTOMATED_TESTING} ? 200 : 5 ) ) {
9b733ba1 42 for my $poke_size (2 .. $len) {
43 my $replace_chunk = 'a' . ( '0' x ($poke_size-1) );
44 for my $poke_start ( 0 .. ($len - $poke_size) ) {
45 $replace_chunk++;
36e403bb 46
9b733ba1 47 my $expecting = $str;
48 substr($expecting, $poke_start, $poke_size, $replace_chunk);
36e403bb 49
9b733ba1 50 poke($str_pv_addr+$poke_start, $replace_chunk);
51 is($str, $expecting, 'String matches expectation after poke');
52 }
36e403bb 53 }
54}
55
24538b08 56if ($ENV{AUTOMATED_TESTING} and ! $INC{'threads.pm'}) {
9b733ba1 57 my $vsz;
58 if (-f "/proc/$$/stat") {
59 my $proc_stat = do { local (@ARGV, $/) = "/proc/$$/stat"; <> };
60 ($vsz) = map { $_ / 1024 }
61 (split (/\s+/, $proc_stat))[-22]; # go backwards because the %s of the procname can contain anything
62 }
63
64 printf STDERR "#\n# VSIZE:%dKiB\n", $vsz
65 if $vsz;
66}
67
24538b08 68print "1..$::TEST_COUNT\n" unless $INC{'threads.pm'};