From: Vincent Pit <perl@profvince.com>
Date: Wed, 11 Nov 2015 17:45:41 +0000 (-0200)
Subject: Factor the fake valgrind test helper into a separate class
X-Git-Tag: v1.16~9
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FTest-Valgrind.git;a=commitdiff_plain;h=15e7706165e33a1e52fba63877a92613ff1794a8

Factor the fake valgrind test helper into a separate class
---

diff --git a/MANIFEST b/MANIFEST
index 3421317..e91a24f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -38,5 +38,6 @@ t/20-bad.t
 t/70-session.t
 t/80-suppressions.t
 t/81-suppressions-demangle.t
+t/lib/Test/Valgrind/FakeValgrind.pm
 t/lib/Test/Valgrind/Test/Action.pm
 t/supp/no_perl
diff --git a/t/70-session.t b/t/70-session.t
index bada708..1ce46c5 100644
--- a/t/70-session.t
+++ b/t/70-session.t
@@ -5,10 +5,11 @@ use warnings;
 
 use Test::Valgrind::Session;
 
-use File::Temp;
-
 use Test::More tests => 7;
 
+use lib 't/lib';
+use Test::Valgrind::FakeValgrind;
+
 my $sess = eval { Test::Valgrind::Session->new(
  search_dirs => [ ],
 ) };
@@ -19,56 +20,27 @@ $sess = eval { Test::Valgrind::Session->new(
 ) };
 like $@, qr/^No appropriate valgrind executable/, 'nonexistant valgrind';
 
