t/22-bad-mixed.t

   1 #!perl -T
   2
   3 package Dongs;
   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 eval $skip;
  44
  45    {
  46     try "return; $prefix; use indirect; $_";
  47     is $@,     '', "use indirect: $_";
  48     is @warns, 0,  'correct number of reports';
  49
  50     try "return; $prefix; no indirect; $_";
  51     is $@,     '', "no indirect: $_";
  52     is @warns, 0,  'correct number of reports';
  53    }
  54
  55    {
  56     local $_ = $_;
  57     s/Hlagh/Dongs/g;
  58
  59     try "return; $prefix; use indirect; $_";
  60     is $@,     '', "use indirect, defined: $_";
  61     is @warns, 0,  'correct number of reports';
  62
  63     try "return; $prefix; no indirect; $_";
  64     is $@,          '', "use indirect, defined: $_";
  65     is @warns,      1,  'correct number of reports';
  66     like $warns[0], qr/^Indirect call of method "meh" on object "Dongs" at \(eval \d+\) line \d+/, 'report 0 is correct';
  67    }
  68   }
  69  }
  70 }
  71
  72 __DATA__
  73
  74 meh Hlagh->new;
  75 ####
  76 meh Hlagh->new();
  77 ####
  78 meh Hlagh->new, "Wut";