ext/B/t/optree_check.t

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