b0f29b594855b03fc2a73be2637ff52183dd91c3
[perl/modules/indirect.git] / t / 30-scope.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 my $tests;
7 BEGIN { $tests = 18 }
8
9 use Test::More tests => 1 + $tests + 1 + 2 + 2;
10
11 use lib 't/lib';
12
13 my %wrong = map { $_ => 1 } 2, 3, 5, 7, 9, 10, 14, 15, 17, 18;
14
15 sub expect {
16  my ($pkg) = @_;
17  return qr/^warn:Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"\s+at\s+\(eval\s+\d+\)\s+line\s+\d+/;
18 }
19
20 {
21  my $code = do { local $/; <DATA> };
22  my (%res, $num, @left);
23  {
24   local $SIG{__WARN__} = sub {
25    ++$num;
26    my $w = join '', 'warn:', @_;
27    if ($w =~ /"P(\d+)"/ and not exists $res{$1}) {
28     $res{$1} = $w;
29    } else {
30     push @left, "[$num] $w";
31    }
32   };
33   eval "die qq{ok\\n}; $code";
34   is($@, "ok\n", 'DATA compiled fine');
35  }
36  for (1 .. $tests) {
37   my $w = $res{$_};
38   if ($wrong{$_}) {
39    like($w, expect("P$_"), "$_ should warn");
40   } else {
41    is($w, undef, "$_ shouldn't warn");
42   }
43  }
44  is(@left, 0, 'nothing left');
45  diag "Extraneous warnings:\n", @left if @left;
46 }
47
48 {
49  my $w = '';
50  local $SIG{__WARN__} = sub {
51   $w = 'more than 2 warnings' if $w;
52   $w = join '', 'warn:', @_
53  };
54  {
55   eval 'no indirect; my $x = new Foo';
56   like($w, expect('Foo'), "eval 'no indirect; my \$x = new Foo'");
57  }
58  $w = '';
59  {
60   {
61    no indirect;
62    eval 'my $x = new Bar';
63   }
64   if ($] < 5.009005) {
65    is($w, '', "eval 'no indirect; my \$x = new Bar'");
66   } else {
67    like($w, expect('Bar'), "no indirect; eval 'my \$x = new Bar'");
68   }
69  }
70 }
71
72 {
73  my @w;
74  {
75   local $SIG{__WARN__} = sub { push @w, join '', @_ };
76   eval 'no indirect; use indirect::TestRequired';
77  }
78  is         $@, '',  'require test didn\'t croak';
79  is_deeply \@w, [ ], 'pragma didn\'t propagate into the required file';
80 }
81
82 __DATA__
83 my $a = new P1;
84
85 {
86  no indirect;
87  my $b = new P2;
88  {
89   my $c = new P3;
90  }
91  {
92   use indirect;
93   my $d = new P4;
94  }
95  my $e = new P5;
96 }
97
98 my $f = new P6;
99
100 no indirect;
101
102 my $g = new P7;
103
104 use indirect;
105
106 my $h = new P8;
107
108 {
109  no indirect;
110  eval { my $i = new P9 };
111 }
112
113 eval { no indirect; my $j = new P10 };
114
115 {
116  use indirect;
117  new P11 do { use indirect; new P12 };
118 }
119
120 {
121  use indirect;
122  new P13 do { no indirect; new P14 };
123 }
124
125 {
126  no indirect;
127  new P15 do { use indirect; new P16 };
128 }
129
130 {
131  no indirect;
132  new P17 do { no indirect; new P18 };
133 }