[perl5.git] / ext / B / t / optree_constants.t

#!perl

BEGIN {
    unshift @INC, 't';
    require Config;
    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
        print "1..0 # Skip -- Perl configured without B module\n";
        exit 0;
    }
    if (!$Config::Config{useperlio}) {
        print "1..0 # Skip -- need perlio to walk the optree\n";
        exit 0;
    }
}

use OptreeCheck;	# ALSO DOES @ARGV HANDLING !!!!!!
use Config;

plan tests => 67;

#################################

use constant {		# see also t/op/gv.t line 282
    myaref	=> [ 1,2,3 ],
    myfl	=> 1.414213,
    myglob	=> \*STDIN,
    myhref	=> { a	=> 1 },
    myint	=> 42,
    myrex	=> qr/foo/,
    mystr	=> 'hithere',
    mysub	=> \&ok,
    myundef	=> undef,
    myunsub	=> \&nosuch,
};

sub myyes() { 1==1 }
sub myno () { return 1!=1 }
sub pi () { 3.14159 };

my $RV_class = $] >= 5.011 ? 'IV' : 'RV';

my $want = {	# expected types, how value renders in-line, todos (maybe)
    mystr	=> [ 'PV', '"'.mystr.'"' ],
    myhref	=> [ $RV_class, '\\\\HASH'],
    pi		=> [ 'NV', pi ],
    myglob	=> [ $RV_class, '\\\\' ],
    mysub	=> [ $RV_class, '\\\\' ],
    myunsub	=> [ $RV_class, '\\\\' ],
    # these are not inlined, at least not per BC::Concise
    #myyes	=> [ $RV_class, ],
    #myno	=> [ $RV_class, ],
    $] > 5.009 ? (
    myaref	=> [ $RV_class, '\\\\' ],
    myfl	=> [ 'NV', myfl ],
    myint	=> [ 'IV', myint ],
    $] >= 5.011 ? (
    myrex	=> [ $RV_class, '\\\\"\\(?^:Foo\\)"' ],
    ) : (
    myrex	=> [ $RV_class, '\\\\' ],
    ),
    myundef	=> [ 'NULL', ],
    ) : (
    myaref	=> [ 'PVIV', '' ],
    myfl	=> [ 'PVNV', myfl ],
    myint	=> [ 'PVIV', myint ],
    myrex	=> [ 'PVNV', '' ],
    myundef	=> [ 'PVIV', ],
    )
};

use constant WEEKDAYS
    => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );


$::{napier} = \2.71828;	# counter-example (doesn't get optimized).
eval "sub napier ();";


# should be able to undefine constant::import here ???
INIT { 
    # eval 'sub constant::import () {}';
    # undef *constant::import::{CODE};
};

#################################
pass("RENDER CONSTANT SUBS RETURNING SCALARS");

for $func (sort keys %$want) {
    # no strict 'refs';	# why not needed ?
    checkOptree ( name      => "$func() as a coderef",
		  code      => \&{$func},
		  noanchors => 1,
		  expect    => <<EOT_EOT, expect_nt => <<EONT_EONT);
 is a constant sub, optimized to a $want->{$func}[0]
EOT_EOT
 is a constant sub, optimized to a $want->{$func}[0]
EONT_EONT

}

pass("RENDER CALLS TO THOSE CONSTANT SUBS");

for $func (sort keys %$want) {
    # print "# doing $func\n";
    checkOptree ( name    => "call $func",
		  code    => "$func",
		  ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
		  bc_opts => '-nobanner',
		  expect  => <<EOT_EOT, expect_nt => <<EONT_EONT);
3  <1> leavesub[2 refs] K/REFC,1 ->(end)
-     <\@> lineseq KP ->3
1        <;> dbstate(main 833 (eval 44):1) v:% ->2
2        <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
EOT_EOT
3  <1> leavesub[2 refs] K/REFC,1 ->(end)
-     <\@> lineseq KP ->3
1        <;> dbstate(main 833 (eval 44):1) v:% ->2
2        <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
EONT_EONT

}

##############
pass("MORE TESTS");

