Commit | Line | Data |
36e403bb |
1 | use strict; |
2 | use warnings; |
3 | |
9b733ba1 |
4 | # T::M appears to leak, emit the TAP by hand |
5 | #use Test::More 'no_plan'; |
6 | |
9b733ba1 |
7 | sub 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 |
32 | use Devel::PeekPoke qw/peek poke/; |
36e403bb |
33 | use Devel::PeekPoke::Constants qw/PTR_SIZE PTR_PACK_TYPE/; |
34 | |
35 | my $str = 'for mutilation and mayhem'; |
36 | my $len = length($str); |
37 | my $str_pv_addr = unpack(PTR_PACK_TYPE, pack('p', $str) ); |
38 | |
39 | is( peek($str_pv_addr, $len + 1), $str . "\0", 'peek as expected (with NUL termination)' ); |
40 | |
c1ec81b5 |
41 | for (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 |
56 | if ($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 |
68 | print "1..$::TEST_COUNT\n" unless $INC{'threads.pm'}; |