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