t/11-line.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 3 * 4;
   7
   8 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
   9
  10 sub expect {
  11  my ($pkg, $line) = @_;
  12  return qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"\s+at\s+\(eval\s+\d+\)\s+line\s+$line/;
  13 }
  14
  15 {
  16  local $/ = "####";
  17  while (<DATA>) {
  18   chomp;
  19   s/^\s+//;
  20
  21   my ($code, $lines) = split /#+/, $_, 2;
  22   $lines = eval "[ sort ($lines) ]";
  23   if ($@) {
  24    diag "Couldn't parse line numbers: $@";
  25    next;
  26   }
  27
  28   my (@warns, @lines);
  29   {
  30    local $SIG{__WARN__} = sub { push @warns, "@_" };
  31    eval "return; no indirect hook => sub { push \@lines, \$_[3] }; $code";
  32   }
  33
  34   is        $@,              '',     'did\'t croak';
  35   is_deeply \@warns,         [ ],    'didn\'t warn';
  36   is_deeply [ sort @lines ], $lines, 'correct line numbers';
  37  }
  38 }
  39
  40 __DATA__
  41 my $x = new X;             # 1
  42 ####
  43 my $x = new
  44   X;                       # 1
  45 ####
  46 my $x = new X; $x = new X; # 1, 1
  47 ####
  48 my $x = new
  49  X new
  50     X;                     # 1, 2