ext/XS-APItest/t/blockhooks.t

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Test::More tests => 17;
   6
   7 use XS::APItest;
   8 use t::BHK ();      # make sure it gets compiled early
   9
  10 BEGIN { package XS::APItest; *main::bhkav = \@XS::APItest::bhkav }
  11
  12 # 'use t::BHK' switches on recording hooks, and clears @bhkav.
  13 # 'no t::BHK' switches recording off again.
  14 # 'use t::BHK push => "foo"' pushes onto @bhkav
  15
  16 BEGIN { diag "## COMPILE TIME ##" }
  17 diag "## RUN TIME ##";
  18
  19 use t::BHK;
  20     1;
  21 no t::BHK;
  22
  23 BEGIN { is_deeply \@bhkav, [], "no blocks" }
  24
  25 use t::BHK;
  26     {
  27         1;
  28     }
  29 no t::BHK;
  30
  31 BEGIN { is_deeply \@bhkav,
  32     [[start => 1], qw/pre_end post_end/],
  33     "plain block";
  34 }
  35
  36 use t::BHK;
  37     if (1) { 1 }
  38 no t::BHK;
  39
  40 BEGIN { is_deeply \@bhkav,
  41     [
  42         [start => 1],
  43         [start => 0],
  44         qw/pre_end post_end/,
  45         qw/pre_end post_end/,
  46     ],
  47     "if block";
  48 }
  49
  50 use t::BHK;
  51     for (1) { 1 }
  52 no t::BHK;
  53
  54 BEGIN { is_deeply \@bhkav,
  55     [
  56         [start => 1],
  57         [start => 0],
  58         qw/pre_end post_end/,
  59         qw/pre_end post_end/,
  60     ],
  61     "for loop";
  62 }
  63
  64 use t::BHK;
  65     {
  66         { 1; }
  67     }
  68 no t::BHK;
  69
  70 BEGIN { is_deeply \@bhkav,
  71     [
  72         [start => 1],
  73         [start => 1],
  74         qw/pre_end post_end/,
  75         qw/pre_end post_end/,
  76     ],
  77     "nested blocks";
  78 }
  79
  80 use t::BHK;
  81     use t::BHK push => "before";
  82     {
  83         use t::BHK push => "inside";
  84     }
  85     use t::BHK push => "after";
  86 no t::BHK;
  87
  88 BEGIN { is_deeply \@bhkav,
  89     [
  90         "before",
  91         [start => 1],
  92         "inside",
  93         qw/pre_end post_end/,
  94         "after"
  95     ],
  96     "hooks called in the correct places";
  97 }
  98
  99 use t::BHK;
 100     BEGIN { 1 }
 101 no t::BHK;
 102
 103 BEGIN { is_deeply \@bhkav,
 104     [
 105         [start => 1],
 106         qw/pre_end post_end/,
 107     ],
 108     "BEGIN block";
 109 }
 110
 111 use t::BHK; t::BHK->import;
 112     eval "1";
 113 no t::BHK; t::BHK->unimport;
 114
 115 BEGIN { is_deeply \@bhkav, [], "string eval (compile)" }
 116 is_deeply \@bhkav,
 117     [
 118         [eval => "entereval"],
 119         [start => 1],
 120         qw/pre_end post_end/,
 121     ],
 122     "string eval (run)";
 123
 124 delete @INC{qw{t/Null.pm t/Block.pm}};
 125
 126 t::BHK->import;
 127     do "t/Null.pm";
 128 t::BHK->unimport;
 129
 130 is_deeply \@bhkav,
 131     [
 132         [eval => "dofile"],
 133         [start => 1],
 134         qw/pre_end post_end/,
 135     ],
 136     "do file (null)";
 137
 138 t::BHK->import;
 139     do "t/Block.pm";
 140 t::BHK->unimport;
 141
 142 is_deeply \@bhkav,
 143     [
 144         [eval => "dofile"],
 145         [start => 1],
 146         [start => 1],
 147         qw/pre_end post_end/,
 148         qw/pre_end post_end/,
 149     ],
 150     "do file (single block)";
 151
 152 delete @INC{qw{t/Null.pm t/Block.pm}};
 153
 154 t::BHK->import;
 155     require t::Null;
 156 t::BHK->unimport;
 157
 158 is_deeply \@bhkav,
 159     [
 160         [eval => "require"],
 161         [start => 1],
 162         qw/pre_end post_end/,
 163     ],
 164     "require (null)";
 165
 166 t::BHK->import;
 167     require t::Block;
 168 t::BHK->unimport;
 169
 170 is_deeply \@bhkav,
 171     [
 172         [eval => "require"],
 173         [start => 1],
 174         [start => 1],
 175         qw/pre_end post_end/,
 176         qw/pre_end post_end/,
 177     ],
 178     "require (single block)";
 179
 180 BEGIN { delete $INC{"t/Block.pm"} }
 181
 182 use t::BHK;
 183     use t::Block;
 184 no t::BHK;
 185
 186 BEGIN { is_deeply \@bhkav,
 187     [
 188         [eval => "require"],
 189         [start => 1],
 190         [start => 1],
 191         qw/pre_end post_end/,
 192         qw/pre_end post_end/,
 193     ],
 194     "use (single block)";
 195 }
 196
 197 BEGIN { delete $INC{"t/Markers.pm"} }
 198
 199 use t::BHK;
 200     use t::BHK push => "compile/main/before";
 201     use t::Markers;
 202     use t::BHK push => "compile/main/after";
 203 no t::BHK;
 204
 205 BEGIN { is_deeply \@bhkav,
 206     [
 207         "compile/main/before",
 208         [eval => "require"],
 209         [start => 1],
 210             "compile/pm/before",
 211             [start => 1],
 212                 "compile/pm/inside",
 213             qw/pre_end post_end/,
 214             "compile/pm/after",
 215         qw/pre_end post_end/,
 216         "run/pm",
 217         "run/import",
 218         "compile/main/after",
 219     ],
 220     "use with markers";
 221 }
 222
 223 # OK, now some *really* evil stuff...
 224
 225 BEGIN {
 226     package EvalDestroy;
 227
 228     sub DESTROY { $_[0]->() }
 229 }
 230
 231 use t::BHK;
 232     {
 233         BEGIN {
 234             # grumbleSCOPECHECKgrumble
 235             push @XS::APItest::COMPILE_SCOPE_CONTAINER,
 236                 bless sub {
 237                     push @bhkav, "DESTROY";
 238                 }, "EvalDestroy";
 239         }
 240         1;
 241     }
 242 no t::BHK;
 243
 244 BEGIN { is_deeply \@bhkav,
 245     [
 246         [start => 1],                   # block
 247             [start => 1],               # BEGIN
 248                 [start => 1],           # sub
 249                 qw/pre_end post_end/,
 250             qw/pre_end post_end/,
 251         "pre_end",
 252             "DESTROY",
 253         "post_end",
 254     ],
 255     "compile-time DESTROY comes between pre_ and post_end";
 256 }
 257
 258 use t::BHK;
 259     {
 260         BEGIN {
 261             push @XS::APItest::COMPILE_SCOPE_CONTAINER,
 262                 bless sub {
 263                     eval "{1}";
 264                 }, "EvalDestroy";
 265         }
 266         1;
 267     }
 268 no t::BHK;
 269
 270 BEGIN { is_deeply \@bhkav,
 271     [
 272         [start => 1],                   # block
 273             [start => 1],               # BEGIN
 274                 [start => 1],           # sub
 275                 qw/pre_end post_end/,
 276             qw/pre_end post_end/,
 277         "pre_end",
 278             [eval => "entereval"],
 279             [start => 1],               # eval
 280                 [start => 1],           # block inside eval
 281                 qw/pre_end post_end/,
 282             qw/pre_end post_end/,
 283         "post_end",
 284     ],
 285     "evil eval-in-DESTROY tricks";
 286 }