=head1 VERSION
-Version 1.01
+Version 1.17
=cut
-our $VERSION = '1.01';
+our $VERSION = '1.17';
=head1 DESCRIPTION
=cut
-use base qw/Test::Valgrind::Action Test::Valgrind::Action::Captor/;
+use base qw<Test::Valgrind::Action Test::Valgrind::Action::Captor>;
=head1 METHODS
This class inherits L<Test::Valgrind::Action>.
-=head2 C<< new name => $name, target => $target, ... >>
+=head2 C<new>
+
+ my $tvas = Test::Valgrind::Action::Suppressions->new(
+ name => $name,
+ target => $target,
+ %extra_args,
+ );
Your usual constructor.
my %validated;
- for (qw/name target/) {
+ for (qw<name target>) {
my $arg = delete $args{$_};
$class->_croak("'$_' is expected to be a plain scalar")
unless $arg and not ref $arg;
my $self = $class->SUPER::new(%args);
- $self->{$_} = $validated{$_} for qw/name target/;
+ $self->{$_} = $validated{$_} for qw<name target>;
$self;
}
=head2 C<name>
+ my $name = $tvas->name;
+
Read-only accessor for the C<name> option.
=cut
=head2 C<target>
+ my $target = $tvas->target;
+
Read-only accessor for the C<target> option.
=cut
$self->SUPER::start($sess);
- delete @{$self}{qw/status supps diagnostics/};
+ delete @{$self}{qw<status supps diagnostics>};
$self->save_fh(\*STDOUT => '>' => undef);
$self->save_fh(\*STDERR => '>' => undef);
require File::Spec;
my ($vol, $dir, $file) = File::Spec->splitpath($target);
my $base = File::Spec->catpath($vol, $dir, '');
- unless (-e $base) {
+ if (-e $base) {
+ 1 while unlink $target;
+ } else {
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);
+ my $id = 0;
+ my %seen;
for (sort { $a->data cmp $b->data }
grep !$seen{$_->data}++, @{$self->{supps}}) {
print $fh "{\n"
=head1 COPYRIGHT & LICENSE
-Copyright 2009 Vincent Pit, all rights reserved.
+Copyright 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.