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