ext/B/t/optree_constants.t

   1 #!perl
   2
   3 BEGIN {
   4     if ($ENV{PERL_CORE}) {
   5         chdir('t') if -d 't';
   6         @INC = ('.', '../lib', '../ext/B/t');
   7     } else {
   8         unshift @INC, 't';
   9         push @INC, "../../t";
  10     }
  11     require Config;
  12     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
  13         print "1..0 # Skip -- Perl configured without B module\n";
  14         exit 0;
  15     }
  16     # require 'test.pl'; # now done by OptreeCheck
  17 }
  18
  19 use OptreeCheck;        # ALSO DOES @ARGV HANDLING !!!!!!
  20 use Config;
  21
  22 my $tests = 18;
  23 plan tests => $tests;
  24 SKIP: {
  25 skip "no perlio in this build", $tests unless $Config::Config{useperlio};
  26
  27 #################################
  28
  29 use constant {          # see also t/op/gv.t line 282
  30     myint => 42,
  31     mystr => 'hithere',
  32     myfl => 3.14159,
  33     myrex => qr/foo/,
  34     myglob => \*STDIN,
  35     myaref => [ 1,2,3 ],
  36     myhref => { a => 1 },
  37 };
  38
  39 use constant WEEKDAYS
  40     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
  41
  42
  43 sub pi () { 3.14159 };
  44 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
  45 eval "sub napier ();";
  46
  47
  48 # should be able to undefine constant::import here ???
  49 INIT {
  50     # eval 'sub constant::import () {}';
  51     # undef *constant::import::{CODE};
  52 };
  53
  54 #################################
  55 pass("CONSTANT SUBS RETURNING SCALARS");
  56
  57 checkOptree ( name      => 'myint() as coderef',
  58               code      => \&myint,
  59               noanchors => 1,
  60               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  61  is a constant sub, optimized to a IV
  62 EOT_EOT
  63  is a constant sub, optimized to a IV
  64 EONT_EONT
  65
  66
  67 checkOptree ( name      => 'mystr() as coderef',
  68               code      => \&mystr,
  69               noanchors => 1,
  70               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  71  is a constant sub, optimized to a PV
  72 EOT_EOT
  73  is a constant sub, optimized to a PV
  74 EONT_EONT
  75
  76
  77 checkOptree ( name      => 'myfl() as coderef',
  78               code      => \&myfl,
  79               noanchors => 1,
  80               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  81  is a constant sub, optimized to a NV
  82 EOT_EOT
  83  is a constant sub, optimized to a NV
  84 EONT_EONT
  85
  86
  87 checkOptree ( name      => 'myrex() as coderef',
  88               code      => \&myrex,
  89               todo      => '- currently renders as XS code',
  90               noanchors => 1,
  91               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  92  is XS code
  93 EOT_EOT
  94  is XS code
  95 EONT_EONT
  96
  97
  98 checkOptree ( name      => 'myglob() as coderef',
  99               code      => \&myglob,
 100               todo      => '- currently renders as XS code',
 101               noanchors => 1,
 102               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 103  is XS code
 104 EOT_EOT
 105  is XS code
 106 EONT_EONT
 107
 108
 109 checkOptree ( name      => 'myaref() as coderef',
 110               code      => \&myaref,
 111               todo      => '- currently renders as XS code',
 112               noanchors => 1,
 113               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 114  is XS code
 115 EOT_EOT
 116  is XS code
 117 EONT_EONT
 118
 119
 120 checkOptree ( name      => 'myhref() as coderef',
 121               code      => \&myhref,
 122               todo      => '- currently renders as XS code',
 123               noanchors => 1,
 124               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 125  is XS code
 126 EOT_EOT
 127  is XS code
 128 EONT_EONT
 129
 130
 131 ##############
 132
 133 checkOptree ( name      => 'call myint',
 134               code      => 'myint',
 135               bc_opts   => '-nobanner',
 136               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 137 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 138 -     <@> lineseq KP ->3
 139 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 140 2        <$> const[IV 42] s ->3
 141 EOT_EOT
 142 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 143 -     <@> lineseq KP ->3
 144 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 145 2        <$> const(IV 42) s ->3
 146 EONT_EONT
 147
 148
 149 checkOptree ( name      => 'call mystr',
 150               code      => 'mystr',
 151               bc_opts   => '-nobanner',
 152               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 153 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 154 -     <@> lineseq KP ->3
 155 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 156 2        <$> const[PV "hithere"] s ->3
 157 EOT_EOT
 158 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 159 -     <@> lineseq KP ->3
 160 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 161 2        <$> const(PV "hithere") s ->3
 162 EONT_EONT
 163
 164
 165 checkOptree ( name      => 'call myfl',
 166               code      => 'myfl',
 167               bc_opts   => '-nobanner',
 168               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 169 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 170 -     <@> lineseq KP ->3
 171 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 172 2        <$> const[NV 3.14159] s ->3
 173 EOT_EOT
 174 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 175 -     <@> lineseq KP ->3
 176 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 177 2        <$> const(NV 3.14159) s ->3
 178 EONT_EONT
 179
 180
 181 checkOptree ( name      => 'call myrex',
 182               code      => 'myrex',
 183               todo      => '- RV value is bare backslash',
 184               noanchors => 1,
 185               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 186 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 187 # -     <@> lineseq KP ->3
 188 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 189 # 2        <$> const[RV \\] s ->3
 190 EOT_EOT
 191 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 192 # -     <@> lineseq KP ->3
 193 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 194 # 2        <$> const(RV \\) s ->3
 195 EONT_EONT
 196
 197
 198 checkOptree ( name      => 'call myglob',
 199               code      => 'myglob',
 200               todo      => '- RV value is bare backslash',
 201               noanchors => 1,
 202               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 203 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 204 # -     <@> lineseq KP ->3
 205 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 206 # 2        <$> const[RV \\] s ->3
 207 EOT_EOT
 208 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 209 # -     <@> lineseq KP ->3
 210 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 211 # 2        <$> const(RV \\) s ->3
 212 EONT_EONT
 213
 214
 215 checkOptree ( name      => 'call myaref',
 216               code      => 'myaref',
 217               todo      => '- RV value is bare backslash',
 218               noanchors => 1,
 219               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 220 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 221 # -     <@> lineseq KP ->3
 222 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
 223 # 2        <$> const[RV \\] s ->3
 224 EOT_EOT
 225 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 226 # -     <@> lineseq KP ->3
 227 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
 228 # 2        <$> const(RV \\) s ->3
 229 EONT_EONT
 230
 231
 232 checkOptree ( name      => 'call myhref',
 233               code      => 'myhref',
 234               noanchors => 1,
 235               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 236 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 237 # -     <@> lineseq KP ->3
 238 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
 239 # 2        <$> const[RV \\HASH] s ->3
 240 EOT_EOT
 241 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 242 # -     <@> lineseq KP ->3
 243 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
 244 # 2        <$> const(RV \\HASH) s ->3
 245 EONT_EONT
 246
 247
 248 ##################
 249
 250 # test constant sub defined w/o 'use constant'
 251
 252 checkOptree ( name      => "pi(), defined w/o 'use constant'",
 253               code      => \&pi,
 254               noanchors => 1,
 255               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 256  is a constant sub, optimized to a NV
 257 EOT_EOT
 258  is a constant sub, optimized to a NV
 259 EONT_EONT
 260
 261
 262 checkOptree ( name      => 'constant subs returning lists are not optimized',
 263               code      => \&WEEKDAYS,
 264               noanchors => 1,
 265               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 266 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 267 # -     <@> lineseq K ->3
 268 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
 269 # 2        <0> padav[@list:FAKE:m:102] ->3
 270 EOT_EOT
 271 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 272 # -     <@> lineseq K ->3
 273 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
 274 # 2        <0> padav[@list:FAKE:m:76] ->3
 275 EONT_EONT
 276
 277
 278 sub printem {
 279     printf "myint %d mystr %s myfl %f pi %f\n"
 280         , myint, mystr, myfl, pi;
 281 }
 282
 283 checkOptree ( name      => 'call em all in a print statement',
 284               code      => \&printem,
 285               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 286 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 287 # -     <@> lineseq KP ->9
 288 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
 289 # 8        <@> prtf sK ->9
 290 # 2           <0> pushmark s ->3
 291 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
 292 # 4           <$> const[IV 42] s ->5
 293 # 5           <$> const[PV "hithere"] s ->6
 294 # 6           <$> const[NV 3.14159] s ->7
 295 # 7           <$> const[NV 3.14159] s ->8
 296 EOT_EOT
 297 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 298 # -     <@> lineseq KP ->9
 299 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
 300 # 8        <@> prtf sK ->9
 301 # 2           <0> pushmark s ->3
 302 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
 303 # 4           <$> const(IV 42) s ->5
 304 # 5           <$> const(PV "hithere") s ->6
 305 # 6           <$> const(NV 3.14159) s ->7
 306 # 7           <$> const(NV 3.14159) s ->8
 307 EONT_EONT
 308
 309
 310 } #skip
 311
 312 __END__
 313
 314 =head NB
 315
 316 Optimized constant subs are stored as bare scalars in the stash
 317 (package hash), which formerly held only GVs (typeglobs).
 318
 319 But you cant create them manually - you cant assign a scalar to a
 320 stash element, and expect it to work like a constant-sub, even if you
 321 provide a prototype.
 322
 323 This is a feature; alternative is too much action-at-a-distance.  The
 324 following test demonstrates - napier is not seen as a function at all,
 325 much less an optimized one.
 326
 327 =cut
 328
 329 checkOptree ( name      => 'not evertnapier',
 330               code      => \&napier,
 331               noanchors => 1,
 332               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 333  has no START
 334 EOT_EOT
 335  has no START
 336 EONT_EONT
 337
 338