[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 s ->3
# 3           <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
# 4           <$> const[IV 42] s* ->5
# 5           <$> const[PV "hithere"] s* ->6
# 6           <$> const[NV 1.414213] s* ->7
# 7           <$> const[NV 3.14159] s* ->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 s ->3
# 3           <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
# 4           <$> const(IV 42) s* ->5
# 5           <$> const(PV "hithere") s* ->6
# 6           <$> const(NV 1.414213) s* ->7
# 7           <$> const(NV 3.14159) s* ->8
EONT_EONT

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
be2b1c74	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
be2b1c74	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
dbeafbd1 NC	184	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1 NC	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
dbeafbd1 NC	189	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1 NC	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 JC	213	# 8 <@> prtf sK ->9
	214	# 2 <0> pushmark s ->3
	215	# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
d7bdb74f FR	216	# 4 <$> const[IV 42] s* ->5
	217	# 5 <$> const[PV "hithere"] s* ->6
	218	# 6 <$> const[NV 1.414213] s* ->7
	219	# 7 <$> const[NV 3.14159] s* ->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 JC	224	# 8 <@> prtf sK ->9
	225	# 2 <0> pushmark s ->3
	226	# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
6b7c6d95 FC	227	# 4 <$> const(IV 42) s* ->5
	228	# 5 <$> const(PV "hithere") s* ->6
	229	# 6 <$> const(NV 1.414213) s* ->7
	230	# 7 <$> const(NV 3.14159) s* ->8
d51cf0c9 JC	231	EONT_EONT
d51cf0c9 JC	232
e412117e NC	233	if($] < 5.009) {
	234	# 5.8.x's use constant has larger types
	235	foreach ($expect, $expect_nt) {
	236	s/IV 42/PV$&/;
	237	s/NV 1.41/PV$&/;
	238	}
	239	}
	240
	241	checkOptree ( name => 'call many in a print statement',
	242	code => \&printem,
	243	strip_open_hints => 1,
	244	expect => $expect, expect_nt => $expect_nt);
