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 = 23;
  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     myundef => undef,
  38     mysub => \&ok,
  39     mysub => \&nosuch,
  40 };
  41
  42 use constant WEEKDAYS
  43     => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
  44
  45
  46 sub pi () { 3.14159 };
  47 $::{napier} = \2.71828; # counter-example (doesn't get optimized).
  48 eval "sub napier ();";
  49
  50
  51 # should be able to undefine constant::import here ???
  52 INIT {
  53     # eval 'sub constant::import () {}';
  54     # undef *constant::import::{CODE};
  55 };
  56
  57 #################################
  58 pass("CONSTANT SUBS RETURNING SCALARS");
  59
  60 checkOptree ( name      => 'myint() as coderef',
  61               code      => \&myint,
  62               noanchors => 1,
  63               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  64  is a constant sub, optimized to a IV
  65 EOT_EOT
  66  is a constant sub, optimized to a IV
  67 EONT_EONT
  68
  69
  70 checkOptree ( name      => 'mystr() as coderef',
  71               code      => \&mystr,
  72               noanchors => 1,
  73               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  74  is a constant sub, optimized to a PV
  75 EOT_EOT
  76  is a constant sub, optimized to a PV
  77 EONT_EONT
  78
  79
  80 checkOptree ( name      => 'myfl() as coderef',
  81               code      => \&myfl,
  82               noanchors => 1,
  83               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  84  is a constant sub, optimized to a NV
  85 EOT_EOT
  86  is a constant sub, optimized to a NV
  87 EONT_EONT
  88
  89
  90 checkOptree ( name      => 'myrex() as coderef',
  91               code      => \&myrex,
  92               noanchors => 1,
  93               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
  94  is a constant sub, optimized to a RV
  95 EOT_EOT
  96  is a constant sub, optimized to a RV
  97 EONT_EONT
  98
  99
 100 checkOptree ( name      => 'myglob() as coderef',
 101               code      => \&myglob,
 102               noanchors => 1,
 103               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 104  is a constant sub, optimized to a RV
 105 EOT_EOT
 106  is a constant sub, optimized to a RV
 107 EONT_EONT
 108
 109
 110 checkOptree ( name      => 'myaref() as coderef',
 111               code      => \&myaref,
 112               noanchors => 1,
 113               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 114  is a constant sub, optimized to a RV
 115 EOT_EOT
 116  is a constant sub, optimized to a RV
 117 EONT_EONT
 118
 119
 120 checkOptree ( name      => 'myhref() as coderef',
 121               code      => \&myhref,
 122               noanchors => 1,
 123               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 124  is a constant sub, optimized to a RV
 125 EOT_EOT
 126  is a constant sub, optimized to a RV
 127 EONT_EONT
 128
 129
 130 checkOptree ( name      => 'myundef() as coderef',
 131               code      => \&myundef,
 132               noanchors => 1,
 133               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 134  is a constant sub, optimized to a NULL
 135 EOT_EOT
 136  is a constant sub, optimized to a NULL
 137 EONT_EONT
 138
 139
 140 checkOptree ( name      => 'mysub() as coderef',
 141               code      => \&mysub,
 142               noanchors => 1,
 143               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 144  is a constant sub, optimized to a RV
 145 EOT_EOT
 146  is a constant sub, optimized to a RV
 147 EONT_EONT
 148
 149
 150 checkOptree ( name      => 'myunsub() as coderef',
 151               todo      => '- may prove only that sub is unformed',
 152               code      => \&myunsub,
 153               noanchors => 1,
 154               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 155  has no START
 156 EOT_EOT
 157  has no START
 158 EONT_EONT
 159
 160
 161 ##############
 162
 163 checkOptree ( name      => 'call myint',
 164               code      => 'myint',
 165               bc_opts   => '-nobanner',
 166               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 167 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 168 -     <@> lineseq KP ->3
 169 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 170 2        <$> const[IV 42] s ->3
 171 EOT_EOT
 172 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 173 -     <@> lineseq KP ->3
 174 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 175 2        <$> const(IV 42) s ->3
 176 EONT_EONT
 177
 178
 179 checkOptree ( name      => 'call mystr',
 180               code      => 'mystr',
 181               bc_opts   => '-nobanner',
 182               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 183 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 184 -     <@> lineseq KP ->3
 185 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 186 2        <$> const[PV "hithere"] s ->3
 187 EOT_EOT
 188 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 189 -     <@> lineseq KP ->3
 190 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 191 2        <$> const(PV "hithere") s ->3
 192 EONT_EONT
 193
 194
 195 checkOptree ( name      => 'call myfl',
 196               code      => 'myfl',
 197               bc_opts   => '-nobanner',
 198               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 199 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 200 -     <@> lineseq KP ->3
 201 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 202 2        <$> const[NV 3.14159] s ->3
 203 EOT_EOT
 204 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 205 -     <@> lineseq KP ->3
 206 1        <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
 207 2        <$> const(NV 3.14159) s ->3
 208 EONT_EONT
 209
 210
 211 checkOptree ( name      => 'call myrex',
 212               code      => 'myrex',
 213               todo      => '- RV value is bare backslash',
 214               noanchors => 1,
 215               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 216 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 217 # -     <@> lineseq KP ->3
 218 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 219 # 2        <$> const[RV \\] s ->3
 220 EOT_EOT
 221 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 222 # -     <@> lineseq KP ->3
 223 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 224 # 2        <$> const(RV \\) s ->3
 225 EONT_EONT
 226
 227
 228 checkOptree ( name      => 'call myglob',
 229               code      => 'myglob',
 230               todo      => '- RV value is bare backslash',
 231               noanchors => 1,
 232               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 233 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 234 # -     <@> lineseq KP ->3
 235 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 236 # 2        <$> const[RV \\] s ->3
 237 EOT_EOT
 238 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 239 # -     <@> lineseq KP ->3
 240 # 1        <;> nextstate(main 753 (eval 27):1) v ->2
 241 # 2        <$> const(RV \\) s ->3
 242 EONT_EONT
 243
 244
 245 checkOptree ( name      => 'call myaref',
 246               code      => 'myaref',
 247               todo      => '- RV value is bare backslash',
 248               noanchors => 1,
 249               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 250 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 251 # -     <@> lineseq KP ->3
 252 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
 253 # 2        <$> const[RV \\] s ->3
 254 EOT_EOT
 255 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 256 # -     <@> lineseq KP ->3
 257 # 1        <;> nextstate(main 758 (eval 29):1) v ->2
 258 # 2        <$> const(RV \\) s ->3
 259 EONT_EONT
 260
 261
 262 checkOptree ( name      => 'call myhref',
 263               code      => 'myhref',
 264               noanchors => 1,
 265               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 266 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 267 # -     <@> lineseq KP ->3
 268 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
 269 # 2        <$> const[RV \\HASH] s ->3
 270 EOT_EOT
 271 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 272 # -     <@> lineseq KP ->3
 273 # 1        <;> nextstate(main 763 (eval 31):1) v ->2
 274 # 2        <$> const(RV \\HASH) s ->3
 275 EONT_EONT
 276
 277
 278 checkOptree ( name      => 'call myundef',
 279               code      => 'myundef',
 280               noanchors => 1,
 281               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 282 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 283 # -     <@> lineseq KP ->3
 284 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
 285 # 2        <$> const[NULL ] s ->3
 286 EOT_EOT
 287 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 288 # -     <@> lineseq KP ->3
 289 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
 290 # 2        <$> const(NULL ) s ->3
 291 EONT_EONT
 292
 293
 294 checkOptree ( name      => 'call mysub',
 295               code      => 'mysub',
 296               noanchors => 1,
 297               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 298 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 299 # -     <@> lineseq KP ->3
 300 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
 301 # 2        <$> const[RV \\] s ->3
 302 EOT_EOT
 303 # 3  <1> leavesub[1 ref] K/REFC,1 ->(end)
 304 # -     <@> lineseq KP ->3
 305 # 1        <;> nextstate(main 771 (eval 35):1) v ->2
 306 # 2        <$> const(RV \\) s ->3
 307 EONT_EONT
 308
 309 ##################
 310
 311 # test constant sub defined w/o 'use constant'
 312
 313 checkOptree ( name      => "pi(), defined w/o 'use constant'",
 314               code      => \&pi,
 315               noanchors => 1,
 316               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 317  is a constant sub, optimized to a NV
 318 EOT_EOT
 319  is a constant sub, optimized to a NV
 320 EONT_EONT
 321
 322
 323 checkOptree ( name      => 'constant sub returning list',
 324               code      => \&WEEKDAYS,
 325               noanchors => 1,
 326               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 327 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 328 # -     <@> lineseq K ->3
 329 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
 330 # 2        <0> padav[@list:FAKE:m:102] ->3
 331 EOT_EOT
 332 # 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
 333 # -     <@> lineseq K ->3
 334 # 1        <;> nextstate(constant 685 constant.pm:121) v ->2
 335 # 2        <0> padav[@list:FAKE:m:76] ->3
 336 EONT_EONT
 337
 338
 339 sub printem {
 340     printf "myint %d mystr %s myfl %f pi %f\n"
 341         , myint, mystr, myfl, pi;
 342 }
 343
 344 checkOptree ( name      => 'call many in a print statement',
 345               code      => \&printem,
 346               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 347 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 348 # -     <@> lineseq KP ->9
 349 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
 350 # 8        <@> prtf sK ->9
 351 # 2           <0> pushmark s ->3
 352 # 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
 353 # 4           <$> const[IV 42] s ->5
 354 # 5           <$> const[PV "hithere"] s ->6
 355 # 6           <$> const[NV 3.14159] s ->7
 356 # 7           <$> const[NV 3.14159] s ->8
 357 EOT_EOT
 358 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
 359 # -     <@> lineseq KP ->9
 360 # 1        <;> nextstate(main 635 optree_constants.t:163) v ->2
 361 # 8        <@> prtf sK ->9
 362 # 2           <0> pushmark s ->3
 363 # 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
 364 # 4           <$> const(IV 42) s ->5
 365 # 5           <$> const(PV "hithere") s ->6
 366 # 6           <$> const(NV 3.14159) s ->7
 367 # 7           <$> const(NV 3.14159) s ->8
 368 EONT_EONT
 369
 370
 371 } #skip
 372
 373 __END__
 374
 375 =head NB
 376
 377 Optimized constant subs are stored as bare scalars in the stash
 378 (package hash), which formerly held only GVs (typeglobs).
 379
 380 But you cant create them manually - you cant assign a scalar to a
 381 stash element, and expect it to work like a constant-sub, even if you
 382 provide a prototype.
 383
 384 This is a feature; alternative is too much action-at-a-distance.  The
 385 following test demonstrates - napier is not seen as a function at all,
 386 much less an optimized one.
 387
 388 =cut
 389
 390 checkOptree ( name      => 'not evertnapier',
 391               code      => \&napier,
 392               noanchors => 1,
 393               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 394  has no START
 395 EOT_EOT
 396  has no START
 397 EONT_EONT
 398
 399