File Coverage

blib/lib/Test/Valgrind/Tool/memcheck.pm
Criterion Covered Total %
statement 34 67 50.7
branch 2 18 11.1
condition 4 16 25.0
subroutine 11 17 64.7
pod 8 8 100.0
total 59 126 46.8


line stmt bran cond sub pod time code
1             package Test::Valgrind::Tool::memcheck;
2              
3 7     7   2319 use strict;
  7         13  
  7         174  
4 7     7   34 use warnings;
  7         14  
  7         307  
5              
6             =head1 NAME
7              
8             Test::Valgrind::Tool::memcheck - Run an analysis through the memcheck tool.
9              
10             =head1 VERSION
11              
12             Version 1.18
13              
14             =cut
15              
16             our $VERSION = '1.18';
17              
18             =head1 DESCRIPTION
19              
20             This class contains the information required by the session for running the C tool.
21              
22             =cut
23              
24 7     7   31 use base qw;
  7         21  
  7         3719  
25              
26             =head1 METHODS
27              
28             This class inherits L.
29              
30             =head2 C
31              
32             my $required_version = $tvt->requires_version;
33              
34             This tool requires C C<3.1.0>.
35              
36             =cut
37              
38 5     5 1 47 sub requires_version { '3.1.0' }
39              
40             =head2 C
41              
42             my $tvtm = Test::Valgrind::Tool::memcheck->new(
43             callers => $callers,
44             %extra_args,
45             );
46              
47             Your usual constructor.
48              
49             C<$callers> specifies the number of stack frames to inspect for errors : the bigger you set it, the more granular the analysis is.
50              
51             Other arguments are passed straight to C<< Test::Valgrind::Tool->new >>.
52              
53             =cut
54              
55             sub new {
56 7     7 1 78 my $class = shift;
57 7   33     62 $class = ref($class) || $class;
58              
59 7         17 my %args = @_;
60              
61 7   50     44 my $callers = delete $args{callers} || 50;
62 7         23 $callers =~ s/\D//g;
63              
64 7         54 my $self = bless $class->Test::Valgrind::Tool::new(%args), $class;
65              
66 7         45 $self->{callers} = $callers;
67              
68 7         29 $self;
69             }
70              
71 0     0 1 0 sub new_trainer { shift->new(callers => 50) }
72              
73             =head2 C
74              
75             my $callers = $tvtm->callers;
76              
77             Read-only accessor for the C option.
78              
79             =cut
80              
81 2     2 1 90 sub callers { $_[0]->{callers} }
82              
83 0     0 1 0 sub suppressions_tag { 'memcheck-' . $_[1]->version }
84              
85             =head2 C
86              
87             my $parser_class = $tvtm->parser_class($session);
88              
89             This tool uses a L parser in analysis mode, and a L parser in suppressions mode.
90              
91             =cut
92              
93             sub parser_class {
94 0     0 1 0 my ($self, $session) = @_;
95              
96 0 0       0 my $class = $session->do_suppressions
97             ? 'Test::Valgrind::Parser::Suppressions::Text'
98             : 'Test::Valgrind::Parser::XML::Twig';
99              
100             {
101 0         0 local $@;
  0         0  
102 0 0       0 eval "require $class; 1" or die $@;
103             }
104              
105 0         0 return $class;
106             }
107              
108             =head2 C
109              
110             my $report_class = $tvtm->report_class($session);
111              
112             This tool emits C object reports in analysis mode, and C object reports in suppressions mode.
113              
114             =cut
115              
116             sub report_class {
117 10     10 1 28 my ($self, $session) = @_;
118              
119 10 50       52 if ($session->do_suppressions) {
120 0         0 require Test::Valgrind::Parser::Suppressions::Text;
121 0         0 return 'Test::Valgrind::Report::Suppressions';
122             } else {
123 10         334 return 'Test::Valgrind::Tool::memcheck::Report';
124             }
125             }
126              
127             sub args {
128 2     2 1 18 my $self = shift;
129 2         27 my ($sess) = @_;
130              
131 2         109 my @args = (
132             '--tool=memcheck',
133             '--leak-check=full',
134             '--leak-resolution=high',
135             '--show-reachable=yes',
136             '--num-callers=' . $self->callers,
137             '--error-limit=yes',
138             );
139              
140 2 50 33     104 push @args, '--track-origins=yes' if $sess->version >= '3.4.0'
141             and not $sess->do_suppressions;
142              
143 2         90 push @args, $self->SUPER::args(@_);
144              
145 2         150 return @args;
146             }
147              
148             =head1 SEE ALSO
149              
150             L, L.
151              
152             =head1 AUTHOR
153              
154             Vincent Pit, C<< >>, L.
155              
156             You can contact me by mail or on C (vincent).
157              
158             =head1 BUGS
159              
160             Please report any bugs or feature requests to C, or through the web interface at L.
161             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
162              
163             =head1 SUPPORT
164              
165             You can find documentation for this module with the perldoc command.
166              
167             perldoc Test::Valgrind::Tool::memcheck
168              
169             =head1 COPYRIGHT & LICENSE
170              
171             Copyright 2009,2010,2011,2013,2015 Vincent Pit, all rights reserved.
172              
173             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
174              
175             =cut
176              
177             # End of Test::Valgrind::Tool::memcheck
178              
179             package Test::Valgrind::Tool::memcheck::Report;
180              
181 7     7   49 use base qw;
  7         26  
  7         3967  
