X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F30-scope.t;h=8eb7eccb975042c5a45a9e45f339ddaca0bc2015;hp=2546dee6a954bac24e34c41f89d567d4e35d0205;hb=3b0a87b6115bb15525313ea0dc3def689d2fb2e8;hpb=fdc979b79c21fcaa1fdd8e9a465756510ed26e88 diff --git a/t/30-scope.t b/t/30-scope.t index 2546dee..8eb7ecc 100644 --- a/t/30-scope.t +++ b/t/30-scope.t @@ -4,15 +4,17 @@ use strict; use warnings; my $tests; -BEGIN { $tests = 10 } +BEGIN { $tests = 18 } -use Test::More tests => 1 + $tests + 1 + 2; +use Test::More tests => 1 + $tests + 1 + 2 + 2; -my %wrong = map { $_ => 1 } 2, 3, 5, 7, 9, 10; +use lib 't/lib'; + +my %wrong = map { $_ => 1 } 2, 3, 5, 7, 9, 10, 14, 15, 17, 18; sub expect { my ($pkg) = @_; - return qr/^warn:Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"/; + 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+/; } { @@ -59,7 +61,7 @@ sub expect { no indirect; eval 'my $x = new Bar'; } - if ($] < 5.010) { + if ($] < 5.009005) { is($w, '', "eval 'no indirect; my \$x = new Bar'"); } else { like($w, expect('Bar'), "no indirect; eval 'my \$x = new Bar'"); @@ -67,6 +69,17 @@ sub expect { } } +{ + local $TODO = 'Need a workaround for this' if $] < 5.010001; + my @w; + { + local $SIG{__WARN__} = sub { push @w, join '', @_ }; + eval 'no indirect; use indirect::TestRequired'; + } + is $@, '', 'require test didn\'t croak'; + is_deeply \@w, [ ], 'pragma didn\'t propagate into the required file'; +} + __DATA__ my $a = new P1; @@ -99,3 +112,23 @@ my $h = new P8; } eval { no indirect; my $j = new P10 }; + +{ + use indirect; + new P11 do { use indirect; new P12 }; +} + +{ + use indirect; + new P13 do { no indirect; new P14 }; +} + +{ + no indirect; + new P15 do { use indirect; new P16 }; +} + +{ + no indirect; + new P17 do { no indirect; new P18 }; +}