t/22-bad-mixed.t

   1 #!perl -T
   2
   3 package NotEmpty;
   4
   5 sub new;
   6
   7 package main;
   8
   9 use strict;
  10 use warnings;
  11
  12 use Test::More tests => 3 * 9;
  13
  14 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
  15
  16 sub meh;
  17
  18 my @warns;
  19
  20 sub try {
  21  my ($code) = @_;
  22
  23  @warns = ();
  24  {
  25   local $SIG{__WARN__} = sub { push @warns, @_ };
  26   eval $code;
  27  }
  28 }
  29
  30 {
  31  local $/ = "####";
  32  while (<DATA>) {
  33   chomp;
  34   s/\s*$//;
  35   s/(.*?)$//m;
  36   my ($skip, $prefix) = split /#+/, $1;
  37   $skip   = 0  unless defined $skip;
  38   $prefix = '' unless defined $prefix;
  39   s/\s*//;
  40
  41 SKIP:
  42   {
  43    skip "$_: $skip" => 9 if do { local $@; eval $skip };
  44
  45    {
  46     local $_ = $_;
  47     s/Pkg/Empty/g;
  48
  49     try "return; $prefix; use indirect; $_";
  50     is $@,     '', "use indirect: $_";
  51     is @warns, 0,  'correct number of reports';
  52
  53     try "return; $prefix; no indirect; $_";
  54     is $@,     '', "no indirect: $_";
  55     is @warns, 0,  'correct number of reports';
  56    }
  57
  58    {
  59     local $_ = $_;
  60     s/Pkg/NotEmpty/g;
  61
  62     try "return; $prefix; use indirect; $_";
  63     is $@,     '', "use indirect, defined: $_";
  64     is @warns, 0,  'correct number of reports';
  65
  66     try "return; $prefix; no indirect; $_";
  67     is $@,          '', "use indirect, defined: $_";
  68     is @warns,      1,  'correct number of reports';
  69     like $warns[0], qr/^Indirect call of method "meh" on object "NotEmpty" at \(eval \d+\) line \d+/, 'report 0 is correct';
  70    }
  71   }
  72  }
  73 }
  74
  75 __DATA__
  76
  77 meh Pkg->new;
  78 ####
  79 meh Pkg->new();
  80 ####
  81 meh Pkg->new, "Wut";