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 => 8;
  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 my @open_todo;
  51 sub open_todo {
  52     if (((caller 0)[10]||{})->{open}) {
  53         @open_todo = (skip => "\$^OPEN is set");
  54     }
  55 }
  56 open_todo;
  57
  58 checkOptree ( name      => 'BEGIN',
  59               bcopts    => 'BEGIN',
  60               prog      => $src,
  61               @warnings_todo,
  62               @open_todo,
  63               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  64 # BEGIN 1:
  65 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
  66 # -     <@> lineseq KP ->b
  67 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
  68 # 3        <1> require sK/1 ->4
  69 # 2           <$> const[PV "warnings.pm"] s/BARE ->3
  70 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
  71 # -        <@> lineseq K ->-
  72 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
  73 # a           <1> entersub[t1] KS*/TARG,2 ->b
  74 # 6              <0> pushmark s ->7
  75 # 7              <$> const[PV "warnings"] sM ->8
  76 # 8              <$> const[PV "qw"] sM ->9
  77 # 9              <$> method_named[PV "import"] ->a
  78 # BEGIN 2:
  79 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
  80 # -     <@> lineseq KP ->f
  81 # c        <;> nextstate(main 2 -e:1) v:{ ->d
  82 # e        <1> postinc[t3] sK/1 ->f
  83 # -           <1> ex-rv2sv sKRM/1 ->e
  84 # d              <#> gvsv[*beg] s ->e
  85 EOT_EOT
  86 # BEGIN 1:
  87 # b  <1> leavesub[1 ref] K/REFC,1 ->(end)
  88 # -     <@> lineseq KP ->b
  89 # 1        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->2
  90 # 3        <1> require sK/1 ->4
  91 # 2           <$> const(PV "warnings.pm") s/BARE ->3
  92 # 4        <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$ ->5
  93 # -        <@> lineseq K ->-
  94 # 5           <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$ ->6
  95 # a           <1> entersub[t1] KS*/TARG,2 ->b
  96 # 6              <0> pushmark s ->7
  97 # 7              <$> const(PV "warnings") sM ->8
  98 # 8              <$> const(PV "qw") sM ->9
  99 # 9              <$> method_named(PV "import") ->a
 100 # BEGIN 2:
 101 # f  <1> leavesub[1 ref] K/REFC,1 ->(end)
 102 # -     <@> lineseq KP ->f
 103 # c        <;> nextstate(main 2 -e:1) v:{ ->d
 104 # e        <1> postinc[t2] sK/1 ->f
 105 # -           <1> ex-rv2sv sKRM/1 ->e
 106 # d              <$> gvsv(*beg) s ->e
 107 EONT_EONT
 108
 109
 110 checkOptree ( name      => 'END',
 111               bcopts    => 'END',
 112               prog      => $src,
 113               @open_todo,
 114               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 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[t3] sK/1 ->4
 120 # -           <1> ex-rv2sv sKRM/1 ->3
 121 # 2              <#> gvsv[*end] s ->3
 122 EOT_EOT
 123 # END 1:
 124 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 125 # -     <@> lineseq KP ->4
 126 # 1        <;> nextstate(main 5 -e:6) v:{ ->2
 127 # 3        <1> postinc[t2] sK/1 ->4
 128 # -           <1> ex-rv2sv sKRM/1 ->3
 129 # 2              <$> gvsv(*end) s ->3
 130 EONT_EONT
 131
 132
 133 checkOptree ( name      => 'CHECK',
 134               bcopts    => 'CHECK',
 135               prog      => $src,
 136               @open_todo,
 137               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 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[t3] sK/1 ->4
 143 # -           <1> ex-rv2sv sKRM/1 ->3
 144 # 2              <#> gvsv[*chk] s ->3
 145 EOT_EOT
 146 # CHECK 1:
 147 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 148 # -     <@> lineseq KP ->4
 149 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
 150 # 3        <1> postinc[t2] sK/1 ->4
 151 # -           <1> ex-rv2sv sKRM/1 ->3
 152 # 2              <$> gvsv(*chk) s ->3
 153 EONT_EONT
 154
 155 checkOptree ( name      => 'UNITCHECK',
 156               bcopts    => 'UNITCHECK',
 157               prog      => $src,
 158               @open_todo,
 159               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 160 # UNITCHECK 1:
 161 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 162 # -     <@> lineseq KP ->4
 163 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
 164 # 3        <1> postinc[t3] sK/1 ->4
 165 # -           <1> ex-rv2sv sKRM/1 ->3
 166 # 2              <#> gvsv[*uc] s ->3
 167 EOT_EOT
 168 # UNITCHECK 1:
 169 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 170 # -     <@> lineseq KP ->4
 171 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
 172 # 3        <1> postinc[t2] sK/1 ->4
 173 # -           <1> ex-rv2sv sKRM/1 ->3
 174 # 2              <$> gvsv(*uc) s ->3
 175 EONT_EONT
 176
 177
 178 checkOptree ( name      => 'INIT',
 179               bcopts    => 'INIT',
 180               #todo     => 'get working',
 181               prog      => $src,
 182               @open_todo,
 183               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 184 # INIT 1:
 185 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 186 # -     <@> lineseq KP ->4
 187 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
 188 # 3        <1> postinc[t3] sK/1 ->4
 189 # -           <1> ex-rv2sv sKRM/1 ->3
 190 # 2              <#> gvsv[*init] s ->3
 191 EOT_EOT
 192 # INIT 1:
 193 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 194 # -     <@> lineseq KP ->4
 195 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
 196 # 3        <1> postinc[t2] sK/1 ->4
 197 # -           <1> ex-rv2sv sKRM/1 ->3
 198 # 2              <$> gvsv(*init) s ->3
 199 EONT_EONT
 200
 201
 202 checkOptree ( name      => 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 203               bcopts    => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /],
 204               prog      => $src,
 205               @warnings_todo,
 206               @open_todo,
 207               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 208 # BEGIN 1:
 209 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 210 # 2  <$> const[PV "warnings.pm"] s/BARE
 211 # 3  <1> require sK/1
 212 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 213 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 214 # 6  <0> pushmark s
 215 # 7  <$> const[PV "warnings"] sM
 216 # 8  <$> const[PV "qw"] sM
 217 # 9  <$> method_named[PV "unimport"]
 218 # a  <1> entersub[t1] KS*/TARG,2
 219 # b  <1> leavesub[1 ref] K/REFC,1
 220 # BEGIN 2:
 221 # c  <;> nextstate(main 2 -e:1) v:{
 222 # d  <#> gvsv[*beg] s
 223 # e  <1> postinc[t3] sK/1
 224 # f  <1> leavesub[1 ref] K/REFC,1
 225 # END 1:
 226 # g  <;> nextstate(main 5 -e:1) v:{
 227 # h  <#> gvsv[*end] s
 228 # i  <1> postinc[t3] sK/1
 229 # j  <1> leavesub[1 ref] K/REFC,1
 230 # INIT 1:
 231 # k  <;> nextstate(main 4 -e:1) v:{
 232 # l  <#> gvsv[*init] s
 233 # m  <1> postinc[t3] sK/1
 234 # n  <1> leavesub[1 ref] K/REFC,1
 235 # CHECK 1:
 236 # o  <;> nextstate(main 3 -e:1) v:{
 237 # p  <#> gvsv[*chk] s
 238 # q  <1> postinc[t3] sK/1
 239 # r  <1> leavesub[1 ref] K/REFC,1
 240 # UNITCHECK 1:
 241 # s  <;> nextstate(main 6 -e:1) v:{
 242 # t  <#> gvsv[*uc] s
 243 # u  <1> postinc[t3] sK/1
 244 # v  <1> leavesub[1 ref] K/REFC,1
 245 EOT_EOT
 246 # BEGIN 1:
 247 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 248 # 2  <$> const(PV "warnings.pm") s/BARE
 249 # 3  <1> require sK/1
 250 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 251 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 252 # 6  <0> pushmark s
 253 # 7  <$> const(PV "warnings") sM
 254 # 8  <$> const(PV "qw") sM
 255 # 9  <$> method_named(PV "unimport")
 256 # a  <1> entersub[t1] KS*/TARG,2
 257 # b  <1> leavesub[1 ref] K/REFC,1
 258 # BEGIN 2:
 259 # c  <;> nextstate(main 2 -e:1) v:{
 260 # d  <$> gvsv(*beg) s
 261 # e  <1> postinc[t2] sK/1
 262 # f  <1> leavesub[1 ref] K/REFC,1
 263 # END 1:
 264 # g  <;> nextstate(main 5 -e:1) v:{
 265 # h  <$> gvsv(*end) s
 266 # i  <1> postinc[t2] sK/1
 267 # j  <1> leavesub[1 ref] K/REFC,1
 268 # INIT 1:
 269 # k  <;> nextstate(main 4 -e:1) v:{
 270 # l  <$> gvsv(*init) s
 271 # m  <1> postinc[t2] sK/1
 272 # n  <1> leavesub[1 ref] K/REFC,1
 273 # CHECK 1:
 274 # o  <;> nextstate(main 3 -e:1) v:{
 275 # p  <$> gvsv(*chk) s
 276 # q  <1> postinc[t2] sK/1
 277 # r  <1> leavesub[1 ref] K/REFC,1
 278 # UNITCHECK 1:
 279 # s  <;> nextstate(main 6 -e:1) v:{
 280 # t  <$> gvsv(*uc) s
 281 # u  <1> postinc[t2] sK/1
 282 # v  <1> leavesub[1 ref] K/REFC,1
 283 EONT_EONT
 284
 285
 286 # perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/'
 287
 288
 289
 290 checkOptree ( name      => 'regression test for patch 25352',
 291               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
 292               prog      => 'print q/foo/',
 293               @warnings_todo,
 294               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 295 # BEGIN 1:
 296 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 297 # 2  <$> const[PV "warnings.pm"] s/BARE
 298 # 3  <1> require sK/1
 299 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 300 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 301 # 6  <0> pushmark s
 302 # 7  <$> const[PV "warnings"] sM
 303 # 8  <$> const[PV "qw"] sM
 304 # 9  <$> method_named[PV "unimport"]
 305 # a  <1> entersub[t1] KS*/TARG,2
 306 # b  <1> leavesub[1 ref] K/REFC,1
 307 EOT_EOT
 308 # BEGIN 1:
 309 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 310 # 2  <$> const(PV "warnings.pm") s/BARE
 311 # 3  <1> require sK/1
 312 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 313 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 314 # 6  <0> pushmark s
 315 # 7  <$> const(PV "warnings") sM
 316 # 8  <$> const(PV "qw") sM
 317 # 9  <$> method_named(PV "unimport")
 318 # a  <1> entersub[t1] KS*/TARG,2
 319 # b  <1> leavesub[1 ref] K/REFC,1
 320 EONT_EONT