1 package Test::Valgrind;
10 use Test::Valgrind::Suppressions;
14 Test::Valgrind - Test your code through valgrind.
22 our $VERSION = '0.01';
27 eval 'use Test::Valgrind';
28 plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind';
30 # Code to inspect for memory leaks/errors.
34 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 pass parameters to C<import> as a list of key / value pairs, where valid keys are :
42 =item C<< supp => $file >>
44 Also use suppressions from C<$file> besides perl's.
46 =item C<< no_supp => $bool >>
48 If true, do not use any suppressions.
50 =item C<< callers => $number >>
52 Specify the maximum stack depth studied when valgrind encounters an error. Raising this number improves granularity. Default is 50.
54 =item C<< extra => [ @args ] >>
56 Add C<@args> to valgrind parameters.
58 =item C<< diag => $bool >>
60 If true, print the raw output of valgrind as diagnostics (may be quite verbose).
62 =item C<< no_test => $bool >>
64 If true, do not actually output the plan and the tests results.
74 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
76 if (!defined $args{run} && !$run) {
80 $next = (caller $l++)[1];
81 last unless defined $next;
84 return if not $file or $file eq '-e';
86 for (split /:/, $ENV{PATH}) {
87 my $vg = $_ . '/valgrind';
94 plan skip_all => 'No valgrind executable could be found in your path';
97 my $callers = $args{callers} || 50;
98 $callers = int $callers;
99 pipe my $rdr, my $wtr or croak "pipe(\$rdr, \$wtr): $!";
103 } elsif ($pid == 0) {
104 setpgrp 0, 0 or croak "setpgrp(0, 0): $!";
105 close $rdr or croak "close(\$rdr): $!";
106 open STDERR, '>&', $wtr or croak "open(STDERR, '>&', \$wtr): $!";
110 '--leak-resolution=high',
111 '--num-callers=' . $callers,
114 unless ($args{no_supp}) {
115 for (Test::Valgrind::Suppressions::supppath(), $args{supp}) {
116 push @args, '--suppressions=' . $_ if $_;
119 if (defined $args{extra} and ref $args{extra} eq 'ARRAY') {
120 push @args, @{$args{extra}};
123 push @args, '-I' . $_ for @INC;
124 push @args, '-MTest::Valgrind=run,1', $file;
125 print STDERR "valgrind @args\n" if $args{diag};
126 local $ENV{PERL_DESTRUCT_LEVEL} = 3;
127 local $ENV{PERL_DL_NONLAZY} = 1;
128 exec 'valgrind', @args;
130 close $wtr or croak "close(\$wtr): $!";
131 local $SIG{INT} = sub { kill -(SIGTERM) => $pid };
132 plan tests => 5 unless $args{no_test};
135 'definitely lost', 'indirectly lost', 'possibly lost', 'still reachable'
137 my %res = map { $_ => 0 } @tests;
139 diag $_ if $args{diag};
140 if (/^=+\d+=+\s*FATAL\s*:\s*(.*)/) {
142 diag "Valgrind error: $err";
143 $res{$_} = undef for @tests;
145 if (/ERROR\s+SUMMARY\s*:\s+(\d+)/) {
146 $res{errors} = int $1;
147 } elsif (/([a-z][a-z\s]*[a-z])\s*:\s*([\d.,]+)/) {
148 my ($cat, $count) = ($1, $2);
149 if (exists $res{$cat}) {
152 $res{$cat} = int $count;
159 is($res{$_}, 0, 'valgrind ' . $_) unless $args{no_test};
160 ++$failed if defined $res{$_} and $res{$_} != 0;
170 You can't use this module to test code given by the C<-e> command-line switch.
171 This module is not really secure. It's definitely not taint safe. That shouldn't be a problem for test files.
172 If your tests output to STDERR, everything will be eaten in the process.
176 Valgrind 3.1.0 (L<http://valgrind.org>).
178 L<Carp>, L<POSIX> (core modules since perl 5) and L<Test::More> (since 5.6.2).
182 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
184 You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
188 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.
192 You can find documentation for this module with the perldoc command.
194 perldoc Test::Valgrind
196 =head1 COPYRIGHT & LICENSE
198 Copyright 2008 Vincent Pit, all rights reserved.
200 This program is free software; you can redistribute it and/or modify it
201 under the same terms as Perl itself.
205 1; # End of Test::Valgrind