t/20-bad-no.t

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