X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F10-args.t;h=4037c60eb95231591255b08f4c613dfc46b64018;hp=6b7b61c2b0d97a3cf90954a027fbdbcb0803e50c;hb=84cf20f38df18db8a29e9d4676b2ffa97451c83a;hpb=50cf1763d6570e6589e3e809aede60d7e3f1912e diff --git a/t/10-args.t b/t/10-args.t index 6b7b61c..4037c60 100644 --- a/t/10-args.t +++ b/t/10-args.t @@ -1,17 +1,58 @@ -#!perl +#!perl -T use strict; use warnings; -use Test::More tests => 1; +use Test::More tests => 4 + 1 + 1; + +BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} } + +sub expect { + my ($pkg) = @_; + qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/; +} + +{ + my @warns; + { + 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 $@, '', '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 Croaked; + $x = new NotReached; + HERE + } + like $@, expect('Croaked'), 'croaks when :fatal is specified'; +} { - local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; - eval < 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'; }