~ubuntu-branches/ubuntu/trusty/libdevel-pragma-perl/trusty

« back to all changes in this revision

Viewing changes to t/require.t

  • Committer: Package Import Robot
  • Author(s): Damyan Ivanov, gregor herrmann, Salvatore Bonaccorso, Damyan Ivanov
  • Date: 2013-10-22 09:41:47 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20131022094147-dewww2ogaornhlov
Tags: 0.60-1
* Team upload

[ gregor herrmann ]
* debian/control: update {versioned,alternative} (build) dependencies.

[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs

[ Damyan Ivanov ]
* Imported Upstream version 0.60
* add years to main upstream copyright notice
* add ppport.h to debian/copyright (how did this escape NEW review?)
* update (build-)dependencies
* bump debhelper build-dependency to ensure hardening support
* claim conformance with Policy 3.9.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
3
3
use strict;
4
4
use warnings;
5
5
 
6
 
use if (-d 't'), lib => 't';
7
 
use vars qw($COUNTER);
 
6
use lib qw(t/lib);
 
7
use vars qw($COUNTER $ERR);
8
8
 
9
9
use Test::More tests => 24;
10
10
 
 
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
 
13
 
11
14
{
12
15
    use Devel::Pragma qw(on_require);
13
16
 
14
 
    use vars qw($COUNTER);
15
 
 
16
17
    BEGIN { $COUNTER = 1 }
17
18
 
18
19
    BEGIN {
19
20
        on_require(
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 },
22
23
        );
23
24
    }
24
25
 
25
26
    use require_1;
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') }
28
29
 
29
30
    use require_2;
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') }
32
33
 
33
 
    BEGIN { is($COUNTER, 3, 'callbacks called twice') }
 
34
    BEGIN { is($COUNTER, 3, 'test 5: callbacks called twice') }
34
35
 
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');
37
38
}
38
39
 
39
40
{
40
41
    use Devel::Pragma qw(:all);
41
42
 
42
 
    BEGIN { my_hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
 
43
    BEGIN { hints->{'PRE_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
43
44
 
44
45
    BEGIN {
45
46
        on_require(
52
53
        local $SIG{__WARN__} =  sub {
53
54
            like($_[0],
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'
56
57
             );
57
58
        };
58
59
 
61
62
    }
62
63
 
63
64
    BEGIN {
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');
66
67
    }
67
68
}
68
69
 
69
70
{
70
71
    use Devel::Pragma qw(:all);
71
72
 
72
 
    BEGIN { my_hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
 
73
    BEGIN { hints->{'POST_REQUIRE_EXCEPTION_CAUGHT'} = 1 }
73
74
 
74
75
    BEGIN {
75
76
        on_require(
82
83
        local $SIG{__WARN__} = sub {
83
84
            like($_[0],
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'
86
87
             );
87
88
        };
88
89
 
91
92
    }
92
93
 
93
94
    BEGIN {
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');
96
97
    }
97
98
}
98
99
 
99
100
{
100
101
    use Devel::Pragma qw(:all);
101
102
 
102
 
    use vars qw($ERR);
103
 
 
104
 
    BEGIN { my_hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'} = 1 }
 
103
    BEGIN { hints->{'CLEANUP_AFTER_NESTED_EXCEPTION'} = 1 }
105
104
 
106
105
    BEGIN {
107
106
        on_require(
108
107
            sub { },
109
108
            sub {
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'
112
111
            }
113
112
        );
117
116
        local $SIG{__WARN__} = sub {
118
117
            like($_[0],
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'
121
120
             );
122
121
        };
123
122
 
125
124
        $ERR = $@; # BEGIN blocks don't appear to propagate $@
126
125
    }
127
126
 
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');
129
128
 
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') }
131
130
}
132
131
 
133
132
{
137
136
 
138
137
    BEGIN {
139
138
        on_require(
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') },
142
141
        );
143
142
    }
144
143
 
145
144
    BEGIN {
146
145
        on_require(
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') },
149
148
        );
150
149
    }
151
150
 
152
151
    use require_6;
153
 
    BEGIN { is(require_6::test(), 'require_6', 'require_6 loaded') }
 
152
    BEGIN { is(require_6::test(), 'require_6', 'test 21: require_6 loaded') }
154
153
}
155
154
 
156
155
# make sure the callbacks aren't called out of scope
157
156
use require_7;
158
 
BEGIN { is(require_7::test(), 'require_7', 'require_7 loaded') }
 
157
BEGIN { is(require_7::test(), 'require_7', 'test 22: require_7 loaded') }