t/20-bad-no.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my $total = 28;
   7
   8 use Test::More;
   9
  10 use IPC::Cmd qw/run/;
  11
  12 (my $success, my $err_code, undef, undef, my $stderr)
  13  = run command => [
  14           $^X,
  15           map('-I' . $_, @INC),
  16           $ENV{PERL5OPT} || '',
  17           '-M-indirect',
  18           '-c',
  19           't/data/bad.d'
  20    ];
  21
  22 plan skip_all => "Couldn't capture buffers" if $success and not defined $stderr;
  23 plan tests => $total + 1;
  24
  25 $stderr = join '', @{$stderr || []};
  26 unless ($success) {
  27  diag $stderr;
  28  diag "Failed to execute data file (error $err_code)";
  29  fail "Couldn't run test $_" for 1 .. $total + 1;
  30  exit $total + 1;
  31 }
  32
  33 my %fail = map { $_ => 1 } 1 .. $total;
  34 my $extra_fail = 0;
  35
  36 while ($stderr =~ /^Indirect\s+call\s+of\s+method\s+"([^"]+)"\s+on\s+object\s+"([^"]+)"/mg) {
  37  my ($m, $o) = ($1, $2);
  38  my $id;
  39  if ($m =~ /^(?:new|potato)(\d+)$/) {
  40   $id = $1;
  41  } elsif ($o =~ /^Hlagh(\d+)$/) {
  42   $id = $1;
  43  } else {
  44   diag "$m $o";
  45   ++$extra_fail;
  46  }
  47  if ($id) {
  48   ok($fail{$id}, "test $id failed as expected");
  49   delete $fail{$id};
  50  }
  51 }
  52
  53 fail("test $_ hasn't failed") for sort { $a <=> $b } keys %fail;
  54 is($extra_fail, 0, 'no extra fails');