ext/B/t/optree_specials.t

   1 #!./perl
   2
   3 # This tests the B:: module(s) with CHECK, BEGIN, END and INIT blocks. The
   4 # text excerpts below marked with "# " in front are the expected output. They
   5 # are there twice, EOT for threading, and EONT for a non-threading Perl. The
   6 # output is matched losely. If the match fails even though the "got" and
   7 # "expected" output look exactly the same, then watch for trailing, invisible
   8 # spaces.
   9
  10 BEGIN {
  11     if ($ENV{PERL_CORE}){
  12         chdir('t') if -d 't';
  13         @INC = ('.', '../lib', '../ext/B/t');
  14     } else {
  15         unshift @INC, 't';
  16         push @INC, "../../t";
  17     }
  18     require Config;
  19     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
  20         print "1..0 # Skip -- Perl configured without B module\n";
  21         exit 0;
  22     }
  23     # require 'test.pl'; # now done by OptreeCheck
  24 }
  25
  26 # import checkOptree(), and %gOpts (containing test state)
  27 use OptreeCheck;        # ALSO DOES @ARGV HANDLING !!!!!!
  28 use Config;
  29
  30 plan tests => 7 + ($] > 5.009 ? 1 : 0);
  31
  32 require_ok("B::Concise");
  33
  34 my $out = runperl(
  35     switches => ["-MO=Concise,BEGIN,CHECK,INIT,END,-exec"],
  36     prog => q{$a=$b && print q/foo/},
  37     stderr => 1 );
  38
  39 #print "out:$out\n";
  40
  41 my $src = q[our ($beg, $chk, $init, $end, $uc) = qq{'foo'}; BEGIN { $beg++ } CHECK { $chk++ } INIT { $init++ } END { $end++ } UNITCHECK {$uc++}];
  42
  43
  44 my @warnings_todo;
  45 @warnings_todo = (todo =>
  46    "Change 23768 (Remove Carp from warnings.pm) alters expected output, not"
  47    . "propagated to 5.8.x")
  48     if $] < 5.009;
  49
  50 checkOptree ( name      => 'BEGIN',
  51               bcopts    => 'BEGIN',
  52               prog      => $src,
  53               @warnings_todo,
  54               strip_open_hints => 1,
  55               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  56 # BEGIN 1:
  57 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
  58 # -     <@> lineseq KP ->b
  59 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
  60 # 3        <1> require sK/1 ->4
  61 # 2           <$> const[PV "warnings.pm"] s/BARE ->3
  62 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
  63 # -        <@> lineseq K ->-
  64 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
  65 # a           <1> entersub[t1] KS*/TARG,2 ->b
  66 # 6              <0> pushmark s ->7
  67 # 7              <$> const[PV "warnings"] sM ->8
  68 # 8              <$> const[PV "qw"] sM ->9
  69 # 9              <$> method_named[PV "import"] ->a
  70 # BEGIN 2:
  71 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
  72 # -     <@> lineseq KP ->f
  73 # c        <;> nextstate(main 2 -e:1) v:>,<,%,{ ->d
  74 # e        <1> postinc[t3] sK/1 ->f
  75 # -           <1> ex-rv2sv sKRM/1 ->e
  76 # d              <#> gvsv[*beg] s ->e
  77 EOT_EOT
  78 # BEGIN 1:
  79 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
  80 # -     <@> lineseq KP ->b
  81 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
  82 # 3        <1> require sK/1 ->4
  83 # 2           <$> const(PV "warnings.pm") s/BARE ->3
  84 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
  85 # -        <@> lineseq K ->-
  86 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
  87 # a           <1> entersub[t1] KS*/TARG,2 ->b
  88 # 6              <0> pushmark s ->7
  89 # 7              <$> const(PV "warnings") sM ->8
  90 # 8              <$> const(PV "qw") sM ->9
  91 # 9              <$> method_named(PV "import") ->a
  92 # BEGIN 2:
  93 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
  94 # -     <@> lineseq KP ->f
  95 # c        <;> nextstate(main 2 -e:1) v:>,<,%,{ ->d
  96 # e        <1> postinc[t2] sK/1 ->f
  97 # -           <1> ex-rv2sv sKRM/1 ->e
  98 # d              <$> gvsv(*beg) s ->e
  99 EONT_EONT
 100
 101
 102 checkOptree ( name      => 'END',
 103               bcopts    => 'END',
 104               prog      => $src,
 105               strip_open_hints => 1,
 106               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 107 # END 1:
 108 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 109 # -     <@> lineseq KP ->4
 110 # 1        <;> nextstate(main 5 -e:6) v:>,<,%,{ ->2
 111 # 3        <1> postinc[t3] sK/1 ->4
 112 # -           <1> ex-rv2sv sKRM/1 ->3
 113 # 2              <#> gvsv[*end] s ->3
 114 EOT_EOT
 115 # END 1:
 116 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 117 # -     <@> lineseq KP ->4
 118 # 1        <;> nextstate(main 5 -e:6) v:>,<,%,{ ->2
 119 # 3        <1> postinc[t2] sK/1 ->4
 120 # -           <1> ex-rv2sv sKRM/1 ->3
 121 # 2              <$> gvsv(*end) s ->3
 122 EONT_EONT
 123
 124
 125 checkOptree ( name      => 'CHECK',
 126               bcopts    => 'CHECK',
 127               prog      => $src,
 128               strip_open_hints => 1,
 129               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 130 # CHECK 1:
 131 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 132 # -     <@> lineseq KP ->4
 133 # 1        <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2
 134 # 3        <1> postinc[t3] sK/1 ->4
 135 # -           <1> ex-rv2sv sKRM/1 ->3
 136 # 2              <#> gvsv[*chk] s ->3
 137 EOT_EOT
 138 # CHECK 1:
 139 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 140 # -     <@> lineseq KP ->4
 141 # 1        <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2
 142 # 3        <1> postinc[t2] sK/1 ->4
 143 # -           <1> ex-rv2sv sKRM/1 ->3
 144 # 2              <$> gvsv(*chk) s ->3
 145 EONT_EONT
 146
 147 if ($] >= 5.009) {
 148     checkOptree ( name  => 'UNITCHECK',
 149                   bcopts=> 'UNITCHECK',
 150                   prog  => $src,
 151                   strip_open_hints => 1,
 152                   expect=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 153 # UNITCHECK 1:
 154 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 155 # -     <@> lineseq KP ->4
 156 # 1        <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2
 157 # 3        <1> postinc[t3] sK/1 ->4
 158 # -           <1> ex-rv2sv sKRM/1 ->3
 159 # 2              <#> gvsv[*uc] s ->3
 160 EOT_EOT
 161 # UNITCHECK 1:
 162 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 163 # -     <@> lineseq KP ->4
 164 # 1        <;> nextstate(main 3 -e:4) v:>,<,%,{ ->2
 165 # 3        <1> postinc[t2] sK/1 ->4
 166 # -           <1> ex-rv2sv sKRM/1 ->3
 167 # 2              <$> gvsv(*uc) s ->3
 168 EONT_EONT
 169 }
 170
 171 checkOptree ( name      => 'INIT',
 172               bcopts    => 'INIT',
 173               #todo     => 'get working',
 174               prog      => $src,
 175               strip_open_hints => 1,
 176               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 177 # INIT 1:
 178 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 179 # -     <@> lineseq KP ->4
 180 # 1        <;> nextstate(main 4 -e:5) v:>,<,%,{ ->2
 181 # 3        <1> postinc[t3] sK/1 ->4
 182 # -           <1> ex-rv2sv sKRM/1 ->3
 183 # 2              <#> gvsv[*init] s ->3
 184 EOT_EOT
 185 # INIT 1:
 186 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 187 # -     <@> lineseq KP ->4
 188 # 1        <;> nextstate(main 4 -e:5) v:>,<,%,{ ->2
 189 # 3        <1> postinc[t2] sK/1 ->4
 190 # -           <1> ex-rv2sv sKRM/1 ->3
 191 # 2              <$> gvsv(*init) s ->3
 192 EONT_EONT
 193
 194
 195 checkOptree ( name      => 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 196               bcopts    => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /],
 197               prog      => $src,
 198               @warnings_todo,
 199               strip_open_hints => 1,
 200               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 201 # BEGIN 1:
 202 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 203 # 2  <$> const[PV "warnings.pm"] s/BARE
 204 # 3  <1> require sK/1
 205 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 206 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 207 # 6  <0> pushmark s
 208 # 7  <$> const[PV "warnings"] sM
 209 # 8  <$> const[PV "qw"] sM
 210 # 9  <$> method_named[PV "unimport"]
 211 # a  <1> entersub[t1] KS*/TARG,2
 212 # b  <1> leavesub[1 ref] K/REFC,1
 213 # BEGIN 2:
 214 # c  <;> nextstate(main 2 -e:1) v:>,<,%,{
 215 # d  <#> gvsv[*beg] s
 216 # e  <1> postinc[t3] sK/1
 217 # f  <1> leavesub[1 ref] K/REFC,1
 218 # END 1:
 219 # g  <;> nextstate(main 5 -e:1) v:>,<,%,{
 220 # h  <#> gvsv[*end] s
 221 # i  <1> postinc[t3] sK/1
 222 # j  <1> leavesub[1 ref] K/REFC,1
 223 # INIT 1:
 224 # k  <;> nextstate(main 4 -e:1) v:>,<,%,{
 225 # l  <#> gvsv[*init] s
 226 # m  <1> postinc[t3] sK/1
 227 # n  <1> leavesub[1 ref] K/REFC,1
 228 # CHECK 1:
 229 # o  <;> nextstate(main 3 -e:1) v:>,<,%,{
 230 # p  <#> gvsv[*chk] s
 231 # q  <1> postinc[t3] sK/1
 232 # r  <1> leavesub[1 ref] K/REFC,1
 233 # UNITCHECK 1:
 234 # s  <;> nextstate(main 6 -e:1) v:>,<,%,{
 235 # t  <#> gvsv[*uc] s
 236 # u  <1> postinc[t3] sK/1
 237 # v  <1> leavesub[1 ref] K/REFC,1
 238 EOT_EOT
 239 # BEGIN 1:
 240 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 241 # 2  <$> const(PV "warnings.pm") s/BARE
 242 # 3  <1> require sK/1
 243 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 244 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 245 # 6  <0> pushmark s
 246 # 7  <$> const(PV "warnings") sM
 247 # 8  <$> const(PV "qw") sM
 248 # 9  <$> method_named(PV "unimport")
 249 # a  <1> entersub[t1] KS*/TARG,2
 250 # b  <1> leavesub[1 ref] K/REFC,1
 251 # BEGIN 2:
 252 # c  <;> nextstate(main 2 -e:1) v:>,<,%,{
 253 # d  <$> gvsv(*beg) s
 254 # e  <1> postinc[t2] sK/1
 255 # f  <1> leavesub[1 ref] K/REFC,1
 256 # END 1:
 257 # g  <;> nextstate(main 5 -e:1) v:>,<,%,{
 258 # h  <$> gvsv(*end) s
 259 # i  <1> postinc[t2] sK/1
 260 # j  <1> leavesub[1 ref] K/REFC,1
 261 # INIT 1:
 262 # k  <;> nextstate(main 4 -e:1) v:>,<,%,{
 263 # l  <$> gvsv(*init) s
 264 # m  <1> postinc[t2] sK/1
 265 # n  <1> leavesub[1 ref] K/REFC,1
 266 # CHECK 1:
 267 # o  <;> nextstate(main 3 -e:1) v:>,<,%,{
 268 # p  <$> gvsv(*chk) s
 269 # q  <1> postinc[t2] sK/1
 270 # r  <1> leavesub[1 ref] K/REFC,1
 271 # UNITCHECK 1:
 272 # s  <;> nextstate(main 6 -e:1) v:>,<,%,{
 273 # t  <$> gvsv(*uc) s
 274 # u  <1> postinc[t2] sK/1
 275 # v  <1> leavesub[1 ref] K/REFC,1
 276 EONT_EONT
 277
 278
 279 # perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/'
 280
 281
 282
 283 checkOptree ( name      => 'regression test for patch 25352',
 284               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
 285               prog      => 'print q/foo/',
 286               @warnings_todo,
 287               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 288 # BEGIN 1:
 289 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 290 # 2  <$> const[PV "warnings.pm"] s/BARE
 291 # 3  <1> require sK/1
 292 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 293 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 294 # 6  <0> pushmark s
 295 # 7  <$> const[PV "warnings"] sM
 296 # 8  <$> const[PV "qw"] sM
 297 # 9  <$> method_named[PV "unimport"]
 298 # a  <1> entersub[t1] KS*/TARG,2
 299 # b  <1> leavesub[1 ref] K/REFC,1
 300 EOT_EOT
 301 # BEGIN 1:
 302 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 303 # 2  <$> const(PV "warnings.pm") s/BARE
 304 # 3  <1> require sK/1
 305 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 306 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 307 # 6  <0> pushmark s
 308 # 7  <$> const(PV "warnings") sM
 309 # 8  <$> const(PV "qw") sM
 310 # 9  <$> method_named(PV "unimport")
 311 # a  <1> entersub[t1] KS*/TARG,2
 312 # b  <1> leavesub[1 ref] K/REFC,1
 313 EONT_EONT