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

#!perl

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir('t') if -d 't';
	@INC = ('.', '../lib', '../ext/B/t');
    } else {
	unshift @INC, 't';
	push @INC, "../../t";
    }
    require Config;
    if (($Config::Config{'extensions'} !~ /\bB\b/) ){
        print "1..0 # Skip -- Perl configured without B module\n";
        exit 0;
    }
    # require 'test.pl'; # now done by OptreeCheck
}

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

my $tests = 30;
plan tests => $tests;
SKIP: {
skip "no perlio in this build", $tests unless $Config::Config{useperlio};

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

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 $want = {	# expected types, how value renders in-line, todos (maybe)
    myfl	=> [ 'NV', myfl ],
    myint	=> [ 'IV', myint ],
    mystr	=> [ 'PV', '"'.mystr.'"' ],
    myhref	=> [ 'RV', '\\\\HASH'],
    myundef	=> [ 'NULL', ],
    pi		=> [ 'NV', pi ],
    # these have todos, since they render as a bare backslash
    myaref	=> [ 'RV', '\\\\', ' - should render as \\ARRAY' ],
    myglob	=> [ 'RV', '\\\\', ' - should render as \\GV' ],
    myrex	=> [ 'RV', '\\\\', ' - should render as ??' ],
    mysub	=> [ 'RV', '\\\\', ' - should render as \\CV' ],
    myunsub	=> [ 'RV', '\\\\', ' - should render as \\CV' ],
    # these are not inlined, at least not per BC::Concise
    #myyes	=> [ 'RV', ],
    #myno	=> [ 'RV', ],
};

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 1163 OptreeCheck.pm:511]: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 1163 OptreeCheck.pm:511]: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',
	      code	=> 'sub a() { 1==1 }; print a',
	      noanchors => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 810 (eval 47):1) v ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[SPECIAL sv_yes] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 810 (eval 47):1) v ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(SPECIAL sv_yes) s ->4
EONT_EONT


checkOptree ( name	=> 'myno() as coderef',
	      code	=> 'sub a() { 1!=1 }; print a',
	      noanchors => 1,
	      todo	=> '- SPECIAL sv_no renders as PVNV 0',
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 810 (eval 47):1) v ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const[PVNV 0] s ->4
EOT_EOT
# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
# -     <@> lineseq KP ->5
# 1        <;> nextstate(main 810 (eval 47):1) v ->2
# 4        <@> print sK ->5
# 2           <0> pushmark s ->3
# 3           <$> const(PVNV 0) s ->4
EONT_EONT


