t/71-session-command.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN { delete $ENV{PATH} }
   7
   8 use Test::More tests => 2;
   9
  10 use Test::Valgrind::Command;
  11 use Test::Valgrind::Tool;
  12 use Test::Valgrind::Session;
  13
  14 use lib 't/lib';
  15 use Test::Valgrind::FakeValgrind;
  16
  17 my $cmd = Test::Valgrind::Command->new(
  18  command => 'Perl',
  19  args    => [ '-e1' ],
  20 );
  21
  22 {
  23  package Test::Valgrind::Parser::Dummy;
  24
  25  use base 'Test::Valgrind::Parser';
  26
  27  sub parse { }
  28 }
  29
  30 {
  31  package Test::Valgrind::Tool::Dummy;
  32
  33  use base 'Test::Valgrind::Tool::memcheck';
  34
  35  sub parser_class { 'Test::Valgrind::Parser::Dummy' }
  36 }
  37
  38 my $tool = Test::Valgrind::Tool::Dummy->new();
  39
  40 {
  41  package Test::Valgrind::Action::Dummy;
  42
  43  use base 'Test::Valgrind::Action';
  44
  45  sub do_suppressions { 0 }
  46
  47  sub report {
  48   my ($self, $sess, $report) = @_;
  49
  50   if ($report->is_diag) {
  51    my $contents = $report->data;
  52    if ($contents !~ /^(?:Using valgrind |No suppressions used)/) {
  53     ::diag($contents);
  54    }
  55    return;
  56   } else {
  57    $self->SUPER::report($sess, $report);
  58   }
  59  }
  60 }
  61
  62 my $action = Test::Valgrind::Action::Dummy->new();
  63
  64 SKIP: {
  65  my $tmp_vg;
  66  my $sess;
  67
  68  {
  69   my $dummy_vg = Test::Valgrind::FakeValgrind->new(
  70    exe_name => 'invisible_pink_unicorn'
  71   );
  72   skip $dummy_vg => 2 unless ref $dummy_vg;
  73   $tmp_vg = $dummy_vg->path;
  74
  75   local $@;
  76   $sess = eval {
  77    Test::Valgrind::Session->new(
  78     allow_no_supp => 1,
  79     no_def_supp   => 1,
  80     valgrind      => $tmp_vg,
  81    );
  82   };
  83   is $@, '', 'session was correctly created';
  84  }
  85
  86  skip 'dummy valgrind executable was not deleted' => 1 if -e $tmp_vg;
  87
  88  local $@;
  89  eval {
  90   $sess->run(
  91    action  => $action,
  92    command => $cmd,
  93    tool    => $tool,
  94   );
  95  };
  96  like $@, qr/invisible_pink_unicorn/, 'command not found croaks';
  97 }