X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2Flib%2FTest%2FValgrind%2FFakeValgrind.pm;h=067309b6a5cd708f0b04a8fc064673ffbe49740b;hb=ca8eca27f27c14e65e67ffce2fa1447eee64c5c1;hp=098bae02fed9b17e04dd9a13c67ca131077778d5;hpb=15e7706165e33a1e52fba63877a92613ff1794a8;p=perl%2Fmodules%2FTest-Valgrind.git

diff --git a/t/lib/Test/Valgrind/FakeValgrind.pm b/t/lib/Test/Valgrind/FakeValgrind.pm
index 098bae0..067309b 100644
--- a/t/lib/Test/Valgrind/FakeValgrind.pm
+++ b/t/lib/Test/Valgrind/FakeValgrind.pm
@@ -8,7 +8,7 @@ use File::Spec;
 use File::Temp;
 
 sub _dummy_valgrind_code {
- my ($version) = @_;
+ my ($version, $body) = @_;
 
  my $perl = $^X;
  unless (-e $perl and -x $perl) {
@@ -18,34 +18,61 @@ sub _dummy_valgrind_code {
   }
  }
 
+ if (defined $body) {
+  $body = "\n$body";
+ } else {
+  $body = '';
+ }
+
  return <<" FAKE_VG";
 #!$perl
 if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
  print "valgrind-$version\n";
-}
+ exit 0;
+}$body
  FAKE_VG
 }
 
+my $good_enough_file_temp;
+BEGIN {
+ $good_enough_file_temp = do {
+  no warnings;
+  local $@;
+  eval { File::Temp->VERSION('0.19'); 1 }
+ }
+}
+
 sub new {
  my ($class, %args) = @_;
 
  my $exe_name = $args{exe_name};
  my $version  = $args{version} || '3.1.0';
+ my $body     = $args{body};
 
  my $self = { };
 
  if (defined $exe_name) {
+  return 'File::Temp 0.19 is required to make a proper temporary directory'
+         unless $good_enough_file_temp;
   $self->{tmp_dir_obj}  = File::Temp->newdir(CLEANUP => 1);
   $self->{tmp_dir}      = $self->{tmp_dir_obj}->dirname;
   $self->{tmp_file}     = File::Spec->catfile($self->{tmp_dir}, $exe_name);
  } else {
-  $self->{tmp_file_obj} = File::Temp->new(UNLINK => 1);
-  $self->{tmp_file}     = $self->{tmp_file_obj}->filename;
+  # Can't use the OO interface if we don't wan't the file to be opened by
+  # default, but then we have to deal with cleanup ourselves.
+  local $^W = 0;
+  (undef, my $tmp_file) = File::Temp::tempfile(
+   TEMPLATE => 'fakevgXXXX',
+   TMPDIR   => 1,
+   CLEANUP  => 0,
+   OPEN     => 0,
+  );
+  $self->{tmp_file}     = $tmp_file;
   my ($vol, $dir)       = File::Spec->splitpath($self->{tmp_file});
   $self->{tmp_dir}      = File::Spec->catpath($vol, $dir, '');
  }
 
- my $code = _dummy_valgrind_code($version);
+ my $code = _dummy_valgrind_code($version, $body);
  return 'Could not generate the dummy valgrind executable' unless $code;
 
  return 'Temporary file already exists' if -s $self->{tmp_file};
@@ -60,8 +87,10 @@ sub new {
  bless $self, $class;
 }
 
-sub path { $_[0]->{tmp_file} }
+sub path    { $_[0]->{tmp_file} }
+
+sub dir     { $_[0]->{tmp_dir} }
 
-sub dir  { $_[0]->{tmp_dir} }
+sub DESTROY { 1 while unlink $_[0]->{tmp_file} }
 
 1;