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