t/lib/Test/Valgrind/FakeValgrind.pm

   1 package Test::Valgrind::FakeValgrind;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Config ();
   7 use File::Spec;
   8 use File::Temp;
   9
  10 sub _dummy_valgrind_code {
  11  my ($version, $body) = @_;
  12
  13  my $perl = $^X;
  14  unless (-e $perl and -x $perl) {
  15   $perl = $Config::Config{perlpath};
  16   unless (-e $perl and -x $perl) {
  17    return undef;
  18   }
  19  }
  20
  21  if (defined $body) {
  22   $body = "\n$body";
  23  } else {
  24   $body = '';
  25  }
  26
  27  return <<" FAKE_VG";
  28 #!$perl
  29 if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
  30  print "valgrind-$version\n";
  31  exit 0;
  32 }$body
  33  FAKE_VG
  34 }
  35
  36 my $good_enough_file_temp;
  37 BEGIN {
  38  $good_enough_file_temp = do {
  39   no warnings;
  40   local $@;
  41   eval { File::Temp->VERSION('0.19'); 1 }
  42  }
  43 }
  44
  45 sub new {
  46  my ($class, %args) = @_;
  47
  48  return 'Temporary executables do not work on Windows' if $^O eq 'MSWin32';
  49
  50  my $exe_name = $args{exe_name};
  51  my $version  = $args{version} || '3.1.0';
  52  my $body     = $args{body};
  53
  54  my $self = { };
  55
  56  my $exe_ext = $Config::Config{exe_ext};
  57  $exe_ext    = '' unless defined $exe_ext;
  58  if (defined $exe_name) {
  59   return 'File::Temp 0.19 is required to make a proper temporary directory'
  60          unless $good_enough_file_temp;
  61   if (length $exe_ext and $exe_name !~ /\Q$exe_ext\E$/) {
  62    $exe_name .= $exe_ext;
  63   }
  64   $self->{tmp_dir_obj} = File::Temp->newdir(CLEANUP => 1);
  65   $self->{tmp_dir}     = $self->{tmp_dir_obj}->dirname;
  66   $self->{tmp_file}    = File::Spec->catfile($self->{tmp_dir}, $exe_name);
  67  } else {
  68   # Can't use the OO interface if we don't wan't the file to be opened by
  69   # default, but then we have to deal with cleanup ourselves.
  70   my %args = (
  71    TEMPLATE => 'fakevgXXXX',
  72    TMPDIR   => 1,
  73    CLEANUP  => 0,
  74    OPEN     => 0,
  75   );
  76   $args{SUFFIX} = $exe_ext if length $exe_ext;
  77   my $tmp_file = do {
  78    local $^W = 0;
  79    (File::Temp::tempfile(%args))[1]
  80   };
  81   $self->{tmp_file} = $tmp_file;
  82   my ($vol, $dir)   = File::Spec->splitpath($self->{tmp_file});
  83   $self->{tmp_dir}  = File::Spec->catpath($vol, $dir, '');
  84  }
  85
  86  my $code = _dummy_valgrind_code($version, $body);
  87  return 'Could not generate the dummy valgrind executable' unless $code;
  88
  89  return 'Temporary file already exists' if -s $self->{tmp_file};
  90
  91  {
  92   open my $vg_fh, '>', $self->{tmp_file};
  93   print $vg_fh $code;
  94   close $vg_fh;
  95   chmod 0755, $self->{tmp_file};
  96  }
  97
  98  bless $self, $class;
  99 }
 100
 101 sub path    { $_[0]->{tmp_file} }
 102
 103 sub dir     { $_[0]->{tmp_dir} }
 104
 105 sub DESTROY { 1 while unlink $_[0]->{tmp_file} }
 106
 107 1;