]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/10-args.t
Update VPIT::TestHelpers to 3c878c7c
[perl/modules/indirect.git] / t / 10-args.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 4 + 3 + 1 + 2;
7
8 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
9
10 sub expect {
11  my ($pkg) = @_;
12  qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/;
13 }
14
15 {
16  my @warns;
17  {
18   local $SIG{__WARN__} = sub { push @warns, "@_" };
19   eval <<'  HERE';
20    return;
21    no indirect;
22    my $x = new Warn1;
23    $x = new Warn2;
24   HERE
25  }
26  my $w1 = shift @warns;
27  my $w2 = shift @warns;
28  is             $@, '',              'didn\'t croak without arguments';
29  like          $w1, expect('Warn1'), 'first warning caught without arguments';
30  like          $w2, expect('Warn2'), 'second warning caught without arguments';
31  is_deeply \@warns, [ ],             'no more warnings without arguments';
32 }
33
34 for my $fatal (':fatal', 'FATAL', ':Fatal') {
35  {
36   local $SIG{__WARN__} = sub { die "warn:@_" };
37   eval <<"  HERE";
38    die qq{shouldn't even compile\n};
39    no indirect '$fatal';
40    my \$x = new Croaked;
41    \$x = new NotReached;
42   HERE
43  }
44  like $@, expect('Croaked'), "croaks when $fatal is specified";
45 }
46
47 {
48  {
49   local $SIG{__WARN__} = sub { "warn:@_" };
50   eval <<'  HERE';
51    die qq{shouldn't even compile\n};
52    no indirect 'whatever', hook => sub { die 'hook:' . join(':', @_) . "\n" };
53    my $x = new Hooked;
54    $x = new AlsoNotReached;
55   HERE
56  }
57  like $@, qr/^hook:Hooked:new:\(eval\s+\d+\):\d+$/, 'calls the specified hook';
58 }
59
60 {
61  my $no_hook_and_fatal = qr/^The 'fatal' and 'hook' options are mutually exclusive at \(eval \d+\) line \d+/;
62
63  {
64   local $SIG{__WARN__} = sub { die "warn:@_" };
65   eval <<'  HERE';
66    die qq{shouldn't even compile\n};
67    no indirect 'fatal', hook => sub { };
68    new NotReached;
69   HERE
70  }
71  like $@, $no_hook_and_fatal, '"no indirect qw<fatal hook>" croaks';
72
73  {
74   local $SIG{__WARN__} = sub { die "warn:@_" };
75   eval <<'  HERE';
76    die qq{shouldn't even compile\n};
77    no indirect hook => sub { }, 'fatal';
78    new NotReached;
79   HERE
80  }
81  like $@, $no_hook_and_fatal, '"no indirect qw<hook fatal>" croaks';
82 }