-sub fake_vg {
- my ($version) = @_;
-
- my $perl = $^X;
- unless (-e $perl and -x $perl) {
-  $perl = $Config::Config{perlpath};
-  unless (-e $perl and -x $perl) {
-   return undef;
-  }
- }
-
- return <<" FAKE_VG";
-#!$perl
-if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
- print "valgrind-$version\n";
-} else {
- print "hlagh\n";
-}
- FAKE_VG
-}
-
 SKIP: {
  skip 'Only on linux or darwin' => 5 unless $^O eq 'linux' or $^O eq 'darwin';
 
- my $fake_vg_code = fake_vg('3.0.0');
- skip 'Could not generate the dummy valgrind executable' => 5
-                                                   unless defined $fake_vg_code;
-
- my $vg_old = File::Temp->new(UNLINK => 1);
- print $vg_old $fake_vg_code;
- close $vg_old;
- chmod 0755, $vg_old->filename;
+ my $old_vg = Test::Valgrind::FakeValgrind->new(
+  version => '3.0.0',
+ );
+ skip $old_vg => 5 unless ref $old_vg;
 
  my $sess = eval { Test::Valgrind::Session->new(
-  valgrind    => $vg_old->filename,
+  valgrind    => $old_vg->path,
   min_version => '3.1.0',
  ) };
  like $@, qr/^No appropriate valgrind executable/, 'old valgrind';
 
- $fake_vg_code = fake_vg('3.4.0');
- skip 'Could not generate the dummy valgrind executable' => 4
-                                                   unless defined $fake_vg_code;
-
- my $vg_new = File::Temp->new(UNLINK => 1);
- print $vg_new $fake_vg_code;
- close $vg_new;
- chmod 0755, $vg_new->filename;
+ my $new_vg = Test::Valgrind::FakeValgrind->new(
+  version => '3.4.0',
+ );
+ skip $new_vg => 4 unless ref $new_vg;
 
  $sess = eval { Test::Valgrind::Session->new(
-  valgrind    => $vg_new->filename,
+  valgrind    => $new_vg->path,
   min_version => '3.1.0',
  ) };
  is     $@,    '',                        'new valgrind';
@@ -76,7 +48,7 @@ SKIP: {
 
  $sess = eval { Test::Valgrind::Session->new(
   search_dirs => [ ],
-  valgrind    => [ $vg_old->filename, $vg_new->filename ],
+  valgrind    => [ $old_vg->path, $new_vg->path ],
   min_version => '3.1.0',
  ) };
  is     $@,    '',                        'old and new valgrind';
diff --git a/t/80-suppressions.t b/t/80-suppressions.t
index b2cfa8a..6eae1ab 100644
--- a/t/80-suppressions.t
+++ b/t/80-suppressions.t
@@ -9,14 +9,31 @@ use Test::Valgrind::Command;
 use Test::Valgrind::Tool;
 use Test::Valgrind::Session;
 
+use lib 't/lib';
+use Test::Valgrind::FakeValgrind;
+
 my $cmd = Test::Valgrind::Command->new(
  command => 'Perl',
  args    => [ '-e1' ],
 );
 
-my $tool = Test::Valgrind::Tool->new(
- tool => 'memcheck',
-);
+{
+ package Test::Valgrind::Parser::Dummy;
+
+ use base 'Test::Valgrind::Parser';
+
+ sub parse { }
+}
+
+{
+ package Test::Valgrind::Tool::Dummy;
+
+ use base 'Test::Valgrind::Tool::memcheck';
+
+ sub parser_class { 'Test::Valgrind::Parser::Dummy' }
+}
+
+my $tool = Test::Valgrind::Tool::Dummy->new();
 
 {
  package Test::Valgrind::Action::Dummy;
@@ -24,6 +41,20 @@ my $tool = Test::Valgrind::Tool->new(
  use base 'Test::Valgrind::Action';
 
  sub do_suppressions { 0 }
+
+ sub report {
+  my ($self, $sess, $report) = @_;
+
+  if ($report->is_diag) {
+   my $contents = $report->data;
+   if ($contents !~ /^(?:Using valgrind |No suppressions used)/) {
+    ::diag($contents);
+   }
+   return;
+  } else {
+   $self->SUPER::report($sess, $report);
+  }
+ }
 }
 
 my $dummy_action = Test::Valgrind::Action::Dummy->new();
@@ -79,24 +110,31 @@ if ($res) {
  close $supp_fh;
 }
 
-$sess = eval { Test::Valgrind::Session->new(
- no_def_supp => 1,
- extra_supp  => [ 't/supp/no_perl' ],
-)->run(
- tool    => $tool,
- command => $cmd,
- action  => $dummy_action,
-) };
-like $@, qr/No compatible suppressions available/,
-         'incompatible suppression file';
-
-$sess = eval { Test::Valgrind::Session->new(
- no_def_supp   => 1,
- allow_no_supp => 1,
- extra_supp    => [ 't/supp/no_perl' ],
-)->run(
- tool    => $tool,
- command => $cmd,
- action  => $dummy_action,
-) };
-is $@, '', 'incompatible suppression file, but forced';
+SKIP: {
+ my $dummy_vg = Test::Valgrind::FakeValgrind->new();
+ skip $dummy_vg => 2 unless ref $dummy_vg;
+
+ $sess = eval { Test::Valgrind::Session->new(
+  valgrind    => $dummy_vg->path,
+  no_def_supp => 1,
+  extra_supp  => [ 't/supp/no_perl' ],
+ )->run(
+  tool    => $tool,
+  command => $cmd,
+  action  => $dummy_action,
+ ) };
+ like $@, qr/No compatible suppressions available/,
+          'incompatible suppression file';
+
+ $sess = eval { Test::Valgrind::Session->new(
+  valgrind      => $dummy_vg->path,
+  no_def_supp   => 1,
+  allow_no_supp => 1,
+  extra_supp    => [ 't/supp/no_perl' ],
+ )->run(
+  tool    => $tool,
+  command => $cmd,
+  action  => $dummy_action,
+ ) };
+ is $@, '', 'incompatible suppression file, but forced';
+}
diff --git a/t/lib/Test/Valgrind/FakeValgrind.pm b/t/lib/Test/Valgrind/FakeValgrind.pm
new file mode 100644
index 0000000..098bae0
--- /dev/null
+++ b/t/lib/Test/Valgrind/FakeValgrind.pm
@@ -0,0 +1,67 @@
+package Test::Valgrind::FakeValgrind;
+
+use strict;
+use warnings;
+
+use Config ();
+use File::Spec;
+use File::Temp;
+
+sub _dummy_valgrind_code {
+ my ($version) = @_;
+
+ my $perl = $^X;
+ unless (-e $perl and -x $perl) {
+  $perl = $Config::Config{perlpath};
+  unless (-e $perl and -x $perl) {
+   return undef;
+  }
+ }
+
+ return <<" FAKE_VG";
+#!$perl
+if (\@ARGV == 1 && \$ARGV[0] eq '--version') {
+ print "valgrind-$version\n";
+}
+ FAKE_VG
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $exe_name = $args{exe_name};
+ my $version  = $args{version} || '3.1.0';
+
+ my $self = { };
+
+ if (defined $exe_name) {
+  $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;
+  my ($vol, $dir)       = File::Spec->splitpath($self->{tmp_file});
+  $self->{tmp_dir}      = File::Spec->catpath($vol, $dir, '');
+ }
+
+ my $code = _dummy_valgrind_code($version);
+ return 'Could not generate the dummy valgrind executable' unless $code;
+
+ return 'Temporary file already exists' if -s $self->{tmp_file};
+
+ {
+  open my $vg_fh, '>', $self->{tmp_file};
+  print $vg_fh $code;
+  close $vg_fh;
+  chmod 0755, $self->{tmp_file};
+ }
+
+ bless $self, $class;
+}
+
+sub path { $_[0]->{tmp_file} }
+
+sub dir  { $_[0]->{tmp_dir} }
+
+1;