182              
183             our $VERSION = '1.18';
184              
185             my @kinds = qw<
186             InvalidFree
187             MismatchedFree
188             InvalidRead
189             InvalidWrite
190             InvalidJump
191             Overlap
192             InvalidMemPool
193             UninitCondition
194             UninitValue
195             SyscallParam
196             ClientCheck
197             Leak_DefinitelyLost
198             Leak_IndirectlyLost
199             Leak_PossiblyLost
200             Leak_StillReachable
201             >;
202             push @kinds, __PACKAGE__->SUPER::kinds();
203              
204             my %kinds_hashed = map { $_ => 1 } @kinds;
205              
206 0     0   0 sub kinds { @kinds }
207              
208 10     10   60 sub valid_kind { exists $kinds_hashed{$_[1]} }
209              
210 0 0   0     sub is_leak { $_[0]->kind =~ /^Leak_/ ? 1 : '' }
211              
212             my $pad;
213             BEGIN {
214 7     7   40 require Config;
215 7   50     2749 $pad = 2 * ($Config::Config{ptrsize} || 4);
216             }
217              
218             sub dump {
219 0     0     my ($self) = @_;
220              
221 0           my $data = $self->data;
222              
223 0           my $desc = '';
224              
225 0           for ([ '', 2, 4 ], [ 'aux', 4, 6 ], [ 'orig', 4, 6 ]) {
226 0           my ($prefix, $wind, $sind) = @$_;
227              
228 0           my ($what, $stack) = @{$data}{"${prefix}what", "${prefix}stack"};
  0            
229 0 0 0       next unless defined $what and defined $stack;
230              
231 0           $_ = ' ' x $_ for $wind, $sind;
232              
233 0           $desc .= "$wind$what\n";
234 0           for (@$stack) {
235 0 0         my ($ip, $obj, $fn, $dir, $file, $line) = map { (defined) ? $_ : '?' } @$_;
  0            
236 0           my $frame;
237 0 0 0       if ($fn eq '?' and $obj eq '?') {
238 0           $ip =~ s/^0x//gi;
239 0           my $l = length $ip;
240 0 0         $frame = '0x' . ($l < $pad ? ('0' x ($pad - $l)) : '') . uc($ip);
241             } else {
242 0           $frame = sprintf '%s (%s) [%s:%s]', $fn, $obj, $file, $line;
243             }
244 0           $desc .= "$sind$frame\n";
245             }
246             }
247              
248 0           return $desc;
249             }
250              
251             # End of Test::Valgrind::Tool::memcheck::Report
252