X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F10-args.t;h=bacf850354c9860a801942be79fbaa946ba84168;hp=bb44e978fb1e346c02e01bd9db1f01f7c171e884;hb=485841aab90380ffecbe0f217eb234a64f69bb25;hpb=cfbd22399e253cbac1aad5436d2b191082befe14 diff --git a/t/10-args.t b/t/10-args.t index bb44e97..bacf850 100644 --- a/t/10-args.t +++ b/t/10-args.t @@ -3,48 +3,56 @@ use strict; use warnings; -use Test::More tests => 4 + 1 + 1; +use Test::More tests => 4 + 3 + 1; + +BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} } sub expect { my ($pkg) = @_; - 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+\d+/; + qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/; } { my @warns; - local $SIG{__WARN__} = sub { push @warns, "@_" }; - eval <<'HERE'; - die qq{ok\n}; - no indirect; - my $x = new Warn1; - $x = new Warn2; -HERE + { + local $SIG{__WARN__} = sub { push @warns, "@_" }; + eval <<' HERE'; + return; + no indirect; + my $x = new Warn1; + $x = new Warn2; + HERE + } my $w1 = shift @warns; my $w2 = shift @warns; - is $@, "ok\n", 'didn\'t croak without arguments'; + is $@, '', 'didn\'t croak without arguments'; like $w1, expect('Warn1'), 'first warning caught without arguments'; like $w2, expect('Warn2'), 'second warning caught without arguments'; is_deeply \@warns, [ ], 'no more warnings without arguments'; } -{ - local $SIG{__WARN__} = sub { die "warn:@_" }; - eval <<'HERE'; - die qq{shouldn't even compile\n}; - no indirect ':fatal', hook => sub { die 'should not be called' }; - my $x = new Fatal; - $x = new NotReached; -HERE - like $@, expect('Fatal'), 'croaks when :fatal is specified'; +for my $fatal (':fatal', 'FATAL', ':Fatal') { + { + local $SIG{__WARN__} = sub { die "warn:@_" }; + eval <<" HERE"; + die qq{shouldn't even compile\n}; + no indirect '$fatal', hook => sub { die 'should not be called' }; + my \$x = new Croaked; + \$x = new NotReached; + HERE + } + like $@, expect('Croaked'), "croaks when $fatal is specified"; } { - local $SIG{__WARN__} = sub { "warn:@_" }; - eval <<'HERE'; - die qq{shouldn't even compile\n}; - no indirect 'whatever', hook => sub { die 'hook:' . join(':', @_) . "\n" }, ':fatal'; - my $x = new Hooked; - $x = new AlsoNotReached; -HERE + { + local $SIG{__WARN__} = sub { "warn:@_" }; + eval <<' HERE'; + die qq{shouldn't even compile\n}; + no indirect 'whatever', hook => sub { die 'hook:' . join(':', @_) . "\n" }, ':fatal'; + my $x = new Hooked; + $x = new AlsoNotReached; + HERE + } like $@, qr/^hook:Hooked:new:\(eval\s+\d+\):\d+$/, 'calls the specified hook'; }