X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F10-args.t;h=4037c60eb95231591255b08f4c613dfc46b64018;hp=bb44e978fb1e346c02e01bd9db1f01f7c171e884;hb=e11d9a3efc1dcc5648202bd7651a982477bbc587;hpb=cfbd22399e253cbac1aad5436d2b191082befe14 diff --git a/t/10-args.t b/t/10-args.t index bb44e97..4037c60 100644 --- a/t/10-args.t +++ b/t/10-args.t @@ -5,46 +5,54 @@ use warnings; use Test::More tests => 4 + 1 + 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'; + { + 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'; }