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