Add a TODO test for the "pragma propagating into require" issue
[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  local $TODO = 'Need a workaround for this' if $] < 5.010001;
74  my @w;
75  {
76   local $SIG{__WARN__} = sub { push @w, join '', @_ };
77   eval 'no indirect; use indirect::TestRequired';
78  }
79  is         $@, '',  'require test didn\'t croak';
80  is_deeply \@w, [ ], 'pragma didn\'t propagate into the required file';
81 }
82
83 __DATA__
84 my $a = new P1;
85
86 {
87  no indirect;
88  my $b = new P2;
89  {
90   my $c = new P3;
91  }
92  {
93   use indirect;
94   my $d = new P4;
95  }
96  my $e = new P5;
97 }
98
99 my $f = new P6;
100
101 no indirect;
102
103 my $g = new P7;
104
105 use indirect;
106
107 my $h = new P8;
108
109 {
110  no indirect;
111  eval { my $i = new P9 };
112 }
113
114 eval { no indirect; my $j = new P10 };
115
116 {
117  use indirect;
118  new P11 do { use indirect; new P12 };
119 }
120
121 {
122  use indirect;
123  new P13 do { no indirect; new P14 };
124 }
125
126 {
127  no indirect;
128  new P15 do { use indirect; new P16 };
129 }
130
131 {
132  no indirect;
133  new P17 do { no indirect; new P18 };
134 }