xs_special_subs_require.t revision 1.1.1.1 
1#!perl -w
2BEGIN {
3    chdir 't' if -d 't';
4    @INC = '../lib';
5    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
6    require Config; import Config;
7    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
8        print "1..0 # Skip: XS::APItest was not built\n";
9        exit 0;
10    }
11    # Hush the used only once warning.
12    $XS::APItest::WARNINGS_ON_BOOTSTRAP = $MacPerl::Architecture;
13    $XS::APItest::WARNINGS_ON_BOOTSTRAP = 1;
14}
15
16use strict;
17use warnings;
18my $uc;
19BEGIN {
20    $uc = $] > 5.009;
21}
22use Test::More tests => $uc ? 103 : 83;
23
24# Doing this longhand cut&paste makes it clear
25# BEGIN and INIT are FIFO, CHECK and END are LIFO
26BEGIN {
27    print "# First BEGIN\n";
28    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
29    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
30    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
31       if $uc;
32    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
33       if $uc;
34    is($XS::APItest::CHECK_called, undef, "CHECK not called");
35    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
36    is($XS::APItest::INIT_called, undef, "INIT not called");
37    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
38    is($XS::APItest::END_called, undef, "END not yet called");
39    is($XS::APItest::END_called_PP, undef, "END not yet called");
40}
41
42CHECK {
43    print "# First CHECK\n";
44    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
45    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
46    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
47       if $uc;
48    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
49       if $uc;
50    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
51    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
52    is($XS::APItest::INIT_called, undef, "INIT not called");
53    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
54    is($XS::APItest::END_called, undef, "END not yet called");
55    is($XS::APItest::END_called_PP, undef, "END not yet called");
56}
57
58INIT {
59    print "# First INIT\n";
60    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
61    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
62    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
63       if $uc;
64    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
65       if $uc;
66    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
67    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
68    is($XS::APItest::INIT_called, undef, "INIT not called");
69    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
70    is($XS::APItest::END_called, undef, "END not yet called");
71    is($XS::APItest::END_called_PP, undef, "END not yet called");
72}
73
74END {
75    print "# First END\n";
76    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
77    is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
78    is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
79    is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
80    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
81    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
82    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
83    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
84    is($XS::APItest::END_called, 1, "END called");
85    is($XS::APItest::END_called_PP, 1, "END called");
86}
87
88print "# First body\n";
89is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
90is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
91is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called") if $uc;
92is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called") if $uc;
93is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
94is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
95is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
96is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
97is($XS::APItest::END_called, undef, "END not yet called");
98is($XS::APItest::END_called_PP, undef, "END not yet called");
99
100{
101    my @trap;
102    local $SIG{__WARN__} = sub { push @trap, join "!", @_ };
103    require XS::APItest;
104
105    @trap = sort @trap;
106    is(scalar @trap, 2, "There were 2 warnings");
107    is($trap[0], "Too late to run CHECK block.\n");
108    is($trap[1], "Too late to run INIT block.\n");
109}
110
111print "# Second body\n";
112is($XS::APItest::BEGIN_called, 1, "BEGIN called");
113is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
114is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
115is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
116is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
117is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
118is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
119is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
120is($XS::APItest::END_called, undef, "END not yet called");
121is($XS::APItest::END_called_PP, undef, "END not yet called");
122
123BEGIN {
124    print "# Second BEGIN\n";
125    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
126    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
127    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
128	if $uc;
129    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
130	if $uc;
131    is($XS::APItest::CHECK_called, undef, "CHECK not called");
132    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
133    is($XS::APItest::INIT_called, undef, "INIT not called");
134    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
135    is($XS::APItest::END_called, undef, "END not yet called");
136    is($XS::APItest::END_called_PP, undef, "END not yet called");
137}
138
139CHECK {
140    print "# Second CHECK\n";
141    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
142    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
143    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
144	if $uc;
145    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
146	if $uc;
147    is($XS::APItest::CHECK_called, undef, "CHECK not called");
148    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
149    is($XS::APItest::INIT_called, undef, "INIT not called");
150    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
151    is($XS::APItest::END_called, undef, "END not yet called");
152    is($XS::APItest::END_called_PP, undef, "END not yet called");
153}
154
155INIT {
156    print "# Second INIT\n";
157    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
158    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
159    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
160	if $uc;
161    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
162	if $uc;
163    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
164    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
165    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
166    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
167    is($XS::APItest::END_called, undef, "END not yet called");
168    is($XS::APItest::END_called_PP, undef, "END not yet called");
169}
170
171END {
172    print "# Second END\n";
173    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
174    is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
175    is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
176    is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
177    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
178    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
179    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
180    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
181    is($XS::APItest::END_called, 1, "END called");
182    is($XS::APItest::END_called_PP, 1, "END called");
183}
184