1 package Test::Valgrind;
10 use Perl::Destruct::Level level => 3;
12 use Test::Valgrind::Suppressions;
16 Test::Valgrind - Test Perl code through valgrind.
24 our $VERSION = '0.04';
29 eval 'use Test::Valgrind';
30 plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@;
32 # Code to inspect for memory leaks/errors.
36 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.
38 You can also use it from the command-line to test a given script :
40 perl -MTest::Valgrind leaky.pl
44 You can pass parameters to C<import> as a list of key / value pairs, where valid keys are :
48 =item C<< supp => $file >>
50 Also use suppressions from C<$file> besides perl's.
52 =item C<< no_supp => $bool >>
54 If true, do not use any suppressions.
56 =item C<< callers => $number >>
58 Specify the maximum stack depth studied when valgrind encounters an error. Raising this number improves granularity. Default is 50.
60 =item C<< extra => [ @args ] >>
62 Add C<@args> to valgrind parameters.
64 =item C<< diag => $bool >>
66 If true, print the raw output of valgrind as diagnostics (may be quite verbose).
68 =item C<< no_test => $bool >>
70 If true, do not actually output the plan and the tests results.
80 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
82 if (!defined $args{run} && !$run) {
86 $next = (caller $l++)[1];
87 last unless defined $next;
90 return if not $file or $file eq '-e';
91 my $callers = $args{callers} || 50;
92 $callers = int $callers;
93 my $vg = Test::Valgrind::Suppressions::VG_PATH;
94 if (!$vg || !-x $vg) {
95 for (split /:/, $ENV{PATH}) {
103 plan skip_all => 'No valgrind executable could be found in your path';
107 pipe my $rdr, my $wtr or croak "pipe(\$rdr, \$wtr): $!";
111 } elsif ($pid == 0) {
112 setpgrp 0, 0 or croak "setpgrp(0, 0): $!";
113 close $rdr or croak "close(\$rdr): $!";
114 open STDERR, '>&', $wtr or croak "open(STDERR, '>&', \$wtr): $!";
118 '--leak-resolution=high',
119 '--num-callers=' . $callers,
122 unless ($args{no_supp}) {
123 for (Test::Valgrind::Suppressions::supp_path(), $args{supp}) {
124 push @args, '--suppressions=' . $_ if $_;
127 if (defined $args{extra} and ref $args{extra} eq 'ARRAY') {
128 push @args, @{$args{extra}};
131 push @args, '-I' . $_ for @INC;
132 push @args, '-MTest::Valgrind=run,1', $file;
133 print STDERR "valgrind @args\n" if $args{diag};
134 local $ENV{PERL_DESTRUCT_LEVEL} = 3;
135 local $ENV{PERL_DL_NONLAZY} = 1;
136 exec $vg, @args if $vg and -x $vg;
138 close $wtr or croak "close(\$wtr): $!";
139 local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
140 plan tests => 5 unless $args{no_test};
143 'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
145 my %res = map { $_ => 0 } @tests;
147 diag $_ if $args{diag};
148 if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
150 diag "Valgrind error: $err";
151 $res{$_} = undef for @tests;
153 if (/ERROR\s+SUMMARY\s*:\s+(\d+)/) {
154 $res{errors} = int $1;
155 } elsif (/([a-z][a-z\s]*[a-z])\s*:\s*([\d.,]+)/) {
156 my ($cat, $count) = ($1, $2);
157 if (exists $res{$cat}) {
160 $res{$cat} = int $count;
167 is($res{$_}, 0, 'valgrind ' . $_) unless $args{no_test};
168 ++$failed if defined $res{$_} and $res{$_} != 0;
178 You can't use this module to test code given by the C<-e> command-line switch.
180 Results will most likely be better if your perl is built with debugging enabled. Using the latest valgrind available will also help.
182 This module is not really secure. It's definitely not taint safe. That shouldn't be a problem for test files.
184 If your tests output to STDERR, everything will be eaten in the process. In particular, running this module against test files will obliterate their original test results.
188 Valgrind 3.1.0 (L<http://valgrind.org>).
190 L<Carp>, L<POSIX> (core modules since perl 5) and L<Test::More> (since 5.6.2).
192 L<Perl::Destruct::Level>.
196 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
198 You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
202 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.
206 You can find documentation for this module with the perldoc command.
208 perldoc Test::Valgrind
210 =head1 ACKNOWLEDGEMENTS
212 Rafaƫl Garcia-Suarez, for writing and instructing me about the existence of L<Perl::Destruct::Level> (Elizabeth Mattijsen is a close second).
214 H.Merijn Brand, for daring to test this thing.
216 =head1 COPYRIGHT & LICENSE
218 Copyright 2008 Vincent Pit, all rights reserved.
220 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
224 1; # End of Test::Valgrind