X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FValgrind%2FSuppressions.pm;h=1790243a00d82f0ca254d66edfc2f28f6c14634f;hb=a7f76c8c630e9273e6b8c72f884e7fe012da116e;hp=59c53559c35c134fd32da9e8800affa72847ac31;hpb=1b06adb9788085e8aad3af42ea384153cd0a4fe6;p=perl%2Fmodules%2FTest-Valgrind.git diff --git a/lib/Test/Valgrind/Suppressions.pm b/lib/Test/Valgrind/Suppressions.pm index 59c5355..1790243 100644 --- a/lib/Test/Valgrind/Suppressions.pm +++ b/lib/Test/Valgrind/Suppressions.pm @@ -9,11 +9,11 @@ Test::Valgrind::Suppressions - Generate suppressions for given tool and command. =head1 VERSION -Version 1.02 +Version 1.12 =cut -our $VERSION = '1.02'; +our $VERSION = '1.12'; =head1 DESCRIPTION @@ -88,6 +88,77 @@ sub generate { return $status; } +=head2 C + +Removes all wildcard frames at the end of the suppression. +Moreover, C<'...'> is appended when C C<3.4.0> or higher is used. +Returns the mangled suppression. + +=cut + +sub strip_tail { + shift; + + my ($sess, $supp) = @_; + + 1 while $supp =~ s/[^\r\n]*:\s*\*\s*$//; + # With valgrind 3.4.0, we can replace unknown series of frames by '...' + if ($sess->version ge '3.4.0') { + 1 while $supp =~ s/[^\r\n]*\.{3}\s*$//; + $supp .= "...\n"; + } + + $supp; +} + +=head2 C + +If C<$symbol> is Z-encoded as described in C's F, extract and decode its function name part. +Otherwise, C<$symbol> is returned as is. + +This routine follows C's F. + +=cut + +my %z_escapes = ( + a => '*', + c => ':', + d => '.', + h => '-', + p => '+', + s => ' ', + u => '_', + A => '@', + D => '$', + L => '(', + R => ')', + Z => 'Z', +); + +sub maybe_z_demangle { + my ($self, $sym) = @_; + + $sym =~ s/^_vg[rwn]Z([ZU])_// or return $sym; + + my $fn_is_encoded = $1 eq 'Z'; + + $sym =~ /^VG_Z_/ and $self->_croak('Symbol with a "VG_Z_" prefix is invalid'); + $sym =~ s/^[^_]*_// + or $self->_croak('Symbol doesn\'t contain a function name'); + + if ($fn_is_encoded) { + $sym =~ s/Z(.)/ + my $c = $z_escapes{$1}; + $self->_croak('Invalid escape sequence') unless defined $c; + $c; + /ge; + } + + $self->_croak('Empty symbol') unless length $sym; + + return $sym; +} + =head1 SEE ALSO L, L, L, L. @@ -111,7 +182,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2008-2009 Vincent Pit, all rights reserved. +Copyright 2008-2009,2010 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.