ext/XS/APItest/t/xs_special_subs_require.t

   1 #!perl -w
   2 BEGIN {
   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
  16 use strict;
  17 use warnings;
  18 my $uc;
  19 BEGIN {
  20     $uc = $] > 5.009;
  21 }
  22 use 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
  26 BEGIN {
  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
  42 CHECK {
  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
  58 INIT {
  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
  74 END {
  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
  88 print "# First body\n";
  89 is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
  90 is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
  91 is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called") if $uc;
  92 is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called") if $uc;
  93 is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
  94 is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
  95 is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
  96 is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
  97 is($XS::APItest::END_called, undef, "END not yet called");
  98 is($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
 111 print "# Second body\n";
 112 is($XS::APItest::BEGIN_called, 1, "BEGIN called");
 113 is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
 114 is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
 115 is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
 116 is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
 117 is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
 118 is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
 119 is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
 120 is($XS::APItest::END_called, undef, "END not yet called");
 121 is($XS::APItest::END_called_PP, undef, "END not yet called");
 122
 123 BEGIN {
 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
 139 CHECK {
 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
 155 INIT {
 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
 171 END {
 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 }