]> git.vpit.fr Git - perl/modules/Test-Valgrind.git/blob - lib/Test/Valgrind.pm
Improve Test::Valgrind front documentation
[perl/modules/Test-Valgrind.git] / lib / Test / Valgrind.pm
1 package Test::Valgrind;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 Test::Valgrind - Generate suppressions, analyse and test any command with valgrind.
9
10 =head1 VERSION
11
12 Version 1.11
13
14 =cut
15
16 our $VERSION = '1.11';
17
18 =head1 SYNOPSIS
19
20     # From the command-line
21     perl -MTest::Valgrind leaky.pl
22
23     # From the command-line, snippet style
24     perl -MTest::Valgrind -e 'leaky()'
25
26     # In a test file
27     use Test::More;
28     eval 'use Test::Valgrind';
29     plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' if $@;
30     leaky();
31
32     # In all the test files of a directory
33     prove --exec 'perl -Iblib/lib -Iblib/arch -MTest::Valgrind' t/*.t
34
35 =head1 DESCRIPTION
36
37 This module is a front-end to the C<Test::Valgrind::*> API that lets you run Perl code through the C<memcheck> tool of the C<valgrind> memory debugger, to test for memory errors and leaks.
38 If they aren't available yet, it will first generate suppressions for the current C<perl> interpreter and store them in the portable flavour of F<~/.perl/Test-Valgrind/suppressions/$VERSION>.
39 The actual run will then take place, and tests will be passed or failed according to the result of the analysis.
40
41 The complete API is much more versatile than this.
42 By declaring an appropriate L<Test::Valgrind::Command> class, you can run any executable (that is, not only Perl scripts) under valgrind, generate the corresponding suppressions on-the-fly and convert the analysis result to TAP output so that it can be incorporated into your project's testsuite.
43 If you're not interested in producing TAP, you can output the results in whatever format you like (for example HTML pages) by defining your own L<Test::Valgrind::Action> class.
44
45 Due to the nature of perl's memory allocator, this module can't track leaks of Perl objects.
46 This includes non-mortalized scalars and memory cycles.
47 However, it can track leaks of chunks of memory allocated in XS extensions with C<Newx> and friends or C<malloc>.
48 As such, it's complementary to the other very good leak detectors listed in the L</SEE ALSO> section.
49
50 =head1 METHODS
51
52 =head2 C<analyse [ %options ]>
53
54 Run a C<valgrind> analysis configured by C<%options> :
55
56 =over 4
57
58 =item *
59
60 C<< command => $command >>
61
62 The L<Test::Valgrind::Command> object (or class name) to use.
63
64 Defaults to L<Test::Valgrind::Command::PerlScript>.
65
66 =item *
67
68 C<< tool => $tool >>
69
70 The L<Test::Valgrind::Tool> object (or class name) to use.
71
72 Defaults to L<Test::Valgrind::Tool::memcheck>.
73
74 =item *
75
76 C<< action => $action >>
77
78 The L<Test::Valgrind::Action> object (or class name) to use.
79
80 Defaults to L<Test::Valgrind::Action::Test>.
81
82 =item *
83
84 C<< file => $file >>
85
86 The file name of the script to analyse.
87
88 Ignored if you supply your own custom C<command>, but mandatory otherwise.
89
90 =item *
91
92 C<< callers => $number >>
93
94 Specify the maximum stack depth studied when valgrind encounters an error.
95 Raising this number improves granularity.
96
97 Ignored if you supply your own custom C<tool>, otherwise defaults to C<12>.
98
99 =item *
100
101 C<< diag => $bool >>
102
103 If true, print the output of the test script as diagnostics.
104
105 Ignored if you supply your own custom C<action>, otherwise defaults to false.
106
107 =item *
108
109 C<< extra_supps => \@files >>
110
111 Also use suppressions from C<@files> besides C<perl>'s.
112
113 Defaults to empty.
114
115 =item *
116
117 C<< no_def_supp => $bool >>
118
119 If true, do not use the default suppression file.
120
121 Defaults to false.
122
123 =back
124
125 =cut
126
127 sub analyse {
128  shift;
129
130  my %args = @_;
131
132  my $instanceof = sub {
133   require Scalar::Util;
134   Scalar::Util::blessed($_[0]) && $_[0]->isa($_[1]);
135  };
136
137  my $cmd = delete $args{command};
138  unless ($cmd->$instanceof('Test::Valgrind::Command')) {
139   require Test::Valgrind::Command;
140   $cmd = Test::Valgrind::Command->new(
141    command => $cmd || 'PerlScript',
142    file    => delete $args{file},
143    args    => [ '-MTest::Valgrind=run,1' ],
144   );
145  }
146
147  my $tool = delete $args{tool};
148  unless ($tool->$instanceof('Test::Valgrind::Tool')) {
149   require Test::Valgrind::Tool;
150   $tool = Test::Valgrind::Tool->new(
151    tool     => $tool || 'memcheck',
152    callers  => delete $args{callers},
153   );
154  }
155
156  my $action = delete $args{action};
157  unless ($action->$instanceof('Test::Valgrind::Action')) {
158   require Test::Valgrind::Action;
159   $action = Test::Valgrind::Action->new(
160    action => $action || 'Test',
161    diag   => delete $args{diag},
162   );
163  }
164
165  require Test::Valgrind::Session;
166  my $sess = eval {
167   Test::Valgrind::Session->new(
168    min_version => $tool->requires_version,
169    map { $_ => delete $args{$_} } qw/extra_supps no_def_supp/
170   );
171  };
172  unless ($sess) {
173   my $err = $@;
174   $err =~ s/^(Empty valgrind candidates list|No appropriate valgrind executable could be found)\s+at.*/$1/;
175   $action->abort($sess, $err);
176   return $action->status($sess);
177  }
178
179  eval {
180   $sess->run(
181    command => $cmd,
182    tool    => $tool,
183    action  => $action,
184   );
185  };
186  if ($@) {
187   require Test::Valgrind::Report;
188   $action->report($sess, Test::Valgrind::Report->new_diag($@));
189  }
190
191  my $status = $sess->status;
192  $status = 255 unless defined $status;
193
194  return $status;
195 }
196
197 =head2 C<import [ %options ]>
198
199 In the parent process, L</import> calls L</analyse> with the arguments it received itself - except that if no C<file> option was supplied, it tries to pick the first caller context that looks like a script.
200 When the analysis ends, it exits with the status returned by the action (for the default TAP-generator action, it's the number of failed tests).
201
202 In the child process, it just C<return>s so that the calling code is actually run under C<valgrind>, albeit two side-effects :
203
204 =over 4
205
206 =item *
207
208 L<Perl::Destruct::Level> is loaded and the destruction level is set to C<3>.
209
210 =item *
211
212 Autoflush on C<STDOUT> is turned on.
213
214 =back
215
216 =cut
217
218 # We use as little modules as possible in run mode so that they don't pollute
219 # the analysis. Hence all the requires.
220
221 my $run;
222
223 sub import {
224  my $class = shift;
225  $class = ref($class) || $class;
226
227  if (@_ % 2) {
228   require Carp;
229   Carp::croak('Optional arguments must be passed as key => value pairs');
230  }
231  my %args = @_;
232
233  if (defined delete $args{run} or $run) {
234   require Perl::Destruct::Level;
235   Perl::Destruct::Level::set_destruct_level(3);
236   {
237    my $oldfh = select STDOUT;
238    $|++;
239    select $oldfh;
240   }
241   $run = 1;
242   return;
243  }
244
245  my $file = delete $args{file};
246  unless (defined $file) {
247   my ($next, $last_pm);
248   for (my $l = 0; 1; ++$l) {
249    $next = (caller $l)[1];
250    last unless defined $next;
251    next if $next =~ /^\s*\(\s*eval\s*\d*\s*\)\s*$/;
252    if ($next =~ /\.pmc?$/) {
253     $last_pm = $next;
254    } else {
255     $file = $next;
256     last;
257    }
258   }
259   $file = $last_pm unless defined $file;
260  }
261
262  unless (defined $file) {
263   require Test::Builder;
264   Test::Builder->new->diag('Couldn\'t find a valid source file');
265   return;
266  }
267
268  if ($file ne '-e') {
269   exit $class->analyse(
270    file => $file,
271    %args,
272   );
273  }
274
275  require File::Temp;
276  my $tmp = File::Temp->new;
277
278  require Filter::Util::Call;
279  Filter::Util::Call::filter_add(sub {
280   my $status = Filter::Util::Call::filter_read();
281   if ($status > 0) {
282    print $tmp $_;
283   } elsif ($status == 0) {
284    close $tmp;
285    my $code = $class->analyse(
286     file => $tmp->filename,
287     %args,
288    );
289    exit $code;
290   }
291   $status;
292  });
293 }
294
295 =head1 VARIABLES
296
297 =head2 C<$dl_unload>
298
299 When set to true, all dynamic extensions that were loaded during the analysis will be unloaded at C<END> time by L<DynaLoader/dl_unload_file>.
300
301 Since this obfuscates error stack traces, it's disabled by default.
302
303 =cut
304
305 our $dl_unload;
306
307 END {
308  if ($dl_unload and $run and eval { require DynaLoader; 1 }) {
309   my @rest;
310   DynaLoader::dl_unload_file($_) or push @rest, $_ for @DynaLoader::dl_librefs;
311   @DynaLoader::dl_librefs = @rest;
312  }
313 }
314
315 =head1 CAVEATS
316
317 Perl 5.8 is notorious for leaking like there's no tomorrow, so the suppressions are very likely not to be complete on it.
318 You also have a better chance to get more accurate results if your perl is built with debugging enabled.
319 Using the latest C<valgrind> available will also help.
320
321 This module is not really secure.
322 It's definitely not taint safe.
323 That shouldn't be a problem for test files.
324
325 What your tests output to C<STDOUT> and C<STDERR> is eaten unless you pass the C<diag> option, in which case it will be reprinted as diagnostics.
326
327 =head1 DEPENDENCIES
328
329 L<XML::Twig>, L<version>, L<File::HomeDir>, L<Env::Sanctify>, L<Perl::Destruct::Level>.
330
331 =head1 SEE ALSO
332
333 All the C<Test::Valgrind::*> API, including L<Test::Valgrind::Command>, L<Test::Valgrind::Tool>, L<Test::Valgrind::Action> and L<Test::Valgrind::Session>.
334
335 The C<valgrind(1)> man page.
336
337 L<Test::LeakTrace>.
338
339 L<Devel::Leak>, L<Devel::LeakTrace>, L<Devel::LeakTrace::Fast>.
340
341 =head1 AUTHOR
342
343 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
344
345 You can contact me by mail or on C<irc.perl.org> (vincent).
346
347 =head1 BUGS
348
349 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>.
350 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
351
352 =head1 SUPPORT
353
354 You can find documentation for this module with the perldoc command.
355
356     perldoc Test::Valgrind
357
358 =head1 ACKNOWLEDGEMENTS
359
360 RafaE<euml>l Garcia-Suarez, for writing and instructing me about the existence of L<Perl::Destruct::Level> (Elizabeth Mattijsen is a close second).
361
362 H.Merijn Brand, for daring to test this thing.
363
364 All you people that showed interest in this module, which motivated me into completely rewriting it.
365
366 =head1 COPYRIGHT & LICENSE
367
368 Copyright 2008-2009 Vincent Pit, all rights reserved.
369
370 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
371
372 =cut
373
374 1; # End of Test::Valgrind