1 package Test::Valgrind;
11 use Perl::Destruct::Level level => 3;
13 use Test::Valgrind::Suppressions;
17 Test::Valgrind - Test Perl code through valgrind.
25 our $VERSION = '0.08';
30 eval 'use Test::Valgrind';
31 plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@;
33 # Code to inspect for memory leaks/errors.
37 This module lets you run some code through the B<valgrind> memory debugger, to test it for memory errors and leaks. Just add C<use Test::Valgrind> at the beginning of the code you want to test. Behind the hood, C<Test::Valgrind::import> forks so that the child can basically C<exec 'valgrind', $^X, $0> (except that of course C<$0> isn't right there). The parent then parses the report output by valgrind and pass or fail tests accordingly.
39 You can also use it from the command-line to test a given script :
41 perl -MTest::Valgrind leaky.pl
43 Due to the nature of perl's memory allocator, this module can't track leaks of Perl objects. This includes non-mortalized scalars and memory cycles. However, it can track leaks of chunks of memory allocated in XS extensions with C<Newx> and friends or C<malloc>. As such, it's complementary to the other very good leak detectors listed in the L</SEE ALSO> section.
47 You can pass parameters to C<import> as a list of key / value pairs, where valid keys are :
55 Also use suppressions from C<$file> besides perl's.
59 C<< no_supp => $bool >>
61 If true, do not use any suppressions.
65 C<< callers => $number >>
67 Specify the maximum stack depth studied when valgrind encounters an error. Raising this number improves granularity. Default is 12.
71 C<< extra => [ @args ] >>
73 Add C<@args> to valgrind parameters.
79 If true, print the raw output of valgrind as diagnostics (may be quite verbose).
83 C<< no_test => $bool >>
85 If true, do not actually output the plan and the tests results.
89 C<< cb => sub { my ($val, $name) = @_; ...; return $passed } >>
91 Specifies a subroutine to execute for each test instead of C<Test::More::is>. It receives the number of bytes leaked in C<$_[0]> and the test name in C<$_[1]>, and is expected to return true if the test passed and false otherwise. Defaults to
95 (defined $_[0] and $_[0] == 0) : 1 : 0
102 my $Test = Test::Builder->new;
107 (defined $_[0] and $_[0] == 0) ? 1 : 0;
111 $Test->is_num($_[0], 0, $_[1]);
117 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
119 if (!defined $args{run} && !$run) {
120 my ($file, $pm, $next);
123 $next = (caller $l++)[1];
124 last unless defined $next;
125 next unless $next ne '-e' and $next !~ /^\s*\(\s*eval\s*\d*\s*\)\s*$/
127 if ($next =~ /\.pm$/) {
133 unless (defined $file) {
135 return unless defined $pm;
137 my $callers = $args{callers};
138 $callers = 12 unless defined $callers;
139 $callers = int $callers;
140 my $vg = Test::Valgrind::Suppressions::VG_PATH;
141 if (!$vg || !-x $vg) {
143 for (split /$Config::Config{path_sep}/, $ENV{PATH}) {
151 $Test->skip_all('No valgrind executable could be found in your path');
155 pipe my $ordr, my $owtr or die "pipe(\$ordr, \$owtr): $!";
156 pipe my $vrdr, my $vwtr or die "pipe(\$vrdr, \$vwtr): $!";
160 } elsif ($pid == 0) {
161 setpgrp 0, 0 or die "setpgrp(0, 0): $!";
162 close $ordr or die "close(\$ordr): $!";
163 open STDOUT, '>&=', $owtr or die "open(STDOUT, '>&=', \$owtr): $!";
164 close $vrdr or die "close(\$vrdr): $!";
165 fcntl $vwtr, F_SETFD, 0 or die "fcntl(\$vwtr, F_SETFD, 0): $!";
170 '--leak-resolution=high',
171 '--num-callers=' . $callers,
173 '--log-fd=' . fileno($vwtr)
175 unless ($args{no_supp}) {
176 for (Test::Valgrind::Suppressions::supp_path(), $args{supp}) {
177 push @args, '--suppressions=' . $_ if $_;
180 if (defined $args{extra} and ref $args{extra} eq 'ARRAY') {
181 push @args, @{$args{extra}};
184 push @args, '-I' . $_ for @INC;
185 push @args, '-MTest::Valgrind=run,1', $file;
186 print STDOUT "valgrind @args\n";
187 local $ENV{PERL_DESTRUCT_LEVEL} = 3;
188 local $ENV{PERL_DL_NONLAZY} = 1;
189 exec { $args[0] } @args;
190 die "exec @args: $!";
192 local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
193 $Test->plan(tests => 5) unless $args{no_test} or defined $Test->has_plan;
196 'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
198 my %res = map { $_ => 0 } @tests;
199 close $owtr or die "close(\$owtr): $!";
200 close $vwtr or die "close(\$vwtr): $!";
202 $Test->diag($_) if $args{diag};
203 if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
205 $Test->diag("Valgrind error: $err");
206 $res{$_} = undef for @tests;
208 if (/ERROR\s+SUMMARY\s*:\s+(\d+)/) {
209 $res{errors} = int $1;
210 } elsif (/([a-z][a-z\s]*[a-z])\s*:\s*([\d.,]+)/) {
211 my ($cat, $count) = ($1, $2);
212 if (exists $res{$cat}) {
215 $res{$cat} = int $count;
220 $Test->diag(do { local $/; <$ordr> }) if $args{diag};
221 close $ordr or die "close(\$ordr): $!";
223 my $cb = ($args{no_test} ? \&_counter
224 : ($args{cb} ? $args{cb} : \&_tester));
226 $failed -= $cb->($res{$_}, 'valgrind ' . $_) ? 1 : 0;
235 if ($run and eval { require DynaLoader; 1 }) {
237 DynaLoader::dl_unload_file($_) and push @rest, $_ for @DynaLoader::dl_librefs;
238 @DynaLoader::dl_librefs = @rest;
244 You can't use this module to test code given by the C<-e> command-line switch.
246 Perl 5.8 is notorious for leaking like there's no tomorrow, so the suppressions are very likely not to be very accurate on it. Anyhow, results will most likely be better if your perl is built with debugging enabled. Using the latest valgrind available will also help.
248 This module is not really secure. It's definitely not taint safe. That shouldn't be a problem for test files.
250 What your tests output to STDOUT is eaten unless you pass the C<diag> option, in which case it will be reprinted as diagnostics. STDERR is kept untouched.
254 Valgrind 3.1.0 (L<http://valgrind.org>).
256 L<Carp>, L<Fcntl>, L<POSIX> (core modules since perl 5) and L<Test::Builder> (since 5.6.2).
258 L<Perl::Destruct::Level>.
262 L<Devel::Leak>, L<Devel::LeakTrace>, L<Devel::LeakTrace::Fast>.
266 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
268 You can contact me by mail or on C<irc.perl.org> (vincent).
272 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
276 You can find documentation for this module with the perldoc command.
278 perldoc Test::Valgrind
280 =head1 ACKNOWLEDGEMENTS
282 Rafaƫl Garcia-Suarez, for writing and instructing me about the existence of L<Perl::Destruct::Level> (Elizabeth Mattijsen is a close second).
284 H.Merijn Brand, for daring to test this thing.
286 =head1 COPYRIGHT & LICENSE
288 Copyright 2008-2009 Vincent Pit, all rights reserved.
290 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
294 1; # End of Test::Valgrind