=head1 NAME
-Test::Valgrind::Suppressions - Placeholder for architecture-dependant perl suppressions.
+Test::Valgrind::Suppressions - Generate suppressions for given tool and command.
=head1 VERSION
-Version 0.08
+Version 1.17
=cut
-our $VERSION = '0.08';
+our $VERSION = '1.17';
=head1 DESCRIPTION
-L<Test::Valgrind> needs suppressions so that perl's errors aren't reported. However, these suppressions depend widely on the architecture, perl's version and the features it has been build with (e.g. threads). The goal of this module is hence to be installed together with the suppression file generated when the Test-Valgrind distribution was built, and to handle back to L<Test::Valgrind> the path to the suppression file.
+This module is an helper for generating suppressions.
-=head1 FUNCTIONS
+=cut
+
+use base qw<Test::Valgrind::Carp>;
+
+=head1 METHODS
-=head2 C<supp_path>
+=head2 C<generate>
-Returns the path to the suppression file that applies to the current running perl, or C<undef> when no such file is available.
+ Test::Valgrind::Suppressions->generate(
+ tool => $tool,
+ command => $command,
+ target => $target,
+ );
+
+Generates suppressions for the command C<< $command->new_trainer >> and the tool C<< $tool->new_trainer >>, and writes them in the file specified by C<$target>.
+The action used behind the scenes is L<Test::Valgrind::Action::Suppressions>.
+
+Returns the status code.
=cut
-sub supp_path {
- my $pkg = __PACKAGE__;
- $pkg =~ s!::!/!g;
- $pkg .= '.pm';
- return if not $INC{$pkg};
- my $supp = $INC{$pkg};
- $supp =~ s![^/]*$!perlTestValgrind.supp!;
- return (-f $supp) ? $supp : undef;
+sub generate {
+ my $self = shift;
+
+ my %args = @_;
+
+ my $cmd = delete $args{command};
+ unless (ref $cmd) {
+ require Test::Valgrind::Command;
+ $cmd = Test::Valgrind::Command->new(
+ command => $cmd,
+ args => [ ],
+ );
+ }
+ $cmd = $cmd->new_trainer;
+ return unless defined $cmd;
+
+ my $tool = delete $args{tool};
+ unless (ref $tool) {
+ require Test::Valgrind::Tool;
+ $tool = Test::Valgrind::Tool->new(tool => $tool);
+ }
+ $tool = $tool->new_trainer;
+ return unless defined $tool;
+
+ my $target = delete $args{target};
+ $self->_croak('Invalid target') unless $target and not ref $target;
+
+ require Test::Valgrind::Action;
+ my $action = Test::Valgrind::Action->new(
+ action => 'Suppressions',
+ target => $target,
+ name => 'PerlSuppression',
+ );
+
+ require Test::Valgrind::Session;
+ my $sess = Test::Valgrind::Session->new(
+ min_version => $tool->requires_version,
+ );
+
+ eval {
+ $sess->run(
+ command => $cmd,
+ tool => $tool,
+ action => $action,
+ );
+ };
+ $self->_croak($@) if $@;
+
+ my $status = $sess->status;
+ $status = 255 unless defined $status;
+
+ return $status;
}
-=head1 CONSTANTS
+=head2 C<maybe_generalize>
-=head2 C<VG_PATH>
+ my $mangled_suppression = Test::Valgrind::Suppressions->maybe_generalize(
+ $session,
+ $suppression,
+ );
-The path to the valgrind binary from which the suppressions were generated.
+Removes all wildcard frames at the end of the suppression.
+It also replaces sequences of wildcard frames by C<'...'> when C<valgrind> C<3.4.0> or higher is used.
+Returns the mangled suppression.
=cut
-use constant VG_PATH => undef;
+sub maybe_generalize {
+ shift;
-=head1 EXPORT
+ my ($sess, $supp) = @_;
-This module exports the L</supp_path> function and the L</VG_PATH> constants only on demand, either by giving their name explicitely or by the C<:funcs>, C<:consts> or C<:all> tags.
+ 1 while $supp =~ s/[^\r\n]*:\s*\*\s*$//;
-=cut
+ # With valgrind 3.4.0, we can replace unknown series of frames by '...'
+ if ($sess->version ge '3.4.0') {
+ $supp .= "...\n";
+ $supp =~ s/(?:^\s*(?:\.{3}|\*:\S*|obj:\*)\s*\n)+/...\n/mg;
+ }
+
+ $supp;
+}
+
+=head2 C<maybe_z_demangle>
+
+ my $demangled_symbol = Test::Valgrind::Suppressions->maybe_z_demangle(
+ $symbol,
+ );
+
+If C<$symbol> is Z-encoded as described in C<valgrind>'s F<include/pub_tool_redir.h>, extract and decode its function name part.
+Otherwise, C<$symbol> is returned as is.
-use base qw/Exporter/;
+This routine follows C<valgrind>'s F<coregrind/m_demangle/demangle.c:maybe_Z_demangle>.
-our @EXPORT = ();
-our %EXPORT_TAGS = (
- 'funcs' => [ qw/supp_path/ ],
- 'consts' => [ qw/VG_PATH/ ]
+=cut
+
+my %z_escapes = (
+ a => '*',
+ c => ':',
+ d => '.',
+ h => '-',
+ p => '+',
+ s => ' ',
+ u => '_',
+ A => '@',
+ D => '$',
+ L => '(',
+ R => ')',
+ Z => 'Z',
);
-our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+
+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<Test::Valgrind>.
+L<Test::Valgrind>, L<Test::Valgrind::Command>, L<Test::Valgrind::Tool>, L<Test::Valgrind::Action::Suppressions>.
=head1 AUTHOR
=head1 BUGS
-Please report any bugs or feature requests to C<bug-test-valgrind-suppressions 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.
+Please report any bugs or feature requests to C<bug-test-valgrind-suppressions 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.
=head1 SUPPORT
=head1 COPYRIGHT & LICENSE
-Copyright 2008-2009 Vincent Pit, all rights reserved.
+Copyright 2008,2009,2010,2011,2013,2015 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.
projects / perl / modules / Test-Valgrind.git / blobdiff