1 package Test::Valgrind::Command::Perl;
8 Test::Valgrind::Command::Perl - A Test::Valgrind command that invokes perl.
16 our $VERSION = '1.00';
24 use base qw/Test::Valgrind::Command Test::Valgrind::Carp/;
28 This class inherits L<Test::Valgrind::Command>.
30 =head2 C<< new perl => $^X, inc => \@INC, ... >>
32 Your usual constructor.
34 The C<perl> option specifies which C<perl> executable will run the arugment list given in C<args>.
35 It defaults to C<$^X>.
37 C<inc> is a reference to an array of paths that will be passed as C<-I> to the invoked command.
38 It defaults to C<@INC>.
40 Other arguments are passed straight to C<< Test::Valgrind::Command->new >>.
46 $class = ref($class) || $class;
50 my $perl = delete($args{perl}) || $^X;
51 my $inc = delete($args{inc}) || [ @INC ];
52 $class->_croak('Invalid INC list') unless ref $inc eq 'ARRAY';
54 my $trainer_file = delete $args{trainer_file};
56 my $self = bless $class->SUPER::new(%args), $class;
58 $self->{perl} = $perl;
60 $self->{trainer_file} = $trainer_file;
69 my ($fh, $file) = File::Temp::tempfile(UNLINK => 0);
71 my $curpos = tell DATA;
72 print $fh $_ while <DATA>;
73 seek DATA, $curpos, 0;
75 close $fh or $self->_croak("close(tempscript): $!");
78 args => [ '-MTest::Valgrind=run,1', $file ],
79 trainer_file => $file,
86 Read-only accessor for the C<perl> option.
90 sub perl { $_[0]->{perl} }
94 Read-only accessor for the C<inc> option.
98 sub inc { @{$_[0]->{inc} || []} }
104 map("-I$_", $self->inc),
105 $self->SUPER::args(@_);
108 =head2 C<env $session>
110 Returns an L<Env::Sanctify> object that sets the environment variables C<PERL_DESTRUCT_LEVEL> to C<3> and C<PERL_DL_NONLAZY> to C<1> during the run.
115 Env::Sanctify->sanctify(
117 PERL_DESTRUCT_LEVEL => 2,
118 PERL_DL_NONLAZY => 1,
123 sub suppressions_tag {
126 unless (defined $self->{suppressions_tag}) {
127 my $env = Env::Sanctify->sanctify(sanctify => [ qr/^PERL/ ]);
129 open my $pipe, '-|', $self->perl, '-V'
130 or $self->_croak('open("-| ' . $self->perl . " -V\"): $!");
131 my $perl_v = do { local $/; <$pipe> };
132 close $pipe or $self->_croak('close("-| ' . $self->perl . " -V\"): $!");
135 $self->{suppressions_tag} = Digest::MD5::md5_hex($perl_v);
138 return $self->{suppressions_tag};
144 my $file = $self->{trainer_file};
145 return unless $file and -e $file;
147 1 while unlink $file;
154 L<Test::Valgrind>, L<Test::Valgrind::Command>.
160 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
162 You can contact me by mail or on C<irc.perl.org> (vincent).
166 Please report any bugs or feature requests to C<bug-test-valgrind at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Valgrind>.
167 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
171 You can find documentation for this module with the perldoc command.
173 perldoc Test::Valgrind::Command::Perl
175 =head1 COPYRIGHT & LICENSE
177 Copyright 2009 Vincent Pit, all rights reserved.
179 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
183 1; # End of Test::Valgrind::Command::Perl
189 BEGIN { require Test::Valgrind; }
195 XSLoader::load('Test::Valgrind', $Test::Valgrind::VERSION);
199 Test::Valgrind::notleak("valgrind it!");
202 *Test::Valgrind::DEBUGGING = sub { 'unknown' };
206 fail 'should not be seen';
207 diag 'debbugging flag is ' . Test::Valgrind::DEBUGGING();
211 XSLoader::load('Test::Valgrind::Fake', 0);
214 diag $@ ? 'Ok' : 'Succeeded to load Test::Valgrind::Fake but should\'t';
218 my @cards = List::Util::shuffle(0 .. 51);
221 package Test::Valgrind::Test::Fake;
226 eval 'use Time::HiRes qw/usleep/';