6
use if (-d 't'), lib => 't';
7
use vars qw($COUNTER $ERR);
9
9
use Test::More tests => 24;
11
# when tests fail here, it tends to be because one or more of them hasn't run, for whatever reason, rather than failures
12
# thus each test is numbered sequentially so that tests that haven't executed can easily be tracked down
12
15
use Devel::Pragma qw(on_require);
14
use vars qw($COUNTER);
16
17
BEGIN { $COUNTER = 1 }
20
sub { ok($COUNTER < 3, 'pre-require callback called at compile-time ' . $COUNTER) },
21
sub { ok($COUNTER < 3, 'post-require callback called at compile-time ' . $COUNTER); ++$COUNTER },
21
sub { ok($COUNTER < 3, 'test 1: pre-require callback called at compile-time ' . $COUNTER) },
22
sub { ok($COUNTER < 3, 'test 2: post-require callback called at compile-time ' . $COUNTER); ++$COUNTER },
26
27
use require_1; # make sure requiring an already required module doesn't trigger another callback
27
BEGIN { is(require_1::test(), 'require_1', 'require_1 loaded') }
28
BEGIN { is(require_1::test(), 'require_1', 'test 3: require_1 loaded') }
30
31
use require_2; # make sure requiring an already required module doesn't trigger another callback
31
BEGIN { is(require_2::test(), 'require_2', 'require_2 loaded') }
32
BEGIN { is(require_2::test(), 'require_2', 'test 4: require_2 loaded') }
33
BEGIN { is($COUNTER, 3, 'callbacks called twice') }
34
BEGIN { is($COUNTER, 3, 'test 5: callbacks called twice') }
35
36
require require_3; # runtime require should not be hooked
36
is(require_3::test(), 'require_3', 'require_3 loaded');
37
is(require_3::test(), 'require_3', 'test 6: require_3 loaded');
40
41
use Devel::Pragma qw(:all);
42
BEGIN { my_hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
43
BEGIN { hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
52
53
local $SIG{__WARN__} = sub {
54
55
qr{Devel::Pragma: exception in pre-require callback: pre-require exception},
55
'pre-require callback exception raises warning'
56
'test 7: exception in pre-require callback raises warning'
64
is(require_4::test(), 'require_4', 'require_4 loaded');
65
is(my_hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'}, 1, 'exception in pre-require callback caught');
65
is(require_4::test(), 'require_4', 'test 8: require_4 loaded');
66
is(hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'}, 1, 'test 9: exception in pre-require callback caught');
70
71
use Devel::Pragma qw(:all);
72
BEGIN { my_hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
73
BEGIN { hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
82
83
local $SIG{__WARN__} = sub {
84
85
qr{Devel::Pragma: exception in post-require callback: post-require exception},
85
'post-require callback exception raises warning'
86
'test 10: exception in post-require callback raises warning'
94
is(require_5::test(), 'require_5', 'require_5 loaded');
95
is(my_hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'}, 1, 'exception in post-require callback caught');
95
is(require_5::test(), 'require_5', 'test 11: require_5 loaded');
96
is(hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'}, 1, 'test 12: exception in post-require callback caught');
100
101
use Devel::Pragma qw(:all);
104
BEGIN { my_hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'} = 1 }
103
BEGIN { hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'} = 1 }
110
pass('post-require callback still called after require fails');
109
pass('test 13: post-require callback still called after require fails');
111
110
die 'nested exception'
117
116
local $SIG{__WARN__} = sub {
119
118
qr{Devel::Pragma: exception in post-require callback: nested exception},
120
'post-require callback exception after require exception raises warning'
119
'test 14: post-require callback exception after require exception raises warning'
125
124
$ERR = $@; # BEGIN blocks don't appear to propagate $@
128
like($ERR, qr{^Can't locate DevelPragmaNoSuchFile.pm}, 'nested require raises a fatal exception');
127
like($ERR, qr{^Can't locate DevelPragmaNoSuchFile.pm}, 'test 15: nested require raises a fatal exception');
130
BEGIN { is(my_hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'}, 1, '%^H value still set after nested exception') }
129
BEGIN { is(hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'}, 1, 'test 16: %^H value still set after nested exception') }
140
sub { is(++$COUNTER, 1, 'first pre-require callback called first') },
141
sub { is(++$COUNTER, 3, 'first post-require callback called first') },
139
sub { is(++$COUNTER, 1, 'test 17: first pre-require callback called first') },
140
sub { is(++$COUNTER, 3, 'test 18: first post-require callback called first') },
147
sub { is(++$COUNTER, 2, 'second post-require callback called second') },
148
sub { is(++$COUNTER, 4, 'second post-require callback called second') },
146
sub { is(++$COUNTER, 2, 'test 19: second pre-require callback called second') },
147
sub { is(++$COUNTER, 4, 'test 20: second post-require callback called second') },
153
BEGIN { is(require_6::test(), 'require_6', 'require_6 loaded') }
152
BEGIN { is(require_6::test(), 'require_6', 'test 21: require_6 loaded') }
156
155
# make sure the callbacks aren't called out of scope
158
BEGIN { is(require_7::test(), 'require_7', 'require_7 loaded') }
157
BEGIN { is(require_7::test(), 'require_7', 'test 22: require_7 loaded') }