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 sub meh;
  15
  16 my @warns;
  17
  18 sub try {
  19  my ($code) = @_;
  20
  21  @warns = ();
  22  {
  23   local $SIG{__WARN__} = sub { push @warns, @_ };
  24   eval $code;
  25  }
  26 }
  27
  28 {
  29  local $/ = "####";
  30  while (<DATA>) {
  31   chomp;
  32   s/\s*$//;
  33   s/(.*?)$//m;
  34   my ($skip, $prefix) = split /#+/, $1;
  35   $skip   = 0  unless defined $skip;
  36   $prefix = '' unless defined $prefix;
  37   s/\s*//;
  38
  39 SKIP:
  40   {
  41    skip "$_: $skip" => 9 if eval $skip;
  42
  43    {
  44     try "return; $prefix; use indirect; $_";
  45     is $@,     '', "use indirect: $_";
  46     is @warns, 0,  'correct number of reports';
  47
  48     try "return; $prefix; no indirect; $_";
  49     is $@,     '', "no indirect: $_";
  50     is @warns, 0,  'correct number of reports';
  51    }
  52
  53    {
  54     local $_ = $_;
  55     s/Hlagh/Dongs/g;
  56
  57     try "return; $prefix; use indirect; $_";
  58     is $@,     '', "use indirect, defined: $_";
  59     is @warns, 0,  'correct number of reports';
  60
  61     try "return; $prefix; no indirect; $_";
  62     is $@,          '', "use indirect, defined: $_";
  63     is @warns,      1,  'correct number of reports';
  64     like $warns[0], qr/^Indirect call of method "meh" on object "Dongs" at \(eval \d+\) line \d+/, 'report 0 is correct';
  65    }
  66   }
  67  }
  68 }
  69
  70 __DATA__
  71
  72 meh Hlagh->new;
  73 ####
  74 meh Hlagh->new();
  75 ####
  76 meh Hlagh->new, "Wut";