r34687 - in /trunk/libtest-valgrind-perl: ./ debian/ lib/Test/ lib/Test/Valgrind/ lib/Test/Valgrind/Action/ lib/Test/Valgrind/Command/ lib/Test/Valgrind/Tool/ t/ t/lib/Test/Valgrind/Test/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun May 3 01:31:40 UTC 2009
Author: jawnsy-guest
Date: Sun May 3 01:31:21 2009
New Revision: 34687
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34687
Log:
svn-upgraded. Added note to debian/control with respect to providing support for running any command (not just Perl commands) and providing TAP output.
Added:
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Aggregate.pm
- copied unchanged from r34686, branches/upstream/libtest-valgrind-perl/current/lib/Test/Valgrind/Command/Aggregate.pm
Modified:
trunk/libtest-valgrind-perl/Changes
trunk/libtest-valgrind-perl/MANIFEST
trunk/libtest-valgrind-perl/META.yml
trunk/libtest-valgrind-perl/Makefile.PL
trunk/libtest-valgrind-perl/README
trunk/libtest-valgrind-perl/debian/changelog
trunk/libtest-valgrind-perl/debian/control
trunk/libtest-valgrind-perl/lib/Test/Valgrind.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Captor.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Suppressions.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Test.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Carp.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Perl.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/PerlScript.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Report.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Session.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Suppressions.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/SuppressionsParser.pm
trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/memcheck.pm
trunk/libtest-valgrind-perl/t/92-pod-coverage.t
trunk/libtest-valgrind-perl/t/lib/Test/Valgrind/Test/Action.pm
Modified: trunk/libtest-valgrind-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/Changes?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/Changes (original)
+++ trunk/libtest-valgrind-perl/Changes Sun May 3 01:31:21 2009
@@ -1,4 +1,11 @@
Revision history for Test-Valgrind
+
+1.02 2009-05-02 12:05 UTC
+ + Add : Commands can now be aggregated.
+ + Add : The commands can now also filter and mangle reports.
+ + Chg : The perl suppressions are now stripped from everything below
+ Perl_runops_*.
+ + Doc : Typos, nits and clarifications.
1.01 2009-04-14 21:15 UTC
+ Add : Allow testing code given by -e. Hurray for source filters!
Modified: trunk/libtest-valgrind-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/MANIFEST?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/MANIFEST (original)
+++ trunk/libtest-valgrind-perl/MANIFEST Sun May 3 01:31:21 2009
@@ -11,6 +11,7 @@
lib/Test/Valgrind/Action/Test.pm
lib/Test/Valgrind/Carp.pm
lib/Test/Valgrind/Command.pm
+lib/Test/Valgrind/Command/Aggregate.pm
lib/Test/Valgrind/Command/Perl.pm
lib/Test/Valgrind/Command/PerlScript.pm
lib/Test/Valgrind/Report.pm
Modified: trunk/libtest-valgrind-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/META.yml?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/META.yml (original)
+++ trunk/libtest-valgrind-perl/META.yml Sun May 3 01:31:21 2009
@@ -1,7 +1,7 @@
--- #YAML:1.0
name: Test-Valgrind
-version: 1.01
-abstract: Test Perl code through valgrind.
+version: 1.02
+abstract: Generate suppressions, analyse and test any command with valgrind.
author:
- Vincent Pit <perl at profvince.com>
license: perl
@@ -57,7 +57,7 @@
bugtracker: http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind
homepage: http://search.cpan.org/dist/Test-Valgrind/
license: http://dev.perl.org/licenses/
- repository: http://git.profvince.com/perl/modules/Test-Valgrind.git
+ repository: http://git.profvince.com/?p=perl%2Fmodules%2FTest-Valgrind.git
no_index:
directory:
- t
Modified: trunk/libtest-valgrind-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/Makefile.PL?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/Makefile.PL (original)
+++ trunk/libtest-valgrind-perl/Makefile.PL Sun May 3 01:31:21 2009
@@ -103,7 +103,7 @@
bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
homepage => "http://search.cpan.org/dist/$dist/",
license => 'http://dev.perl.org/licenses/',
- repository => "http://git.profvince.com/perl/modules/$dist.git",
+ repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git",
},
);
Modified: trunk/libtest-valgrind-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/README?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/README (original)
+++ trunk/libtest-valgrind-perl/README Sun May 3 01:31:21 2009
@@ -1,8 +1,9 @@
NAME
- Test::Valgrind - Test Perl code through valgrind.
+ Test::Valgrind - Generate suppressions, analyse and test any command
+ with valgrind.
VERSION
- Version 1.01
+ Version 1.02
SYNOPSIS
# From the command-line
@@ -29,6 +30,11 @@
~/.perl/Test-Valgrind/suppressions/$VERSION. The actual run will then
take place, and tests will be passed or failed according to the result
of the analysis.
+
+ The complete API is much more versatile than this. It allows you to run
+ *any* executable under valgrind, generate the corresponding suppressions
+ and convert the analysis output to TAP so that it can be incorporated
+ into your project's testsuite.
Due to the nature of perl's memory allocator, this module can't track
leaks of Perl objects. This includes non-mortalized scalars and memory
@@ -96,8 +102,8 @@
"import [ %options ]"
In the parent process, "import" calls "analyse" with the arguments it
received itself - except that if no "file" option was supplied, it tries
- to pick the highest caller context that looks like a script. When the
- analyse finishes, it exists with the status that was returned.
+ to pick the first caller context that looks like a script. When the
+ analyse ends, it exits with the status that was returned.
In the child process, it just "return"s so that the calling code is
actually run under "valgrind".
@@ -105,7 +111,8 @@
VARIABLES
$dl_unload
When set to true, all dynamic extensions that were loaded during the
- analysis will be unloaded at "END" time by DynaLoader::dl_unload_file.
+ analysis will be unloaded at "END" time by "dl_unload_file" in
+ DynaLoader.
Since this obfuscates error stack traces, it's disabled by default.
Modified: trunk/libtest-valgrind-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/debian/changelog?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/debian/changelog (original)
+++ trunk/libtest-valgrind-perl/debian/changelog Sun May 3 01:31:21 2009
@@ -1,3 +1,9 @@
+libtest-valgrind-perl (1.02-1) unstable; urgency=low
+
+ * New upstream release. No major changes, except mostly documentation
+
+ -- Jonathan Yu <frequency at cpan.org> Sat, 02 May 2009 21:26:22 -0400
+
libtest-valgrind-perl (1.01-1) unstable; urgency=low
WAITS for libperl-destruct-level-perl (NEW) and libenv-sanctify-perl (TODO)
Modified: trunk/libtest-valgrind-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/debian/control?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/debian/control (original)
+++ trunk/libtest-valgrind-perl/debian/control Sun May 3 01:31:21 2009
@@ -25,3 +25,9 @@
However, it can track leaks of chunks of memory allocated in XS extensions
with Newx and friends or malloc. As such, it's complementary to the other
very good leak detectors such as Test::LeakTrace.
+ .
+ Additionally, this module can run arbitrary commands (not just Perl code)
+ and provide output compliant with Perl's Test Anything Protocol (TAP).
+ This means that any executable can be run under valgrind and incorporated
+ into your testsuite.
+
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind.pm Sun May 3 01:31:21 2009
@@ -5,15 +5,15 @@
=head1 NAME
-Test::Valgrind - Test Perl code through valgrind.
+Test::Valgrind - Generate suppressions, analyse and test any command with valgrind.
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 SYNOPSIS
@@ -37,6 +37,9 @@
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 it for memory errors and leaks.
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>.
The actual run will then take place, and tests will be passed or failed according to the result of the analysis.
+
+The complete API is much more versatile than this.
+It allows you to run I<any> executable under valgrind, generate the corresponding suppressions and convert the analysis output to TAP so that it can be incorporated into your project's testsuite.
Due to the nature of perl's memory allocator, this module can't track leaks of Perl objects.
This includes non-mortalized scalars and memory cycles. However, it can track leaks of chunks of memory allocated in XS extensions with C<Newx> and friends or C<malloc>.
@@ -189,8 +192,8 @@
=head2 C<import [ %options ]>
-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 highest caller context that looks like a script.
-When the analyse finishes, it exists with the status that was returned.
+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.
+When the analyse ends, it exits with the status that was returned.
In the child process, it just C<return>s so that the calling code is actually run under C<valgrind>.
@@ -277,7 +280,7 @@
=head2 C<$dl_unload>
-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>.
+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>.
Since this obfuscates error stack traces, it's disabled by default.
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Captor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Captor.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Captor.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Captor.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Suppressions.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Suppressions.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Suppressions.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Suppressions.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -82,28 +82,7 @@
$self->SUPER::start($sess);
- $self->{status} = undef;
- $self->{total} = 0;
- delete $self->{diagnostics};
-
- if ($self->{fh}) {
- close $self->{fh} or $self->_croak("close(\$self->{fh}): $!");
- }
-
- my $target = $self->target;
-
- require File::Spec;
- my ($vol, $dir, $file) = File::Spec->splitpath($target);
- my $base = File::Spec->catpath($vol, $dir, '');
- unless (-e $base) {
- require File::Path;
- File::Path::mkpath([ $base ]);
- } else {
- 1 while unlink $target;
- }
-
- open $self->{fh}, '>', $target
- or $self->_croak("open(\$self->{fh}, '>', \$self->target): $!");
+ delete @{$self}{qw/status supps diagnostics/};
$self->save_fh(\*STDOUT => '>' => undef);
$self->save_fh(\*STDERR => '>' => undef);
@@ -136,12 +115,7 @@
$self->SUPER::report($sess, $report);
- ++$self->{total};
-
- print { $self->{fh} } "{\n"
- . $self->name . $report->id . "\n"
- . $report->data
- . "}\n";
+ push @{$self->{supps}}, $report;
return;
}
@@ -153,11 +127,36 @@
$self->restore_all_fh;
- close $self->{fh} or $self->_croak("close(\$self->{fh}): $!");
-
print $self->{diagnostics} if defined $self->{diagnostics};
delete $self->{diagnostics};
- print "Found $self->{total} distinct suppressions\n";
+
+ my $target = $self->target;
+
+ require File::Spec;
+ my ($vol, $dir, $file) = File::Spec->splitpath($target);
+ my $base = File::Spec->catpath($vol, $dir, '');
+ unless (-e $base) {
+ require File::Path;
+ File::Path::mkpath([ $base ]);
+ } else {
+ 1 while unlink $target;
+ }
+
+ open my $fh, '>', $target
+ or $self->_croak("open(\$fh, '>', \$self->target): $!");
+
+ my (%seen, $id);
+ for (sort { $a->data cmp $b->data }
+ grep !$seen{$_->data}++, @{$self->{supps}}) {
+ print $fh "{\n"
+ . $self->name . ++$id . "\n"
+ . $_->data
+ . "}\n";
+ }
+
+ close $fh or $self->_croak("close(\$fh): $!");
+
+ print "Found $id distinct suppressions\n";
$self->{status} = 0;
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Test.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Test.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Action/Test.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 DESCRIPTION
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Carp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Carp.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Carp.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Carp.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
sub _croak {
shift;
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -50,7 +50,7 @@
}
my $args = delete $args{args};
- $class->_croak('Invalid argument list') unless $args and ref $args eq 'ARRAY';
+ $class->_croak('Invalid argument list') if $args and ref $args ne 'ARRAY';
bless {
args => $args,
@@ -98,6 +98,17 @@
sub suppressions_tag;
+=head2 C<filter $session, $report>
+
+The <$session> calls this method after receiving a report from the tool and before forwarding it to the action.
+You can either return a mangled C<$report> (which does not need to be a clone of the original) or C<undef> if you want the action to ignore it completely.
+
+Defaults to the identity function.
+
+=cut
+
+sub filter { $_[2] }
+
=head1 SEE ALSO
L<Test::Valgrind>, L<Test::Valgrind::Session>.
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Perl.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Perl.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Perl.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/Perl.pm Sun May 3 01:31:21 2009
@@ -9,14 +9,17 @@
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 DESCRIPTION
+This command is the base for all C<perl>-based commands.
+It handles the suppression generation and sets the main command-line flags.
+
=cut
use Env::Sanctify ();
@@ -27,15 +30,31 @@
This class inherits L<Test::Valgrind::Command>.
-=head2 C<< new perl => $^X, inc => \@INC, ... >>
-
-Your usual constructor.
+=head2 C<< new perl => $^X, inc => \@INC, taint_mode => $taint_mode, ... >>
+
+The package constructor, which takes several options :
+
+=over 4
+
+=item *
The C<perl> option specifies which C<perl> executable will run the arugment list given in C<args>.
-It defaults to C<$^X>.
+
+Defaults to C<$^X>.
+
+=item *
C<inc> is a reference to an array of paths that will be passed as C<-I> to the invoked command.
-It defaults to C<@INC>.
+
+Defaults to C<@INC>.
+
+=item *
+
+C<$taint_mode> is a boolean that specifies if the script should be run under taint mode.
+
+Defaults to false.
+
+=back
Other arguments are passed straight to C<< Test::Valgrind::Command->new >>.
@@ -47,16 +66,19 @@
my %args = @_;
- my $perl = delete($args{perl}) || $^X;
- my $inc = delete($args{inc}) || [ @INC ];
+ my $perl = delete $args{perl} || $^X;
+ my $inc = delete $args{inc} || [ @INC ];
$class->_croak('Invalid INC list') unless ref $inc eq 'ARRAY';
+ my $taint_mode = delete $args{taint_mode};
my $trainer_file = delete $args{trainer_file};
my $self = bless $class->SUPER::new(%args), $class;
- $self->{perl} = $perl;
- $self->{inc} = $inc;
+ $self->{perl} = $perl;
+ $self->{inc} = $inc;
+ $self->{taint_mode} = $taint_mode;
+
$self->{trainer_file} = $trainer_file;
return $self;
@@ -97,10 +119,19 @@
sub inc { @{$_[0]->{inc} || []} }
+=head2 C<taint_mode>
+
+Read-only accessor for the C<taint_mode> option.
+
+=cut
+
+sub taint_mode { $_[0]->{taint_mode} }
+
sub args {
my $self = shift;
return $self->perl,
+ (('-T') x!! $self->taint_mode),
map("-I$_", $self->inc),
$self->SUPER::args(@_);
}
@@ -138,6 +169,22 @@
return $self->{suppressions_tag};
}
+sub filter {
+ my ($self, $session, $report) = @_;
+
+ return $report if $report->is_diag
+ or not $report->isa('Test::Valgrind::Report::Suppressions');
+
+ my $data = $report->data;
+ $data =~ s/^[^\r\n]*\bPerl_runops_(?:standard|debug)\b.*//ms;
+
+ $report->new(
+ id => $report->id,
+ kind => $report->kind,
+ data => $data,
+ );
+}
+
sub DESTROY {
my ($self) = @_;
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/PerlScript.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/PerlScript.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/PerlScript.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Command/PerlScript.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -29,12 +29,21 @@
=head2 C<< new file => $file, [ taint_mode => $taint_mode ], ... >>
-Your usual constructor.
+The package constructor, which takes several options :
+
+=over 4
+
+=item *
C<$file> is the path to the C<perl> script you want to run.
-C<$taint_mode> is a boolean that specifies if the script should be run under taint mode.
-If C<undef> is passed (which is the default), the constructor will try to infer it from the shebang line of the script.
+This option is mandatory.
+
+=item *
+
+C<$taint_mode> is actually handled by the parent class L<Test::Valgrind::Command::Perl>, but it gets special handling in this subclass : if C<undef> is passed (which is the default), the constructor will try to infer its right value from the shebang line of the script.
+
+=back
Other arguments are passed straight to C<< Test::Valgrind::Command::Perl->new >>.
@@ -46,14 +55,10 @@
my %args = @_;
- my $file = delete $args{file};
+ my $file = delete $args{file};
$class->_croak('Invalid script file') unless $file and -e $file;
+
my $taint_mode = delete $args{taint_mode};
-
- my $self = bless $class->SUPER::new(%args), $class;
-
- $self->{file} = $file;
-
if (not defined $taint_mode and open my $fh, '<', $file) {
my $first = <$fh>;
close $fh;
@@ -62,7 +67,13 @@
}
$taint_mode = 0 unless defined $taint_mode;
}
- $self->{taint_mode} = $taint_mode;
+
+ my $self = bless $class->SUPER::new(
+ taint_mode => $taint_mode,
+ %args,
+ ), $class;
+
+ $self->{file} = $file;
return $self;
}
@@ -73,19 +84,14 @@
Read-only accessor for the C<file> option.
-=head2 C<taint_mode>
-
-Read-only accessor for the C<taint_mode> option.
-
=cut
-eval "sub $_ { \$_[0]->{$_} }" for qw/file taint_mode/;
+sub file { $_[0]->{file} }
sub args {
my $self = shift;
return $self->SUPER::args(@_),
- (('-T') x!! $self->taint_mode),
$self->file
}
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Report.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Report.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Report.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Report.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
use base qw/Test::Valgrind::Carp/;
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Session.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Session.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Session.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Session.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -176,13 +176,30 @@
Runs the command C<$command> through C<valgrind> with the tool C<$tool>, which will report to the action C<$action>.
+If the command is a L<Test::Valgrind::Command::Aggregate> object, the action and the tool will be initialized once before running all the aggregated commands.
+
=cut
sub run {
my $self = shift;
- $self->start(@_);
+ my %args = @_;
+
+ $self->start(%args);
my $guard = bless sub { $self->finish } => 'Test::Valgrind::Session::Guard';
+
+ $self->_run($args{command});
+}
+
+sub _run {
+ my ($self, $cmd) = @_;
+
+ if ($cmd->isa('Test::Valgrind::Command::Aggregate')) {
+ $self->_run($_) for $cmd->commands;
+ return;
+ }
+
+ $self->command($cmd);
$self->report(Test::Valgrind::Report->new_diag(
'Using valgrind ' . $self->version . ' located at ' . $self->valgrind
@@ -302,7 +319,8 @@
=head2 C<def_supp_file>
Returns an absolute path to the default suppression file associated to the current session.
-C<undef> will be returned as soon as any of C<< ->tool->suppressions_tag >> or C<< ->tool->suppressions_tag >> are also C<undef>.
+
+C<undef> will be returned as soon as any of C<< ->command->suppressions_tag >> or C<< ->tool->suppressions_tag >> are also C<undef>.
Otherwise, the file part of the name is builded by joining those two together, and the directory part is roughly F<< File::HomeDir->my_home / .perl / Test-Valgrind / suppressions / $VERSION >>.
=cut
@@ -394,8 +412,14 @@
=cut
sub report {
- my $self = shift;
- $self->action->report($self, @_);
+ my ($self, $report) = @_;
+
+ return unless defined $report;
+
+ $report = $self->command->filter($self, $report);
+ return unless defined $report;
+
+ $self->action->report($self, $report);
}
=head2 C<finish>
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Suppressions.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Suppressions.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Suppressions.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Suppressions.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -156,7 +156,7 @@
=head2 C<parse_suppressions $sesssion, $fh>
-Parse the suppression reports sent by the C<valgrind> process attached to the session C<$session> through the filehandle C<$fh>.
+Parse the suppression reports that the C<valgrind> process attached to the session C<$session> send through the filehandle C<$fh>.
This method must be implemented when subclassing.
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/SuppressionsParser.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/SuppressionsParser.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/SuppressionsParser.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/SuppressionsParser.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
+Version 1.02
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -40,7 +40,7 @@
=head2 C<report_class_suppressions $session>
-Generated reports are L<Test::Valgrind::Report::Suppressions> objects.
+Generated reports are C<Test::Valgrind::Report::Suppressions> objects.
Their C<data> member contains the raw text of the suppression.
=cut
@@ -104,16 +104,12 @@
}
}
- my %dupes;
- @dupes{@supps, @extra} = ();
- @supps = keys %dupes;
-
my $num;
$sess->report($self->report_class($sess)->new(
id => ++$num,
kind => 'Suppression',
data => $_,
- )) for @supps;
+ )) for @supps, @extra;
}
=head1 SEE ALSO
Modified: trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/memcheck.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/memcheck.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/memcheck.pm (original)
+++ trunk/libtest-valgrind-perl/lib/Test/Valgrind/Tool/memcheck.pm Sun May 3 01:31:21 2009
@@ -9,11 +9,11 @@
=head1 VERSION
-Version 1.01
-
-=cut
-
-our $VERSION = '1.01';
+Version 1.02
+
+=cut
+
+our $VERSION = '1.02';
=head1 DESCRIPTION
@@ -79,7 +79,7 @@
=cut
-sub twig { $_[0]->{twig} }
+sub twig { $_[0]->{twig} }
sub suppressions_tag { 'memcheck-' . $_[1]->version }
@@ -144,7 +144,7 @@
my ($self, $sess) = @_;
$self->_session(undef);
- $self->SUPER::start($sess);
+ $self->SUPER::finish($sess);
return;
}
@@ -186,9 +186,7 @@
use base qw/Test::Valgrind::Report/;
-use Config qw/%Config/;
-
-our $VERSION = '1.01';
+our $VERSION = '1.02';
my @kinds = qw/
InvalidFree
@@ -217,7 +215,11 @@
sub is_leak { $_[0]->kind =~ /^Leak_/ ? 1 : '' }
-my $pad = 2 * ($Config{ptrsize} || 4);
+my $pad;
+BEGIN {
+ require Config;
+ $pad = 2 * ($Config::Config{ptrsize} || 4);
+}
sub dump {
my ($self) = @_;
@@ -256,7 +258,7 @@
package Test::Valgrind::Tool::memcheck::Twig;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
use Scalar::Util;
@@ -336,7 +338,7 @@
package Test::Valgrind::Tool::memcheck::Twig::Elt;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
BEGIN { require XML::Twig; }
Modified: trunk/libtest-valgrind-perl/t/92-pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/t/92-pod-coverage.t?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/t/92-pod-coverage.t (original)
+++ trunk/libtest-valgrind-perl/t/92-pod-coverage.t Sun May 3 01:31:21 2009
@@ -18,7 +18,7 @@
my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' };
-plan tests => 15;
+plan tests => 16;
pod_coverage_ok('Test::Valgrind');
@@ -30,6 +30,7 @@
pod_coverage_ok('Test::Valgrind::Carp');
pod_coverage_ok('Test::Valgrind::Command');
+pod_coverage_ok('Test::Valgrind::Command::Aggregate', $trustparents);
pod_coverage_ok('Test::Valgrind::Command::Perl', $trustparents);
pod_coverage_ok('Test::Valgrind::Command::PerlScript', $trustparents);
Modified: trunk/libtest-valgrind-perl/t/lib/Test/Valgrind/Test/Action.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-valgrind-perl/t/lib/Test/Valgrind/Test/Action.pm?rev=34687&op=diff
==============================================================================
--- trunk/libtest-valgrind-perl/t/lib/Test/Valgrind/Test/Action.pm (original)
+++ trunk/libtest-valgrind-perl/t/lib/Test/Valgrind/Test/Action.pm Sun May 3 01:31:21 2009
@@ -29,11 +29,11 @@
my ($self, $sess, $report) = @_;
if ($report->can('is_leak') and $report->is_leak) {
- my $trace = join ' ', map { $_->[2] } @{$report->data->{stack} || []}[0 .. 2];
+ my $data = $report->data;
+ my $trace = join ' ', map { $_->[2] } @{$data->{stack} || []}[0 .. 2];
if ($trace eq 'malloc XS_Test__Valgrind_leak Perl_pp_entersub') {
my $tb = Test::Builder->new;
$tb->diag("The subsequent report was correctly caught:\n" . $report->dump);
- my $data = $report->data;
$tb->is_eq($data->{leakedbytes}, 10_000, '10_000 bytes leaked');
$tb->is_eq($data->{leakedblocks}, 1, ' in one block');
return;
More information about the Pkg-perl-cvs-commits
mailing list