d51cf0c9	245
183eb698 JC	246	# test constant expression folding
	247
	248	checkOptree ( name => 'arithmetic constant folding in print',
	249	code => 'print 1+2+3',
	250	strip_open_hints => 1,
	251	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	252	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	253	# - <@> lineseq KP ->5
	254	# 1 <;> nextstate(main 937 (eval 53):1) v ->2
	255	# 4 <@> print sK ->5
	256	# 2 <0> pushmark s ->3
	257	# 3 <$> const[IV 6] s ->4
	258	EOT_EOT
	259	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	260	# - <@> lineseq KP ->5
	261	# 1 <;> nextstate(main 937 (eval 53):1) v ->2
	262	# 4 <@> print sK ->5
	263	# 2 <0> pushmark s ->3
	264	# 3 <$> const(IV 6) s ->4
	265	EONT_EONT
	266
	267	checkOptree ( name => 'string constant folding in print',
	268	code => 'print "foo"."bar"',
	269	strip_open_hints => 1,
	270	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	271	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	272	# - <@> lineseq KP ->5
	273	# 1 <;> nextstate(main 942 (eval 55):1) v ->2
	274	# 4 <@> print sK ->5
	275	# 2 <0> pushmark s ->3
	276	# 3 <$> const[PV "foobar"] s ->4
	277	EOT_EOT
	278	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	279	# - <@> lineseq KP ->5
	280	# 1 <;> nextstate(main 942 (eval 55):1) v ->2
	281	# 4 <@> print sK ->5
	282	# 2 <0> pushmark s ->3
	283	# 3 <$> const(PV "foobar") s ->4
	284	EONT_EONT
	285
	286	checkOptree ( name => 'boolean or folding',
	287	code => 'print "foobar" if 1 or 0',
	288	strip_open_hints => 1,
	289	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	290	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	291	# - <@> lineseq KP ->5
	292	# 1 <;> nextstate(main 942 (eval 55):1) v ->2
	293	# 4 <@> print sK ->5
	294	# 2 <0> pushmark s ->3
	295	# 3 <$> const[PV "foobar"] s ->4
	296	EOT_EOT
	297	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	298	# - <@> lineseq KP ->5
	299	# 1 <;> nextstate(main 942 (eval 55):1) v ->2
	300	# 4 <@> print sK ->5
	301	# 2 <0> pushmark s ->3
	302	# 3 <$> const(PV "foobar") s ->4
	303	EONT_EONT
	304
	305	checkOptree ( name => 'lc,uc,gt,lt,ge,le,cmp',
	306	code => sub {
	307	$s = uc('foo.').ucfirst('bar.').lc('LOW.').lcfirst('LOW');
	308	print "a-lt-b" if "a" lt "b";
	309	print "b-gt-a" if "b" gt "a";
310	print "a-le-b" if "a" le "b";
311	print "b-ge-a" if "b" ge "a";
312	print "b-cmp-a" if "b" cmp "a";
313	print "a-gt-b" if "a" gt "b"; # should be suppressed
314	},
315	strip_open_hints => 1,
316	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
317	# r <1> leavesub[1 ref] K/REFC,1 ->(end)
318	# - <@> lineseq KP ->r
b6093575	319	# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 JC	320	# 4 <2> sassign vKS/2 ->5
	321	# 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3
	322	# - <1> ex-rv2sv sKRM*/1 ->4
	323	# 3 <#> gvsv[*s] s ->4
b6093575	324	# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698 JC	325	# 8 <@> print vK ->9
	326	# 6 <0> pushmark s ->7
	327	# 7 <$> const[PV "a-lt-b"] s ->8
b6093575	328	# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698 JC	329	# c <@> print vK ->d
	330	# a <0> pushmark s ->b
	331	# b <$> const[PV "b-gt-a"] s ->c
b6093575	332	# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698 JC	333	# g <@> print vK ->h
	334	# e <0> pushmark s ->f
	335	# f <$> const[PV "a-le-b"] s ->g
b6093575	336	# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698 JC	337	# k <@> print vK ->l
	338	# i <0> pushmark s ->j
	339	# j <$> const[PV "b-ge-a"] s ->k
b6093575	340	# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698 JC	341	# o <@> print vK ->p
	342	# m <0> pushmark s ->n
	343	# n <$> const[PV "b-cmp-a"] s ->o
b6093575	344	# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
183eb698 JC	345	# q <$> const[PVNV 0] s/SHORT ->r
	346	EOT_EOT
	347	# r <1> leavesub[1 ref] K/REFC,1 ->(end)
	348	# - <@> lineseq KP ->r
b6093575	349	# 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2
183eb698 JC	350	# 4 <2> sassign vKS/2 ->5
	351	# 2 <$> const(PV "FOO.Bar.low.lOW") s ->3
	352	# - <1> ex-rv2sv sKRM*/1 ->4
	353	# 3 <$> gvsv(*s) s ->4
b6093575	354	# 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6
183eb698 JC	355	# 8 <@> print vK ->9
	356	# 6 <0> pushmark s ->7
	357	# 7 <$> const(PV "a-lt-b") s ->8
b6093575	358	# 9 <;> nextstate(main 916 optree_constants.t:309) v:>,<,%,{ ->a
183eb698 JC	359	# c <@> print vK ->d
	360	# a <0> pushmark s ->b
	361	# b <$> const(PV "b-gt-a") s ->c
b6093575	362	# d <;> nextstate(main 916 optree_constants.t:310) v:>,<,%,{ ->e
183eb698 JC	363	# g <@> print vK ->h
	364	# e <0> pushmark s ->f
	365	# f <$> const(PV "a-le-b") s ->g
b6093575	366	# h <;> nextstate(main 916 optree_constants.t:311) v:>,<,%,{ ->i
183eb698 JC	367	# k <@> print vK ->l
	368	# i <0> pushmark s ->j
	369	# j <$> const(PV "b-ge-a") s ->k
b6093575	370	# l <;> nextstate(main 916 optree_constants.t:312) v:>,<,%,{ ->m
183eb698 JC	371	# o <@> print vK ->p
	372	# m <0> pushmark s ->n
	373	# n <$> const(PV "b-cmp-a") s ->o
b6093575	374	# p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q
183eb698 JC	375	# q <$> const(SPECIAL sv_no) s/SHORT ->r
	376	EONT_EONT
	377
	378	checkOptree ( name => 'mixed constant folding, with explicit braces',
	379	code => 'print "foo"."bar".(2+3)',
	380	strip_open_hints => 1,
	381	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	382	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	383	# - <@> lineseq KP ->5
	384	# 1 <;> nextstate(main 977 (eval 28):1) v ->2
	385	# 4 <@> print sK ->5
	386	# 2 <0> pushmark s ->3
	387	# 3 <$> const[PV "foobar5"] s ->4
	388	EOT_EOT
	389	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	390	# - <@> lineseq KP ->5
	391	# 1 <;> nextstate(main 977 (eval 28):1) v ->2
	392	# 4 <@> print sK ->5
	393	# 2 <0> pushmark s ->3
	394	# 3 <$> const(PV "foobar5") s ->4
	395	EONT_EONT
	396
d51cf0c9 JC	397	__END__
	398
	399	=head NB
	400
	401	Optimized constant subs are stored as bare scalars in the stash
	402	(package hash), which formerly held only GVs (typeglobs).
	403
	404	But you cant create them manually - you cant assign a scalar to a
	405	stash element, and expect it to work like a constant-sub, even if you
	406	provide a prototype.
	407
	408	This is a feature; alternative is too much action-at-a-distance. The
	409	following test demonstrates - napier is not seen as a function at all,
	410	much less an optimized one.
	411
	412	=cut
	413
	414	checkOptree ( name => 'not evertnapier',
	415	code => \&napier,
	416	noanchors => 1,
	417	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	418	has no START
	419	EOT_EOT
	420	has no START
	421	EONT_EONT
	422
	423