t/30-scope.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my $total = 8;
   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           '-c',
  17           't/data/mixed.d'
  18    ];
  19
  20 plan skip_all => "Couldn't capture buffers" if $success and not defined $stderr;
  21 plan tests => $total + 1;
  22
  23 $stderr = join '', @$stderr;
  24 unless ($success) {
  25  diag $stderr;
  26  diag "Failed to execute data file (error $err_code)";
  27  fail "Couldn't run test $_" for 1 .. $total + 1;
  28 }
  29
  30 my %fail = map { $_ => 1 } 2, 3, 5, 7;
  31 my %failed;
  32 my $extra_fail = 0;
  33
  34 while ($stderr =~ /^Indirect\s+call\s+of\s+method\s+"([^"]+)"\s+on\s+object\s+"([^"]+)"/mg) {
  35  my ($m, $o) = ($1, $2);
  36  my $id;
  37  if ($o =~ /^P(\d+)$/) {
  38   $id = $1;
  39  } else {
  40   diag "$m $o";
  41   ++$extra_fail;
  42  }
  43  if ($id) {
  44   if (exists $fail{$id}) {
  45    pass("test $id failed as expected");
  46    delete $fail{$id};
  47    $failed{$id} = 1;
  48   } else {
  49    fail("test $id shouldn't have failed");
  50   }
  51  }
  52 }
  53
  54 pass("test $_ hasn't failed") for grep { !$failed{$_} } 1 .. $total;
  55 fail("test $_ should have failed") for sort { $a <=> $b } keys %fail;
  56 is($extra_fail, 0, 'no extra fails');