1#!perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    require './test.pl';
6    set_up_inc( qw(../lib) );
7}
8
9use strict;
10use warnings;
11
12plan(tests => 14);
13
14{
15    fresh_perl_like(
16        '${^HOOK}{require__before} = "x";',
17        qr!\$\{\^HOOK\}\{require__before\} may only be a CODE reference or undef!,
18        { },
19        '%{^HOOK} forbids non code refs (string)');
20}
21{
22    fresh_perl_like(
23        '${^HOOK}{require__before} = [];',
24        qr!\$\{\^HOOK\}\{require__before\} may only be a CODE reference or undef!,
25        { },
26        '%{^HOOK} forbids non code refs (array)');
27}
28{
29    fresh_perl_like(
30        '${^HOOK}{require__before} = sub { die "Not allowed to load $_[0]" }; require Frobnitz;',
31        qr!Not allowed to load Frobnitz\.pm!,
32        { },
33        '${^HOOK}{require__before} exceptions stop require');
34}
35{
36    fresh_perl_is(
37        'use lib "./lib/caller"; '.
38        '${^HOOK}{require__before} = '.
39        '  sub { my ($name) = @_; warn "before $name"; ' .
40        '       return sub { warn "after $name" } }; ' .
41        'require Apack;',
42        <<'EOF_WANT',
43before Apack.pm at - line 1.
44before Bpack.pm at - line 1.
45before Cpack.pm at - line 1.
46after Cpack.pm at - line 1.
47after Bpack.pm at - line 1.
48after Apack.pm at - line 1.
49EOF_WANT
50        { },
51        '${^HOOK}{require__before} with post action works as expected with t/lib/caller/Apack');
52}
53{
54    fresh_perl_is(
55        'use lib "./lib/caller"; '.
56        '${^HOOK}{require__before} = '.
57        '  sub { $_[0] = "Apack.pm" if $_[0] eq "Cycle.pm";'.
58        '        my ($name) = @_; warn "before $name"; ' .
59        '        return sub { warn "after $name" } }; ' .
60        'require Cycle;',
61        <<'EOF_WANT',
62before Apack.pm at - line 1.
63before Bpack.pm at - line 1.
64before Cpack.pm at - line 1.
65after Cpack.pm at - line 1.
66after Bpack.pm at - line 1.
67after Apack.pm at - line 1.
68EOF_WANT
69        { },
70        '${^HOOK}{require__before} with filename rewrite works as expected (Cycle.pm -> Apack.pm)');
71}
72{
73    fresh_perl_is(
74        'use lib "./lib/caller"; '.
75        '${^HOOK}{require__before} = '.
76        '  sub { my ($name) = @_; my $n = ++$::counter; warn "before $name ($n)"; ' .
77        '       return sub { warn "after $name ($n)" } }; ' .
78        'require Cycle;',
79        <<'EOF_WANT',
80before Cycle.pm (1) at - line 1.
81before Bicycle.pm (2) at - line 1.
82before Tricycle.pm (3) at - line 1.
83before Cycle.pm (4) at - line 1.
84after Cycle.pm (4) at - line 1.
85after Tricycle.pm (3) at - line 1.
86after Bicycle.pm (2) at - line 1.
87after Cycle.pm (1) at - line 1.
88EOF_WANT
89        { },
90        '${^HOOK}{require__before} with post action with state work as expected with t/lib/caller/Cycle');
91}
92{
93    fresh_perl_is(
94        'use lib "./lib/caller"; my @seen;'.
95        '${^HOOK}{require__before} = '.
96        '  sub { die "Cycle detected: @seen $_[0]\n" if grep $_ eq $_[0], @seen; push @seen,$_[0]; ' .
97        '       return sub { pop @seen } }; ' .
98        'require Cycle;',
99        <<'EOF_WANT',
100Cycle detected: Cycle.pm Bicycle.pm Tricycle.pm Cycle.pm
101Compilation failed in require at lib/caller/Bicycle.pm line 1.
102Compilation failed in require at lib/caller/Cycle.pm line 1.
103Compilation failed in require at - line 1.
104EOF_WANT
105        { },
106        '${^HOOK}{require__before} with post action with state work as expected with t/lib/caller/Cycle');
107}
108{
109    fresh_perl_is(
110        'use lib "./lib/caller"; '.
111        '${^HOOK}{require__before} = '.
112        '  sub { my ($before_name) = @_; warn "before $before_name"; ' .
113        '       return sub { my ($after_name) = @_; warn "after $after_name" } }; ' .
114        'require Apack;',
115        <<'EOF_WANT',
116before Apack.pm at - line 1.
117before Bpack.pm at - line 1.
118before Cpack.pm at - line 1.
119after Cpack.pm at - line 1.
120after Bpack.pm at - line 1.
121after Apack.pm at - line 1.
122EOF_WANT
123        { },
124        '${^HOOK}{require__before} with post action and name arg works as expected');
125}
126{
127    fresh_perl_is(
128        'use lib "./lib/caller"; '.
129        '${^HOOK}{require__before} = '.
130        '  sub { my ($name) = @_; warn "before $name" };' .
131        'require Apack;',
132        <<'EOF_WANT',
133before Apack.pm at - line 1.
134before Bpack.pm at - line 1.
135before Cpack.pm at - line 1.
136EOF_WANT
137        { },
138        '${^HOOK}{require__before} with no post action works as expected with t/lib/caller/Apack');
139}
140{
141    fresh_perl_is(
142        'use lib "./lib/caller"; '.
143        '${^HOOK}{require__after} = '.
144        '  sub { my ($name) = @_; warn "after $name" };' .
145        'require Apack;',
146        <<'EOF_WANT',
147after Cpack.pm at - line 1.
148after Bpack.pm at - line 1.
149after Apack.pm at - line 1.
150EOF_WANT
151        { },
152        '${^HOOK}{require__after} works as expected with t/lib/caller/Apack');
153}
154{
155    fresh_perl_is(
156        'use lib "./lib/caller"; '.
157        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" },
158                      require__after => sub { print "after: $_[0]\n" } );
159         { local %{^HOOK}; require Apack; }
160         print "done\n";',
161         "done\n",
162         { },
163         'local %{^HOOK} works to clear hooks.'
164    );
165}
166{
167    fresh_perl_is(
168        'use lib "./lib/caller"; '.
169        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" },
170                      require__after => sub { print "after: $_[0]\n" } );
171         { local %{^HOOK}; require Cycle; }
172         require Apack;',
173        <<'EOF_WANT',
174before: Apack.pm
175before: Bpack.pm
176before: Cpack.pm
177after: Cpack.pm
178after: Bpack.pm
179after: Apack.pm
180EOF_WANT
181         { },
182         'local %{^HOOK} works to clear and restore hooks.'
183    );
184}
185{
186    fresh_perl_is(
187        'use lib "./lib/caller"; '.
188        '%{^HOOK} = ( require__before => sub { print "before: $_[0]\n" } );
189         %{^HOOK} = ( require__after  => sub { print "after: $_[0]\n" } );
190         require Apack;',
191        <<'EOF_WANT',
192after: Cpack.pm
193after: Bpack.pm
194after: Apack.pm
195EOF_WANT
196         { },
197         '%{^HOOK} = (...); works as expected (part 1)'
198    );
199}
200
201{
202    fresh_perl_is(
203        'use lib "./lib/caller"; '.
204        '%{^HOOK} = ( require__after  => sub { print "after: $_[0]\n" } );
205         %{^HOOK} = ( require__before => sub { print "before: $_[0]\n" } );
206         require Apack;',
207        <<'EOF_WANT',
208before: Apack.pm
209before: Bpack.pm
210before: Cpack.pm
211EOF_WANT
212         { },
213         '%{^HOOK} = (...); works as expected (part 2)'
214    );
215}
216