ext/B/t/optree_check.t

   1 #!perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = ('../lib', '../ext/B/t');
   6     require Config;
   7     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
   8         print "1..0 # Skip -- Perl configured without B module\n";
   9         exit 0;
  10     }
  11     require './test.pl';
  12 }
  13
  14 use OptreeCheck;
  15
  16 =head1 OptreeCheck selftest harness
  17
  18 This file is primarily to test services of OptreeCheck itself, ie
  19 checkOptree().  %gOpts provides test-state info, it is 'exported' into
  20 main::
  21
  22 doing use OptreeCheck runs import(), which processes @ARGV to process
  23 cmdline args in 'standard' way across all clients of OptreeCheck.
  24
  25 =cut
  26
  27 use Config;
  28 plan tests => 5 + 18 + 14 * $gOpts{selftest};   # fudged
  29
  30 SKIP: {
  31     skip "no perlio in this build", 5 + 18 + 14 * $gOpts{selftest}
  32     unless $Config::Config{useperlio};
  33
  34
  35 pass("REGEX TEST HARNESS SELFTEST");
  36
  37 checkOptree ( name      => "bare minimum opcode search",
  38               bcopts    => '-exec',
  39               code      => sub {my $a},
  40               noanchors => 1, # unanchored match
  41               expect    => 'leavesub',
  42               expect_nt => 'leavesub');
  43
  44 checkOptree ( name      => "found print opcode",
  45               bcopts    => '-exec',
  46               code      => sub {print 1},
  47               noanchors => 1, # unanchored match
  48               expect    => 'print',
  49               expect_nt => 'leavesub');
  50
  51 checkOptree ( name      => 'test skip itself',
  52               skip      => 1,
  53               bcopts    => '-exec',
  54               code      => sub {print 1},
  55               expect    => 'dont-care, skipping',
  56               expect_nt => 'this insures failure');
  57
  58 # This test 'unexpectedly succeeds', but that is "expected".  Theres
  59 # no good way to expect a successful todo, and inducing a failure
  60 # causes the harness to print verbose errors, which is NOT helpful.
  61
  62 checkOptree ( name      => 'test todo itself. suppressed, remove skip to test',
  63               todo      => "suppress todo test for now",
  64               skip      => 1,
  65               bcopts    => '-exec',
  66               code      => sub {print 1},
  67               noanchors => 1, # unanchored match
  68               expect    => 'print',
  69               expect_nt => 'print');
  70
  71 checkOptree ( name      => 'impossible match, remove skip to see failure',
  72               todo      => "see! it breaks!",
  73               skip      => 1, # but skip it 1st
  74               code      => sub {print 1},
  75               expect    => 'look out ! Boy Wonder',
  76               expect_nt => 'holy near earth asteroid Batman !');
  77
  78 pass ("TEST FATAL ERRS");
  79
  80 if (1) {
  81     # test for fatal errors. Im unsettled on fail vs die.
  82     # calling fail isnt good enough by itself.
  83     eval {
  84
  85         checkOptree ( name      => 'empty code or prog',
  86                       todo      => "your excuse here ;-)",
  87                       code      => '',
  88                       prog      => '',
  89                       );
  90     };
  91     like($@, 'code or prog is required', 'empty code or prog prevented');
  92
  93     $@='';
  94     eval {
  95         checkOptree ( name      => 'test against empty expectations',
  96                       bcopts    => '-exec',
  97                       code      => sub {print 1},
  98                       expect    => '',
  99                       expect_nt => '');
 100     };
 101     like($@, 'no reftext found for', "empty expectations prevented");
 102
 103     $@='';
 104     eval {
 105         checkOptree ( name      => 'prevent whitespace only expectations',
 106                       bcopts    => '-exec',
 107                       code      => sub {my $a},
 108                       #skip     => 1,
 109                       expect_nt => "\n",
 110                       expect    => "\n");
 111     };
 112     like($@, 'no reftext found for', "just whitespace expectations prevented");
 113 }
 114
 115 pass ("TEST -e \$srcCode");
 116
 117 checkOptree
 118     (  name     => '-w errors seen',
 119        prog     => 'sort our @a',
 120        errs     => 'Useless use of sort in void context at -e line 1.',
 121        );
 122
 123 checkOptree
 124     (  name     => "self strict, catch err",
 125        prog     => 'use strict; bogus',
 126        errs     => 'Bareword "bogus" not allowed while "strict subs" in use at -e line 1.',
 127        );
 128
 129 checkOptree ( name      => "sort vK - flag specific search",
 130               prog      => 'sort our @a',
 131               noanchors => 1,
 132               expect    => '<@> sort vK ',
 133               expect_nt => '<@> sort vK ');
 134
 135 checkOptree ( name      => "'prog' => 'sort our \@a'",
 136               prog      => 'sort our @a',
 137               noanchors => 1,
 138               expect    => '<@> sort vK',
 139               expect_nt => '<@> sort vK');
 140
 141 checkOptree ( name      => "'code' => 'sort our \@a'",
 142               code      => 'sort our @a',
 143               noanchors => 1,
 144               expect    => '<@> sort K',
 145               expect_nt => '<@> sort K');
 146
 147 pass ("REFTEXT FIXUP TESTS");
 148
 149 checkOptree ( name      => 'fixup nextstate (in reftext)',
 150               bcopts    => '-exec',
 151               code      => sub {my $a},
 152               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 153 # 1  <;> nextstate( NOTE THAT THIS CAN BE ANYTHING ) v
 154 # 2  <0> padsv[$a:54,55] M/LVINTRO
 155 # 3  <1> leavesub[1 ref] K/REFC,1
 156 EOT_EOT
 157 # 1  <;> nextstate(main 54 optree_concise.t:84) v
 158 # 2  <0> padsv[$a:54,55] M/LVINTRO
 159 # 3  <1> leavesub[1 ref] K/REFC,1
 160 EONT_EONT
 161
 162 checkOptree ( name      => 'fixup opcode args',
 163               bcopts    => '-exec',
 164               #fail     => 1, # uncomment to see real padsv args: [$a:491,492]
 165               code      => sub {my $a},
 166               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 167 # 1  <;> nextstate(main 56 optree_concise.t:96) v
 168 # 2  <0> padsv[$a:56,57] M/LVINTRO
 169 # 3  <1> leavesub[1 ref] K/REFC,1
 170 EOT_EOT
 171 # 1  <;> nextstate(main 56 optree_concise.t:96) v
 172 # 2  <0> padsv[$a:56,57] M/LVINTRO
 173 # 3  <1> leavesub[1 ref] K/REFC,1
 174 EONT_EONT
 175
 176 #################################
 177 pass("CANONICAL B::Concise EXAMPLE");
 178
 179 checkOptree ( name      => 'canonical example w -basic',
 180               bcopts    => '-basic',
 181               code      =>  sub{$a=$b+42},
 182               crossfail => 1,
 183               debug     => 1,
 184               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 185 # 7  <1> leavesub[1 ref] K/REFC,1 ->(end)
 186 # -     <@> lineseq KP ->7
 187 # 1        <;> nextstate(main 380 optree_selftest.t:139) v ->2
 188 # 6        <2> sassign sKS/2 ->7
 189 # 4           <2> add[t3] sK/2 ->5
 190 # -              <1> ex-rv2sv sK/1 ->3
 191 # 2                 <#> gvsv[*b] s ->3
 192 # 3              <$> const[IV 42] s ->4
 193 # -           <1> ex-rv2sv sKRM*/1 ->6
 194 # 5              <#> gvsv[*a] s ->6
 195 EOT_EOT
 196 # 7  <1> leavesub[1 ref] K/REFC,1 ->(end)
 197 # -     <@> lineseq KP ->7
 198 # 1        <;> nextstate(main 60 optree_concise.t:122) v ->2
 199 # 6        <2> sassign sKS/2 ->7
 200 # 4           <2> add[t1] sK/2 ->5
 201 # -              <1> ex-rv2sv sK/1 ->3
 202 # 2                 <$> gvsv(*b) s ->3
 203 # 3              <$> const(IV 42) s ->4
 204 # -           <1> ex-rv2sv sKRM*/1 ->6
 205 # 5              <$> gvsv(*a) s ->6
 206 EONT_EONT
 207
 208 checkOptree ( name      => 'canonical example w -exec',
 209               bcopts    => '-exec',
 210               code      => sub{$a=$b+42},
 211               crossfail => 1,
 212               retry     => 1,
 213               debug     => 1,
 214               xtestfail => 1,
 215               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 216 # 1  <;> nextstate(main 61 optree_concise.t:139) v
 217 # 2  <#> gvsv[*b] s
 218 # 3  <$> const[IV 42] s
 219 # 4  <2> add[t3] sK/2
 220 # 5  <#> gvsv[*a] s
 221 # 6  <2> sassign sKS/2
 222 # 7  <1> leavesub[1 ref] K/REFC,1
 223 EOT_EOT
 224 # 1  <;> nextstate(main 61 optree_concise.t:139) v
 225 # 2  <$> gvsv(*b) s
 226 # 3  <$> const(IV 42) s
 227 # 4  <2> add[t1] sK/2
 228 # 5  <$> gvsv(*a) s
 229 # 6  <2> sassign sKS/2
 230 # 7  <1> leavesub[1 ref] K/REFC,1
 231 EONT_EONT
 232
 233 checkOptree ( name      => 'tree reftext is messy cut-paste',
 234               skip      => 1);
 235
 236 } # skip
 237
 238 __END__
 239