checkOptree ( name	=> 'myyes() as coderef',
	      code	=> sub () { 1==1 },
	      noanchors => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 is a constant sub, optimized to a SPECIAL
EOT_EOT
 is a constant sub, optimized to a SPECIAL
EONT_EONT


checkOptree ( name	=> 'myyes() as coderef',
	      prog	=> 'sub a() { 1==1 }; print a',
	      noanchors => 1,
	      strip_open_hints => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 6  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5     <@> print vK ->6
# 3        <0> pushmark s ->4
# 4        <$> const[SPECIAL sv_yes] s* ->5
EOT_EOT
# 6  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5     <@> print vK ->6
# 3        <0> pushmark s ->4
# 4        <$> const(SPECIAL sv_yes) s* ->5
EONT_EONT


# Need to do this as a prog, not code, as only the first constant to use
# PL_sv_no actually gets to use the real thing - every one following is
# copied.
checkOptree ( name	=> 'myno() as coderef',
	      prog	=> 'sub a() { 1!=1 }; print a',
	      noanchors => 1,
	      strip_open_hints => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 6  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5     <@> print vK ->6
# 3        <0> pushmark s ->4
# 4        <$> const[SPECIAL sv_no] s* ->5
EOT_EOT
# 6  <@> leave[1 ref] vKP/REFC ->(end)
# 1     <0> enter ->2
# 2     <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
# 5     <@> print vK ->6
# 3        <0> pushmark s ->4
# 4        <$> const(SPECIAL sv_no) s* ->5
EONT_EONT


my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
# -     <@> lineseq K ->3
# 1        <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
# 2        <0> padav[@list:FAKE:m:96] ->3
EOT_EOT
# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
# -     <@> lineseq K ->3
# 1        <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
# 2        <0> padav[@list:FAKE:m:71] ->3
EONT_EONT

if($] < 5.009) {
    # 5.8.x doesn't add the m flag to padav
    s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
}

checkOptree ( name	=> 'constant sub returning list',
	      code	=> \&WEEKDAYS,
	      noanchors => 1,
	      expect => $expect, expect_nt => $expect_nt);


sub printem {
    printf "myint %d mystr %s myfl %f pi %f\n"
	, myint, mystr, myfl, pi;
}

my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
# 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->9
# 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
# 8        <@> prtf sK ->9
# 2           <0> pushmark sM ->3
# 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4
# 4           <$> const[IV 42] sM* ->5
# 5           <$> const[PV "hithere"] sM* ->6
# 6           <$> const[NV 1.414213] sM* ->7
# 7           <$> const[NV 3.14159] sM* ->8
EOT_EOT
# 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->9
# 1        <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
# 8        <@> prtf sK ->9
# 2           <0> pushmark sM ->3
# 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4
# 4           <$> const(IV 42) sM* ->5
# 5           <$> const(PV "hithere") sM* ->6
# 6           <$> const(NV 1.414213) sM* ->7
# 7           <$> const(NV 3.14159) sM* ->8
EONT_EONT

if($] < 5.015) {
    s/M(?=\*? ->)//g for $expect, $expect_nt;
}
if($] < 5.009) {
    # 5.8.x's use constant has larger types
    foreach ($expect, $expect_nt) {
	s/IV 42/PV$&/;
	s/NV 1.41/PV$&/;
    }
}

checkOptree ( name	=> 'call many in a print statement',
	      code	=> \&printem,
	      strip_open_hints => 1,
	      expect => $expect, expect_nt => $expect_nt);

# test constant expression folding

