]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/11-line.t
No tabs please
[perl/modules/indirect.git] / 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