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