checkOptree ( name	=> 'arithmetic constant folding in print',
	      code	=> 'print 1+2+3',
	      strip_open_hints => 1,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 937 (eval 53):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[IV 6] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 937 (eval 53):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(IV 6) s ->4
EONT_EONT

checkOptree ( name	=> 'string constant folding in print',
	      code	=> 'print "foo"."bar"',
	      strip_open_hints => 1,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 942 (eval 55):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[PV "foobar"] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 942 (eval 55):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(PV "foobar") s ->4
EONT_EONT

checkOptree ( name	=> 'boolean or folding',
	      code	=> 'print "foobar" if 1 or 0',
	      strip_open_hints => 1,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 942 (eval 55):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[PV "foobar"] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 942 (eval 55):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(PV "foobar") s ->4
EONT_EONT

checkOptree ( name	=> 'lc*,uc*,gt,lt,ge,le,cmp',
	      code	=> sub {
		  $s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
		  print "a-lt-b" if "a" lt "b";
		  print "b-gt-a" if "b" gt "a";
		  print "a-le-b" if "a" le "b";
		  print "b-ge-a" if "b" ge "a";
		  print "b-cmp-a" if "b" cmp "a";
		  print "a-gt-b" if "a" gt "b";	# should be suppressed
	      },
	      strip_open_hints => 1,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# r  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->r
# 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
# 4        <2> sassign vKS/2 ->5
# 2           <$> const[PV "FOO.Bar.low.lOW"] s ->3
# -           <1> ex-rv2sv sKRM*/1 ->4
# 3              <#> gvsv[*s] s ->4
# 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
# 8        <@> print vK ->9
# 6           <0> pushmark s ->7
# 7           <$> const[PV "a-lt-b"] s ->8
# 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
# c        <@> print vK ->d
# a           <0> pushmark s ->b
# b           <$> const[PV "b-gt-a"] s ->c
# d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
# g        <@> print vK ->h
# e           <0> pushmark s ->f
# f           <$> const[PV "a-le-b"] s ->g
# h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
# k        <@> print vK ->l
# i           <0> pushmark s ->j
# j           <$> const[PV "b-ge-a"] s ->k
# l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
# o        <@> print vK ->p
# m           <0> pushmark s ->n
# n           <$> const[PV "b-cmp-a"] s ->o
# p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
# q        <$> const[PVNV 0] s/SHORT ->r
EOT_EOT
# r  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->r
# 1        <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
# 4        <2> sassign vKS/2 ->5
# 2           <$> const(PV "FOO.Bar.low.lOW") s ->3
# -           <1> ex-rv2sv sKRM*/1 ->4
# 3              <$> gvsv(*s) s ->4
# 5        <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
# 8        <@> print vK ->9
# 6           <0> pushmark s ->7
# 7           <$> const(PV "a-lt-b") s ->8
# 9        <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
# c        <@> print vK ->d
# a           <0> pushmark s ->b
# b           <$> const(PV "b-gt-a") s ->c
# d        <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
# g        <@> print vK ->h
# e           <0> pushmark s ->f
# f           <$> const(PV "a-le-b") s ->g
# h        <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
# k        <@> print vK ->l
# i           <0> pushmark s ->j
# j           <$> const(PV "b-ge-a") s ->k
# l        <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
# o        <@> print vK ->p
# m           <0> pushmark s ->n
# n           <$> const(PV "b-cmp-a") s ->o
# p        <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
# q        <$> const(SPECIAL sv_no) s/SHORT ->r
EONT_EONT

checkOptree ( name	=> 'mixed constant folding, with explicit braces',
	      code	=> 'print "foo"."bar".(2+3)',
	      strip_open_hints => 1,
	      expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 977 (eval 28):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[PV "foobar5"] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 977 (eval 28):1) v:% ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(PV "foobar5") s ->4
EONT_EONT

__END__

=head NB

Optimized constant subs are stored as bare scalars in the stash
(package hash), which formerly held only GVs (typeglobs).

But you cant create them manually - you cant assign a scalar to a
stash element, and expect it to work like a constant-sub, even if you
provide a prototype.

This is a feature; alternative is too much action-at-a-distance.  The
following test demonstrates - napier is not seen as a function at all,
much less an optimized one.

=cut

checkOptree ( name	=> 'not evertnapier',
	      code	=> \&napier,
	      noanchors => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 has no START
EOT_EOT
 has no START
EONT_EONT
Commit	Line	Data
d51cf0c9 JC	1	#!perl
	2
	3	BEGIN {
74517a3a	4	unshift @INC, 't';
d51cf0c9 JC	5	require Config;
	6	if (($Config::Config{'extensions'} !~ /\bB\b/) ){
	7	print "1..0 # Skip -- Perl configured without B module\n";
	8	exit 0;
	9	}
27e11f68 NC	10	if (!$Config::Config{useperlio}) {
	11	print "1..0 # Skip -- need perlio to walk the optree\n";
	12	exit 0;
	13	}
d51cf0c9 JC	14	}
	15
	16	use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
	17	use Config;
	18
183eb698	19	plan tests => 67;
d51cf0c9 JC	20
	21	#################################
	22
	23	use constant { # see also t/op/gv.t line 282
f9f861ec JC	24	myaref => [ 1,2,3 ],
	25	myfl => 1.414213,
	26	myglob => \*STDIN,
	27	myhref => { a => 1 },
	28	myint => 42,
	29	myrex => qr/foo/,
	30	mystr => 'hithere',
	31	mysub => \&ok,
	32	myundef => undef,
	33	myunsub => \&nosuch,
	34	};
	35
	36	sub myyes() { 1==1 }
	37	sub myno () { return 1!=1 }
	38	sub pi () { 3.14159 };
	39
4df7f6af NC	40	my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
4df7f6af NC	41
f9f861ec	42	my $want = { # expected types, how value renders in-line, todos (maybe)
f9f861ec	43	mystr => [ 'PV', '"'.mystr.'"' ],
4df7f6af	44	myhref => [ $RV_class, '\\\\HASH'],
f9f861ec	45	pi => [ 'NV', pi ],
4df7f6af NC	46	myglob => [ $RV_class, '\\\\' ],
	47	mysub => [ $RV_class, '\\\\' ],
	48	myunsub => [ $RV_class, '\\\\' ],
f9f861ec	49	# these are not inlined, at least not per BC::Concise
4df7f6af NC	50	#myyes => [ $RV_class, ],
4df7f6af NC	51	#myno => [ $RV_class, ],
e412117e	52	$] > 5.009 ? (
4df7f6af	53	myaref => [ $RV_class, '\\\\' ],
e412117e NC	54	myfl => [ 'NV', myfl ],
e412117e NC	55	myint => [ 'IV', myint ],
f7c278bf	56	$] >= 5.011 ? (
4c2c679f	57	myrex => [ $RV_class, '\\\\"\\(?^:Foo\\)"' ],
f7c278bf	58	) : (
4df7f6af	59	myrex => [ $RV_class, '\\\\' ],
f7c278bf	60	),
e412117e NC	61	myundef => [ 'NULL', ],
	62	) : (
	63	myaref => [ 'PVIV', '' ],
	64	myfl => [ 'PVNV', myfl ],
	65	myint => [ 'PVIV', myint ],
	66	myrex => [ 'PVNV', '' ],
	67	myundef => [ 'PVIV', ],
	68	)
d51cf0c9 JC	69	};
	70
	71	use constant WEEKDAYS
	72	=> qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
	73
	74
d51cf0c9 JC	75	$::{napier} = \2.71828; # counter-example (doesn't get optimized).
	76	eval "sub napier ();";
	77
	78
	79	# should be able to undefine constant::import here ???
	80	INIT {
	81	# eval 'sub constant::import () {}';
	82	# undef *constant::import::{CODE};
	83	};
	84
	85	#################################
f9f861ec	86	pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3	87
f9f861ec JC	88	for $func (sort keys %$want) {
	89	# no strict 'refs'; # why not needed ?
	90	checkOptree ( name => "$func() as a coderef",
	91	code => \&{$func},
	92	noanchors => 1,
	93	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
	94	is a constant sub, optimized to a $want->{$func}[0]
2018a5c3	95	EOT_EOT
f9f861ec	96	is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9 JC	97	EONT_EONT
d51cf0c9 JC	98
f9f861ec	99	}
d51cf0c9	100
f9f861ec	101	pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9	102
f9f861ec JC	103	for $func (sort keys %$want) {
	104	# print "# doing $func\n";
	105	checkOptree ( name => "call $func",
	106	code => "$func",
	107	($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
	108	bc_opts => '-nobanner',
	109	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
d51cf0c9	110	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	111	- <\@> lineseq KP ->3
51530e33	112	1 <;> dbstate(main 833 (eval 44):1) v:% ->2
6b7c6d95	113	2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3
d51cf0c9 JC	114	EOT_EOT
d51cf0c9 JC	115	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	116	- <\@> lineseq KP ->3
51530e33	117	1 <;> dbstate(main 833 (eval 44):1) v:% ->2
6b7c6d95	118	2 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3
d51cf0c9 JC	119	EONT_EONT
d51cf0c9 JC	120
f9f861ec	121	}
d51cf0c9	122
f9f861ec JC	123	##############
f9f861ec JC	124	pass("MORE TESTS");
d51cf0c9	125
f9f861ec JC	126	checkOptree ( name => 'myyes() as coderef',
f9f861ec JC	127	code => sub () { 1==1 },
2018a5c3 JC	128	noanchors => 1,
2018a5c3 JC	129	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec	130	is a constant sub, optimized to a SPECIAL
2018a5c3	131	EOT_EOT
f9f861ec	132	is a constant sub, optimized to a SPECIAL
2018a5c3 JC	133	EONT_EONT
	134
	135
f9f861ec	136	checkOptree ( name => 'myyes() as coderef',
36932700	137	prog => 'sub a() { 1==1 }; print a',
2018a5c3	138	noanchors => 1,
e412117e	139	strip_open_hints => 1,
2018a5c3	140	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700 NC	141	# 6 <@> leave[1 ref] vKP/REFC ->(end)
36932700 NC	142	# 1 <0> enter ->2
e412117e	143	# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700 NC	144	# 5 <@> print vK ->6
36932700 NC	145	# 3 <0> pushmark s ->4
6b7c6d95	146	# 4 <$> const[SPECIAL sv_yes] s* ->5
2018a5c3	147	EOT_EOT
36932700 NC	148	# 6 <@> leave[1 ref] vKP/REFC ->(end)
36932700 NC	149	# 1 <0> enter ->2
e412117e	150	# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700 NC	151	# 5 <@> print vK ->6
36932700 NC	152	# 3 <0> pushmark s ->4
6b7c6d95	153	# 4 <$> const(SPECIAL sv_yes) s* ->5
2018a5c3 JC	154	EONT_EONT
2018a5c3 JC	155
d51cf0c9	156
36932700 NC	157	# Need to do this as a prog, not code, as only the first constant to use
	158	# PL_sv_no actually gets to use the real thing - every one following is
	159	# copied.
f9f861ec	160	checkOptree ( name => 'myno() as coderef',
36932700	161	prog => 'sub a() { 1!=1 }; print a',
d51cf0c9	162	noanchors => 1,
e412117e	163	strip_open_hints => 1,
d51cf0c9	164	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700 NC	165	# 6 <@> leave[1 ref] vKP/REFC ->(end)
36932700 NC	166	# 1 <0> enter ->2
e412117e	167	# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700 NC	168	# 5 <@> print vK ->6
36932700 NC	169	# 3 <0> pushmark s ->4
6b7c6d95	170	# 4 <$> const[SPECIAL sv_no] s* ->5
d51cf0c9	171	EOT_EOT
36932700 NC	172	# 6 <@> leave[1 ref] vKP/REFC ->(end)
36932700 NC	173	# 1 <0> enter ->2
e412117e	174	# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3
36932700 NC	175	# 5 <@> print vK ->6
36932700 NC	176	# 3 <0> pushmark s ->4
6b7c6d95	177	# 4 <$> const(SPECIAL sv_no) s* ->5
d51cf0c9 JC	178	EONT_EONT
	179
	180
e412117e	181	my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9 JC	182	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
d51cf0c9 JC	183	# - <@> lineseq K ->3
51530e33	184	# 1 <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
dbeafbd1	185	# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9 JC	186	EOT_EOT
	187	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	188	# - <@> lineseq K ->3
51530e33	189	# 1 <;> nextstate(constant 61 constant.pm:118) v:%,*,& ->2
dbeafbd1	190	# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9 JC	191	EONT_EONT
d51cf0c9 JC	192
e412117e NC	193	if($] < 5.009) {
	194	# 5.8.x doesn't add the m flag to padav
	195	s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt);
	196	}
	197
	198	checkOptree ( name => 'constant sub returning list',
	199	code => \&WEEKDAYS,
	200	noanchors => 1,
	201	expect => $expect, expect_nt => $expect_nt);
	202
d51cf0c9 JC	203
	204	sub printem {
	205	printf "myint %d mystr %s myfl %f pi %f\n"
	206	, myint, mystr, myfl, pi;
	207	}
	208
e412117e	209	my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
d51cf0c9 JC	210	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
d51cf0c9 JC	211	# - <@> lineseq KP ->9
be2b1c74	212	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	213	# 8 <@> prtf sK ->9
69974ce6 FC	214	# 2 <0> pushmark sM ->3
	215	# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4
	216	# 4 <$> const[IV 42] sM* ->5
	217	# 5 <$> const[PV "hithere"] sM* ->6
	218	# 6 <$> const[NV 1.414213] sM* ->7
	219	# 7 <$> const[NV 3.14159] sM* ->8
d51cf0c9 JC	220	EOT_EOT
	221	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	222	# - <@> lineseq KP ->9
be2b1c74	223	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	224	# 8 <@> prtf sK ->9
69974ce6 FC	225	# 2 <0> pushmark sM ->3
	226	# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4
	227	# 4 <$> const(IV 42) sM* ->5
	228	# 5 <$> const(PV "hithere") sM* ->6
	229	# 6 <$> const(NV 1.414213) sM* ->7
	230	# 7 <$> const(NV 3.14159) sM* ->8
d51cf0c9 JC	231	EONT_EONT
d51cf0c9 JC	232
69974ce6 FC	233	if($] < 5.015) {
	234	s/M(?=\*? ->)//g for $expect, $expect_nt;
	235	}
e412117e NC	236	if($] < 5.009) {
	237	# 5.8.x's use constant has larger types
	238	foreach ($expect, $expect_nt) {
	239	s/IV 42/PV$&/;
	240	s/NV 1.41/PV$&/;
	241	}
	242	}
	243
	244	checkOptree ( name => 'call many in a print statement',
	245	code => \&printem,
	246	strip_open_hints => 1,
	247	expect => $expect, expect_nt => $expect_nt);
d51cf0c9	248
183eb698 JC	249	# test constant expression folding
	250
	251	checkOptree ( name => 'arithmetic constant folding in print',
	252	code => 'print 1+2+3',
	253	strip_open_hints => 1,
	254	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	255	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	256	# - <@> lineseq KP ->5
51530e33	257	# 1 <;> nextstate(main 937 (eval 53):1) v:% ->2
183eb698 JC	258	# 4 <@> print sK ->5
	259	# 2 <0> pushmark s ->3
	260	# 3 <$> const[IV 6] s ->4
	261	EOT_EOT
	262	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	263	# - <@> lineseq KP ->5
51530e33	264	# 1 <;> nextstate(main 937 (eval 53):1) v:% ->2
183eb698 JC	265	# 4 <@> print sK ->5
	266	# 2 <0> pushmark s ->3
	267	# 3 <$> const(IV 6) s ->4
	268	EONT_EONT
	269
	270	checkOptree ( name => 'string constant folding in print',
	271	code => 'print "foo"."bar"',
	272	strip_open_hints => 1,
	273	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	274	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	275	# - <@> lineseq KP ->5
51530e33	276	# 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
183eb698 JC	277	# 4 <@> print sK ->5
	278	# 2 <0> pushmark s ->3
	279	# 3 <$> const[PV "foobar"] s ->4
	280	EOT_EOT
	281	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	282	# - <@> lineseq KP ->5
51530e33	283	# 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
183eb698 JC	284	# 4 <@> print sK ->5
	285	# 2 <0> pushmark s ->3
	286	# 3 <$> const(PV "foobar") s ->4
	287	EONT_EONT
	288
	289	checkOptree ( name => 'boolean or folding',
	290	code => 'print "foobar" if 1 or 0',
	291	strip_open_hints => 1,
	292	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	293	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	294	# - <@> lineseq KP ->5
51530e33	295	# 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
183eb698 JC	296	# 4 <@> print sK ->5
	297	# 2 <0> pushmark s ->3
	298	# 3 <$> const[PV "foobar"] s ->4
	299	EOT_EOT
	300	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	301	# - <@> lineseq KP ->5
51530e33	302	# 1 <;> nextstate(main 942 (eval 55):1) v:% ->2
183eb698 JC	303	# 4 <@> print sK ->5
	304	# 2 <0> pushmark s ->3
	305	# 3 <$> const(PV "foobar") s ->4
	306	EONT_EONT
	307
	308	checkOptree ( name => 'lc,uc,gt,lt,ge,le,cmp',
	309	code => sub {
	310	$s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
	311	print "a-lt-b" if "a" lt "b";
	312	print "b-gt-a" if "b" gt "a";
	313	print "a-le-b" if "a" le "b";
	314	print "b-ge-a" if "b" ge "a";
	315	print "b-cmp-a" if "b" cmp "a";
	316	print "a-gt-b" if "a" gt "b"; # should be suppressed
	317	},
	318	strip_open_hints => 1,
	319	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	320	# r <1> leavesub[1 ref] K/REFC,1 ->(end)
	321	# - <@> lineseq KP ->r
b6093575	322	# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 JC	323	# 4 <2> sassign vKS/2 ->5
	324	# 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3
	325	# - <1> ex-rv2sv sKRM*/1 ->4
	326	# 3 <#> gvsv[*s] s ->4
b6093575	327	# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698 JC	328	# 8 <@> print vK ->9
	329	# 6 <0> pushmark s ->7
	330	# 7 <$> const[PV "a-lt-b"] s ->8
b6093575	331	# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698 JC	332	# c <@> print vK ->d
	333	# a <0> pushmark s ->b
	334	# b <$> const[PV "b-gt-a"] s ->c
b6093575	335	# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698 JC	336	# g <@> print vK ->h
	337	# e <0> pushmark s ->f
	338	# f <$> const[PV "a-le-b"] s ->g
b6093575	339	# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698 JC	340	# k <@> print vK ->l
	341	# i <0> pushmark s ->j
	342	# j <$> const[PV "b-ge-a"] s ->k
b6093575	343	# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698 JC	344	# o <@> print vK ->p
	345	# m <0> pushmark s ->n
	346	# n <$> const[PV "b-cmp-a"] s ->o
b6093575	347	# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
183eb698 JC	348	# q <$> const[PVNV 0] s/SHORT ->r
	349	EOT_EOT
	350	# r <1> leavesub[1 ref] K/REFC,1 ->(end)
	351	# - <@> lineseq KP ->r
b6093575	352	# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 JC	353	# 4 <2> sassign vKS/2 ->5
	354	# 2 <$> const(PV "FOO.Bar.low.lOW") s ->3
	355	# - <1> ex-rv2sv sKRM*/1 ->4
	356	# 3 <$> gvsv(*s) s ->4
b6093575	357	# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698 JC	358	# 8 <@> print vK ->9
	359	# 6 <0> pushmark s ->7
	360	# 7 <$> const(PV "a-lt-b") s ->8
b6093575	361	# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698 JC	362	# c <@> print vK ->d
	363	# a <0> pushmark s ->b
	364	# b <$> const(PV "b-gt-a") s ->c
b6093575	365	# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698 JC	366	# g <@> print vK ->h
	367	# e <0> pushmark s ->f
	368	# f <$> const(PV "a-le-b") s ->g
b6093575	369	# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698 JC	370	# k <@> print vK ->l
	371	# i <0> pushmark s ->j
	372	# j <$> const(PV "b-ge-a") s ->k
b6093575	373	# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698 JC	374	# o <@> print vK ->p
	375	# m <0> pushmark s ->n
	376	# n <$> const(PV "b-cmp-a") s ->o
b6093575	377	# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
183eb698 JC	378	# q <$> const(SPECIAL sv_no) s/SHORT ->r
	379	EONT_EONT
	380
	381	checkOptree ( name => 'mixed constant folding, with explicit braces',
	382	code => 'print "foo"."bar".(2+3)',
	383	strip_open_hints => 1,
	384	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	385	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	386	# - <@> lineseq KP ->5
51530e33	387	# 1 <;> nextstate(main 977 (eval 28):1) v:% ->2
183eb698 JC	388	# 4 <@> print sK ->5
	389	# 2 <0> pushmark s ->3
	390	# 3 <$> const[PV "foobar5"] s ->4
	391	EOT_EOT
	392	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	393	# - <@> lineseq KP ->5
51530e33	394	# 1 <;> nextstate(main 977 (eval 28):1) v:% ->2
183eb698 JC	395	# 4 <@> print sK ->5
	396	# 2 <0> pushmark s ->3
	397	# 3 <$> const(PV "foobar5") s ->4
	398	EONT_EONT
	399
d51cf0c9 JC	400	__END__
	401
	402	=head NB
	403
	404	Optimized constant subs are stored as bare scalars in the stash
	405	(package hash), which formerly held only GVs (typeglobs).
	406
	407	But you cant create them manually - you cant assign a scalar to a
	408	stash element, and expect it to work like a constant-sub, even if you
	409	provide a prototype.
	410
	411	This is a feature; alternative is too much action-at-a-distance. The
	412	following test demonstrates - napier is not seen as a function at all,
	413	much less an optimized one.
	414
	415	=cut
	416
	417	checkOptree ( name => 'not evertnapier',
	418	code => \&napier,
	419	noanchors => 1,
	420	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	421	has no START
	422	EOT_EOT
	423	has no START
	424	EONT_EONT
	425
	426