diff options
Diffstat (limited to 't/mwrap.t')
| -rw-r--r-- | t/mwrap.t | 177 |
1 files changed, 0 insertions, 177 deletions
diff --git a/t/mwrap.t b/t/mwrap.t deleted file mode 100644 index 6f99715..0000000 --- a/t/mwrap.t +++ /dev/null @@ -1,177 +0,0 @@ -#!perl -w -# Copyright (C) mwrap hackers <mwrap-perl@80x24.org> -# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt> -use v5.12; -BEGIN { require './t/test_common.perl' }; -use_ok 'Devel::Mwrap'; -my $dump = "$mwrap_tmp/dump"; - -{ - my $env = { MWRAP => "dump_path:$dump,dump_min:10000" }; - my $nr = 1000; - mwrap_run('dump test', $env, '-e', '$x = "hello world" x '.$nr); - ok(-s $dump, "dump file written to"); - my $s = slurp($dump); - truncate($dump, 0); - my $re = qr/([0-9]+)[ \t]+([0-9]+)[ \t]+-e:1[ \t]*\n/sm; - my ($bytes, $n); - if ($s =~ $re) { - ($bytes, $n) = ($1, $2); - ok($bytes >= (length('hello world') * $nr), - "counted 'hello world' x $nr"); - ok($n >= 1, 'allocation counted'); - } else { - fail("$s failed to match $re"); - } -} - -SKIP: { # C++ program which uses malloc via "new" - my $exp = `cmake -h`; - skip 'cmake missing', 2 if $?; - skip "`cmake -h' gave no output", 2 unless $exp =~ /\S/s; - mwrap_run('cmake (C++ new)', {}, '-e', 'system(qw(cmake -h)); exit $?'); - my $res = slurp($mwrap_out); - is($res, $exp, "`cmake -h' works"); - diag slurp($mwrap_err); -}; - -{ - mwrap_run('total_bytes*', {}, '-e', <<'E1'); -my $A = Devel::Mwrap::total_bytes_allocated(); -my $f = Devel::Mwrap::total_bytes_freed(); -print("$A - $f\n"); -E1 - my $o = slurp($mwrap_out); - like($o, qr/^([0-9]+) - ([0-9]+)\n/s, 'got allocated & freed bytes'); -} - -{ - mwrap_run('source location', {}, 't/source_location.perl'); - mwrap_run('source location via -d:', {}, - '-d:Mwrap', 't/source_location.perl'); -} - -mwrap_run('Devel::Mwrap::each', {}, '-e', <<'EOF'); -open my $zero, '<', '/dev/zero' or die "open /dev/zero: $!"; -my $nbytes = 1024 * 512; -sysread($zero, my $before, $nbytes); -my (@keep, @uargs); -my $uarg = 'user-arg'; -eval { - Devel::Mwrap::each(0, sub { - my $ua = shift; - push @uargs, $ua; - die "died in each"; - push @keep, @_; - }, $uarg) }; -"$@" =~ /died in each at -e line \d+/ or die "did not propagate die in each"; -scalar(@keep) == 0 or die "nothing if died in sub"; -$uarg eq join('-', @uargs) or die "uarg passed to sub"; -my %h; -my $iter; -my $arg = "FOO"; -Devel::Mwrap::each(1, sub { - my ($argh, $src_loc, @more) = @_; - my $name = $src_loc->name; - $h{$name} = $src_loc; - sysread($zero, my $iter, $nbytes); - die 'extra args from ::each' if @more; - die "arg mismatch $arg / $argh" if $argh ne $arg; -}, $arg); -my $src_loc = $h{"-e:3"} or die "missing src_loc for -e:3"; -$src_loc->total >= $nbytes or die "allocated <= $nbytes"; -$src_loc = Devel::Mwrap::get("-e:8"); -if ($src_loc && $src_loc->total >= $nbytes) { - die "large allocation inside :each should not be tracked"; -} -my $nr = 0; -Devel::Mwrap::each($nbytes, sub { - $foo += shift; - push @keep, @_; -}, 1); -scalar(@keep) == 1 or die "got multiple matches for > $nbytes"; -$keep[0]->name eq '-e:3' or die "unexpected location for > $nbytes"; -@keep = (); -Devel::Mwrap::reset(); -Devel::Mwrap::each($nbytes, sub { push @keep, @_ }); -scalar(@keep) == 0 or die "::reset did not work"; -EOF - -mwrap_run('Devel::Mwrap::SrcLoc::each', {}, '-e', <<'EOF'); -open my $zero, '<', '/dev/zero' or die "open /dev/zero: $!"; -my @keep; -my $nr = 10; -my $nbytes = 1024 * 10; -sub do_read () { - sysread($zero, my $buf, $nbytes); - # this forces us to allocate a new buf with every call - pop @keep; - push @keep, $buf; -} -for (1..$nr) { do_read() } -my $loc = Devel::Mwrap::get('-e:6'); -$loc && $loc->total >= ($nbytes * $nr) or die "wrong line or bad stats"; -my $ml = $loc->mean_lifespan; -$ml >= 0.0 or die "mean_lifespan broken"; -my @sl_each; -$loc->each($nbytes, sub { shift; push @sl_each, \@_ }); -my $n = scalar(@sl_each); -$n == 1 or die "SrcLoc::each returned unexpected: $n"; -$sl_each[0]->[0] >= $nbytes or die "$sl_each[0]->[0] < $nbytes"; - -my $age_before = $sl_each[0]->[1]; -$nbytes = 1024 * 1024 * 8; -do_read() until Devel::Mwrap::current_age() > ($age_before + $nbytes); -@sl_each = (); -$loc->each($nbytes, sub { shift; push @sl_each, \@_ }); -$n = scalar(@sl_each); -$n == 1 or die "SrcLoc::each returned unexpected: $n"; -$sl_each[0]->[0] >= $nbytes or die "$sl_each[0]->[0] < $nbytes"; -my $age_after = $sl_each[0]->[1]; -$age_after >= $age_before or die "age did not increment"; -EOF -diag slurp($mwrap_out); - -is(Devel::Mwrap::quiet(1), 0, 'was not quiet, before'); -is(Devel::Mwrap::quiet(0), 1, 'was quiet, before'); - -SKIP: { - eval { require Inline::C } or skip 'Inline::C not available', 1; - $ENV{TEST_ALIASES} or skip 'TEST_ALIASES unset', 1; - my $c_src = <<'EOM'; -#include <stdlib.h> -void cfree(void *); /* lold glibc version */ -int test_aliases() -{ - size_t i; - void *p; - for (i = 0; i < 100; i++) { - if (i % 3 == 0) - p = aligned_alloc(64, i); - else - p = malloc(i); - if (i % 2 == 0) - cfree(p); - else - free(p); - } - return 3; -} -EOM - eval <<'EOM'; -use Inline C => $c_src, BUILD_NOISY => 1 -EOM - BAIL_OUT "cannot build $@" if $@; - is(test_aliases(), 3, - 'aligned_alloc + cfree function ran w/o crashing'); -}; - -is(Devel::Mwrap::bt_depth(), 0, 'default bt depth is zero'); -is(Devel::Mwrap::bt_depth(5), 5, 'set depth to reasonable level'); -is(Devel::Mwrap::bt_depth(), 5, 'depth stays at 5'); -is(Devel::Mwrap::bt_depth(500), 32, 'depth clamped to 32 when 500 attempted'); -is(Devel::Mwrap::bt_depth(), 32, 'depth stayed clamped at 32'); -is(Devel::Mwrap::bt_depth(undef), 32, 'depth stayed clamped at 32'); -is(Devel::Mwrap::bt_depth(-1), 32, 'depth stayed clamped at 32'); - -done_testing; |