checkOptree ( name	=> 'constant sub returning list',
	      code	=> \&WEEKDAYS,
	      noanchors => 1,
	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
# -     <@> lineseq K ->3
# 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
# 2        <0> padav[@list:FAKE:m:102] ->3
EOT_EOT
# 3  <1> leavesub[2 refs] K/REFC,1 ->(end)
# -     <@> lineseq K ->3
# 1        <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
# 2        <0> padav[@list:FAKE:m:76] ->3
EONT_EONT


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

checkOptree ( name	=> 'call many in a print statement',
	      code	=> \&printem,
	      expect	=> <<'EOT_EOT', expect_nt => <<'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


} #skip

__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 {
	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
f9f861ec	22	my $tests = 30;
d51cf0c9 JC	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
f9f861ec JC	30	myaref => [ 1,2,3 ],
	31	myfl => 1.414213,
	32	myglob => \*STDIN,
	33	myhref => { a => 1 },
	34	myint => 42,
	35	myrex => qr/foo/,
	36	mystr => 'hithere',
	37	mysub => \&ok,
	38	myundef => undef,
	39	myunsub => \&nosuch,
	40	};
	41
	42	sub myyes() { 1==1 }
	43	sub myno () { return 1!=1 }
	44	sub pi () { 3.14159 };
	45
	46	my $want = { # expected types, how value renders in-line, todos (maybe)
	47	myfl => [ 'NV', myfl ],
	48	myint => [ 'IV', myint ],
	49	mystr => [ 'PV', '"'.mystr.'"' ],
	50	myhref => [ 'RV', '\\\\HASH'],
	51	myundef => [ 'NULL', ],
	52	pi => [ 'NV', pi ],
	53	# these have todos, since they render as a bare backslash
	54	myaref => [ 'RV', '\\\\', ' - should render as \\ARRAY' ],
	55	myglob => [ 'RV', '\\\\', ' - should render as \\GV' ],
	56	myrex => [ 'RV', '\\\\', ' - should render as ??' ],
	57	mysub => [ 'RV', '\\\\', ' - should render as \\CV' ],
	58	myunsub => [ 'RV', '\\\\', ' - should render as \\CV' ],
	59	# these are not inlined, at least not per BC::Concise
	60	#myyes => [ 'RV', ],
	61	#myno => [ 'RV', ],
d51cf0c9 JC	62	};
	63
	64	use constant WEEKDAYS
	65	=> qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
	66
	67
d51cf0c9 JC	68	$::{napier} = \2.71828; # counter-example (doesn't get optimized).
	69	eval "sub napier ();";
	70
	71
	72	# should be able to undefine constant::import here ???
	73	INIT {
	74	# eval 'sub constant::import () {}';
	75	# undef *constant::import::{CODE};
	76	};
	77
	78	#################################
f9f861ec	79	pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3	80
f9f861ec JC	81	for $func (sort keys %$want) {
	82	# no strict 'refs'; # why not needed ?
	83	checkOptree ( name => "$func() as a coderef",
	84	code => \&{$func},
	85	noanchors => 1,
	86	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
	87	is a constant sub, optimized to a $want->{$func}[0]
2018a5c3	88	EOT_EOT
f9f861ec	89	is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9 JC	90	EONT_EONT
d51cf0c9 JC	91
f9f861ec	92	}
d51cf0c9	93
f9f861ec	94	pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9	95
f9f861ec JC	96	for $func (sort keys %$want) {
	97	# print "# doing $func\n";
	98	checkOptree ( name => "call $func",
	99	code => "$func",
	100	($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
	101	bc_opts => '-nobanner',
	102	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
d51cf0c9	103	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	104	- <\@> lineseq KP ->3
d51cf0c9	105	1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec	106	2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9 JC	107	EOT_EOT
d51cf0c9 JC	108	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	109	- <\@> lineseq KP ->3
d51cf0c9	110	1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
f9f861ec	111	2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9 JC	112	EONT_EONT
d51cf0c9 JC	113
f9f861ec	114	}
d51cf0c9	115
f9f861ec JC	116	##############
f9f861ec JC	117	pass("MORE TESTS");
d51cf0c9	118
f9f861ec JC	119	checkOptree ( name => 'myyes() as coderef',
f9f861ec JC	120	code => sub () { 1==1 },
2018a5c3 JC	121	noanchors => 1,
2018a5c3 JC	122	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec	123	is a constant sub, optimized to a SPECIAL
2018a5c3	124	EOT_EOT
f9f861ec	125	is a constant sub, optimized to a SPECIAL
2018a5c3 JC	126	EONT_EONT
	127
	128
f9f861ec JC	129	checkOptree ( name => 'myyes() as coderef',
f9f861ec JC	130	code => 'sub a() { 1==1 }; print a',
2018a5c3 JC	131	noanchors => 1,
2018a5c3 JC	132	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec JC	133	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	134	# - <@> lineseq KP ->5
	135	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	136	# 4 <@> print sK ->5
	137	# 2 <0> pushmark s ->3
	138	# 3 <$> const[SPECIAL sv_yes] s ->4
2018a5c3	139	EOT_EOT
f9f861ec JC	140	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	141	# - <@> lineseq KP ->5
	142	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	143	# 4 <@> print sK ->5
	144	# 2 <0> pushmark s ->3
	145	# 3 <$> const(SPECIAL sv_yes) s ->4
2018a5c3 JC	146	EONT_EONT
2018a5c3 JC	147
d51cf0c9	148
f9f861ec JC	149	checkOptree ( name => 'myno() as coderef',
f9f861ec JC	150	code => 'sub a() { 1!=1 }; print a',
d51cf0c9	151	noanchors => 1,
f9f861ec	152	todo => '- SPECIAL sv_no renders as PVNV 0',
d51cf0c9	153	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec JC	154	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	155	# - <@> lineseq KP ->5
	156	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	157	# 4 <@> print sK ->5
	158	# 2 <0> pushmark s ->3
	159	# 3 <$> const[PVNV 0] s ->4
d51cf0c9	160	EOT_EOT
f9f861ec JC	161	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	162	# - <@> lineseq KP ->5
	163	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	164	# 4 <@> print sK ->5
	165	# 2 <0> pushmark s ->3
	166	# 3 <$> const(PVNV 0) s ->4
d51cf0c9 JC	167	EONT_EONT
	168
	169
2018a5c3	170	checkOptree ( name => 'constant sub returning list',
d51cf0c9 JC	171	code => \&WEEKDAYS,
	172	noanchors => 1,
	173	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	174	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	175	# - <@> lineseq K ->3
d5ec2987	176	# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
d51cf0c9 JC	177	# 2 <0> padav[@list:FAKE:m:102] ->3
	178	EOT_EOT
	179	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	180	# - <@> lineseq K ->3
d5ec2987	181	# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
d51cf0c9 JC	182	# 2 <0> padav[@list:FAKE:m:76] ->3
	183	EONT_EONT
	184
	185
	186	sub printem {
	187	printf "myint %d mystr %s myfl %f pi %f\n"
	188	, myint, mystr, myfl, pi;
	189	}
	190
2018a5c3	191	checkOptree ( name => 'call many in a print statement',
d51cf0c9 JC	192	code => \&printem,
	193	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	194	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	195	# - <@> lineseq KP ->9
	196	# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
	197	# 8 <@> prtf sK ->9
	198	# 2 <0> pushmark s ->3
	199	# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
	200	# 4 <$> const[IV 42] s ->5
	201	# 5 <$> const[PV "hithere"] s ->6
f9f861ec	202	# 6 <$> const[NV 1.414213] s ->7
d51cf0c9 JC	203	# 7 <$> const[NV 3.14159] s ->8
	204	EOT_EOT
	205	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	206	# - <@> lineseq KP ->9
	207	# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2
	208	# 8 <@> prtf sK ->9
	209	# 2 <0> pushmark s ->3
	210	# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
	211	# 4 <$> const(IV 42) s ->5
	212	# 5 <$> const(PV "hithere") s ->6
f9f861ec	213	# 6 <$> const(NV 1.414213) s ->7
d51cf0c9 JC	214	# 7 <$> const(NV 3.14159) s ->8
	215	EONT_EONT
	216
	217
	218	} #skip
	219
	220	__END__
	221
	222	=head NB
	223
	224	Optimized constant subs are stored as bare scalars in the stash
	225	(package hash), which formerly held only GVs (typeglobs).
	226
	227	But you cant create them manually - you cant assign a scalar to a
	228	stash element, and expect it to work like a constant-sub, even if you
	229	provide a prototype.
	230
	231	This is a feature; alternative is too much action-at-a-distance. The
	232	following test demonstrates - napier is not seen as a function at all,
	233	much less an optimized one.
	234
	235	=cut
	236
	237	checkOptree ( name => 'not evertnapier',
	238	code => \&napier,
	239	noanchors => 1,
	240	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	241	has no START
	242	EOT_EOT
	243	has no START
	244	EONT_EONT
	245
	246