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 checkOptree ( name      => 'BEGIN',
  51               bcopts    => 'BEGIN',
  52               prog      => $src,
  53               @warnings_todo,
  54               @open_todo,
  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               @open_todo,
 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               @open_todo,
 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 checkOptree ( name      => 'UNITCHECK',
 148               bcopts    => 'UNITCHECK',
 149               prog      => $src,
 150               @open_todo,
 151               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 152 # UNITCHECK 1:
 153 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 154 # -     <@> lineseq KP ->4
 155 # 1        <;> nextstate(main 3 -e:4) v:{ ->2
 156 # 3        <1> postinc[t3] sK/1 ->4
 157 # -           <1> ex-rv2sv sKRM/1 ->3
 158 # 2              <#> gvsv[*uc] s ->3
 159 EOT_EOT
 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[t2] sK/1 ->4
 165 # -           <1> ex-rv2sv sKRM/1 ->3
 166 # 2              <$> gvsv(*uc) s ->3
 167 EONT_EONT
 168
 169
 170 checkOptree ( name      => 'INIT',
 171               bcopts    => 'INIT',
 172               #todo     => 'get working',
 173               prog      => $src,
 174               @open_todo,
 175               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 176 # INIT 1:
 177 # 4  <1> leavesub[1 ref] K/REFC,1 ->(end)
 178 # -     <@> lineseq KP ->4
 179 # 1        <;> nextstate(main 4 -e:5) v:{ ->2
 180 # 3        <1> postinc[t3] sK/1 ->4
 181 # -           <1> ex-rv2sv sKRM/1 ->3
 182 # 2              <#> gvsv[*init] s ->3
 183 EOT_EOT
 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[t2] sK/1 ->4
 189 # -           <1> ex-rv2sv sKRM/1 ->3
 190 # 2              <$> gvsv(*init) s ->3
 191 EONT_EONT
 192
 193
 194 checkOptree ( name      => 'all of BEGIN END INIT CHECK UNITCHECK -exec',
 195               bcopts    => [qw/ BEGIN END INIT CHECK UNITCHECK -exec /],
 196               prog      => $src,
 197               @warnings_todo,
 198               @open_todo,
 199               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 200 # BEGIN 1:
 201 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 202 # 2  <$> const[PV "warnings.pm"] s/BARE
 203 # 3  <1> require sK/1
 204 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 205 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 206 # 6  <0> pushmark s
 207 # 7  <$> const[PV "warnings"] sM
 208 # 8  <$> const[PV "qw"] sM
 209 # 9  <$> method_named[PV "unimport"]
 210 # a  <1> entersub[t1] KS*/TARG,2
 211 # b  <1> leavesub[1 ref] K/REFC,1
 212 # BEGIN 2:
 213 # c  <;> nextstate(main 2 -e:1) v:{
 214 # d  <#> gvsv[*beg] s
 215 # e  <1> postinc[t3] sK/1
 216 # f  <1> leavesub[1 ref] K/REFC,1
 217 # END 1:
 218 # g  <;> nextstate(main 5 -e:1) v:{
 219 # h  <#> gvsv[*end] s
 220 # i  <1> postinc[t3] sK/1
 221 # j  <1> leavesub[1 ref] K/REFC,1
 222 # INIT 1:
 223 # k  <;> nextstate(main 4 -e:1) v:{
 224 # l  <#> gvsv[*init] s
 225 # m  <1> postinc[t3] sK/1
 226 # n  <1> leavesub[1 ref] K/REFC,1
 227 # CHECK 1:
 228 # o  <;> nextstate(main 3 -e:1) v:{
 229 # p  <#> gvsv[*chk] s
 230 # q  <1> postinc[t3] sK/1
 231 # r  <1> leavesub[1 ref] K/REFC,1
 232 # UNITCHECK 1:
 233 # s  <;> nextstate(main 6 -e:1) v:{
 234 # t  <#> gvsv[*uc] s
 235 # u  <1> postinc[t3] sK/1
 236 # v  <1> leavesub[1 ref] K/REFC,1
 237 EOT_EOT
 238 # BEGIN 1:
 239 # 1  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 240 # 2  <$> const(PV "warnings.pm") s/BARE
 241 # 3  <1> require sK/1
 242 # 4  <;> nextstate(B::Concise -234 Concise.pm:328) v:*,&,{,$
 243 # 5  <;> nextstate(B::Concise -234 Concise.pm:328) :*,&,{,$
 244 # 6  <0> pushmark s
 245 # 7  <$> const(PV "warnings") sM
 246 # 8  <$> const(PV "qw") sM
 247 # 9  <$> method_named(PV "unimport")
 248 # a  <1> entersub[t1] KS*/TARG,2
 249 # b  <1> leavesub[1 ref] K/REFC,1
 250 # BEGIN 2:
 251 # c  <;> nextstate(main 2 -e:1) v:{
 252 # d  <$> gvsv(*beg) s
 253 # e  <1> postinc[t2] sK/1
 254 # f  <1> leavesub[1 ref] K/REFC,1
 255 # END 1:
 256 # g  <;> nextstate(main 5 -e:1) v:{
 257 # h  <$> gvsv(*end) s
 258 # i  <1> postinc[t2] sK/1
 259 # j  <1> leavesub[1 ref] K/REFC,1
 260 # INIT 1:
 261 # k  <;> nextstate(main 4 -e:1) v:{
 262 # l  <$> gvsv(*init) s
 263 # m  <1> postinc[t2] sK/1
 264 # n  <1> leavesub[1 ref] K/REFC,1
 265 # CHECK 1:
 266 # o  <;> nextstate(main 3 -e:1) v:{
 267 # p  <$> gvsv(*chk) s
 268 # q  <1> postinc[t2] sK/1
 269 # r  <1> leavesub[1 ref] K/REFC,1
 270 # UNITCHECK 1:
 271 # s  <;> nextstate(main 6 -e:1) v:{
 272 # t  <$> gvsv(*uc) s
 273 # u  <1> postinc[t2] sK/1
 274 # v  <1> leavesub[1 ref] K/REFC,1
 275 EONT_EONT
 276
 277
 278 # perl "-I../lib" -MO=Concise,BEGIN,CHECK,INIT,END,-exec -e '$a=$b && print q/foo/'
 279
 280
 281
 282 checkOptree ( name      => 'regression test for patch 25352',
 283               bcopts    => [qw/ BEGIN END INIT CHECK -exec /],
 284               prog      => 'print q/foo/',
 285               @warnings_todo,
 286               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 287 # BEGIN 1:
 288 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 289 # 2  <$> const[PV "warnings.pm"] s/BARE
 290 # 3  <1> require sK/1
 291 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 292 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 293 # 6  <0> pushmark s
 294 # 7  <$> const[PV "warnings"] sM
 295 # 8  <$> const[PV "qw"] sM
 296 # 9  <$> method_named[PV "unimport"]
 297 # a  <1> entersub[t1] KS*/TARG,2
 298 # b  <1> leavesub[1 ref] K/REFC,1
 299 EOT_EOT
 300 # BEGIN 1:
 301 # 1  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 302 # 2  <$> const(PV "warnings.pm") s/BARE
 303 # 3  <1> require sK/1
 304 # 4  <;> nextstate(B::Concise -234 Concise.pm:359) v:*,&,{,$
 305 # 5  <;> nextstate(B::Concise -234 Concise.pm:359) :*,&,{,$
 306 # 6  <0> pushmark s
 307 # 7  <$> const(PV "warnings") sM
 308 # 8  <$> const(PV "qw") sM
 309 # 9  <$> method_named(PV "unimport")
 310 # a  <1> entersub[t1] KS*/TARG,2
 311 # b  <1> leavesub[1 ref] K/REFC,1
 312 EONT_EONT