[p5sagit/p5-mst-13.2.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 ],
    myaref	=> [ 'RV', '\\\\' ],
    myglob	=> [ 'RV', '\\\\' ],
    myrex	=> [ 'RV', '\\\\' ],
    mysub	=> [ 'RV', '\\\\' ],
    myunsub	=> [ 'RV', '\\\\' ],
    # 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 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',
	      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 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


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,
	      strip_open_hints => 1,
	      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	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	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	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 ],
7a92afd1	53	myaref => [ 'RV', '\\\\' ],
	54	myglob => [ 'RV', '\\\\' ],
	55	myrex => [ 'RV', '\\\\' ],
	56	mysub => [ 'RV', '\\\\' ],
	57	myunsub => [ 'RV', '\\\\' ],
f9f861ec	58	# these are not inlined, at least not per BC::Concise
	59	#myyes => [ 'RV', ],
	60	#myno => [ 'RV', ],
d51cf0c9	61	};
	62
	63	use constant WEEKDAYS
	64	=> qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
	65
	66
d51cf0c9	67	$::{napier} = \2.71828; # counter-example (doesn't get optimized).
	68	eval "sub napier ();";
	69
	70
	71	# should be able to undefine constant::import here ???
	72	INIT {
	73	# eval 'sub constant::import () {}';
	74	# undef *constant::import::{CODE};
	75	};
	76
	77	#################################
f9f861ec	78	pass("RENDER CONSTANT SUBS RETURNING SCALARS");
2018a5c3	79
f9f861ec	80	for $func (sort keys %$want) {
	81	# no strict 'refs'; # why not needed ?
	82	checkOptree ( name => "$func() as a coderef",
	83	code => \&{$func},
	84	noanchors => 1,
	85	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
	86	is a constant sub, optimized to a $want->{$func}[0]
2018a5c3	87	EOT_EOT
f9f861ec	88	is a constant sub, optimized to a $want->{$func}[0]
d51cf0c9	89	EONT_EONT
d51cf0c9	90
f9f861ec	91	}
d51cf0c9	92
f9f861ec	93	pass("RENDER CALLS TO THOSE CONSTANT SUBS");
d51cf0c9	94
f9f861ec	95	for $func (sort keys %$want) {
	96	# print "# doing $func\n";
	97	checkOptree ( name => "call $func",
	98	code => "$func",
	99	($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (),
	100	bc_opts => '-nobanner',
	101	expect => <<EOT_EOT, expect_nt => <<EONT_EONT);
d51cf0c9	102	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	103	- <\@> lineseq KP ->3
be2b1c74	104	1 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec	105	2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
d51cf0c9	106	EOT_EOT
d51cf0c9	107	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
f9f861ec	108	- <\@> lineseq KP ->3
be2b1c74	109	1 <;> dbstate(main 833 (eval 44):1) v ->2
f9f861ec	110	2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
d51cf0c9	111	EONT_EONT
d51cf0c9	112
f9f861ec	113	}
d51cf0c9	114
f9f861ec	115	##############
f9f861ec	116	pass("MORE TESTS");
d51cf0c9	117
f9f861ec	118	checkOptree ( name => 'myyes() as coderef',
f9f861ec	119	code => sub () { 1==1 },
2018a5c3	120	noanchors => 1,
2018a5c3	121	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec	122	is a constant sub, optimized to a SPECIAL
2018a5c3	123	EOT_EOT
f9f861ec	124	is a constant sub, optimized to a SPECIAL
2018a5c3	125	EONT_EONT
	126
	127
f9f861ec	128	checkOptree ( name => 'myyes() as coderef',
f9f861ec	129	code => 'sub a() { 1==1 }; print a',
2018a5c3	130	noanchors => 1,
2018a5c3	131	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec	132	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	133	# - <@> lineseq KP ->5
	134	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	135	# 4 <@> print sK ->5
	136	# 2 <0> pushmark s ->3
	137	# 3 <$> const[SPECIAL sv_yes] s ->4
2018a5c3	138	EOT_EOT
f9f861ec	139	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	140	# - <@> lineseq KP ->5
	141	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	142	# 4 <@> print sK ->5
	143	# 2 <0> pushmark s ->3
	144	# 3 <$> const(SPECIAL sv_yes) s ->4
2018a5c3	145	EONT_EONT
2018a5c3	146
d51cf0c9	147
f9f861ec	148	checkOptree ( name => 'myno() as coderef',
f9f861ec	149	code => 'sub a() { 1!=1 }; print a',
d51cf0c9	150	noanchors => 1,
f9f861ec	151	todo => '- SPECIAL sv_no renders as PVNV 0',
d51cf0c9	152	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
f9f861ec	153	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	154	# - <@> lineseq KP ->5
	155	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	156	# 4 <@> print sK ->5
	157	# 2 <0> pushmark s ->3
	158	# 3 <$> const[PVNV 0] s ->4
d51cf0c9	159	EOT_EOT
f9f861ec	160	# 5 <1> leavesub[1 ref] K/REFC,1 ->(end)
	161	# - <@> lineseq KP ->5
	162	# 1 <;> nextstate(main 810 (eval 47):1) v ->2
	163	# 4 <@> print sK ->5
	164	# 2 <0> pushmark s ->3
	165	# 3 <$> const(PVNV 0) s ->4
d51cf0c9	166	EONT_EONT
	167
	168
2018a5c3	169	checkOptree ( name => 'constant sub returning list',
d51cf0c9	170	code => \&WEEKDAYS,
	171	noanchors => 1,
	172	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	173	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	174	# - <@> lineseq K ->3
dbeafbd1	175	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1	176	# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9	177	EOT_EOT
	178	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	179	# - <@> lineseq K ->3
dbeafbd1	180	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1	181	# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9	182	EONT_EONT
	183
	184
	185	sub printem {
	186	printf "myint %d mystr %s myfl %f pi %f\n"
	187	, myint, mystr, myfl, pi;
	188	}
	189
2018a5c3	190	checkOptree ( name => 'call many in a print statement',
d51cf0c9	191	code => \&printem,
be2b1c74	192	strip_open_hints => 1,
d51cf0c9	193	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	194	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	195	# - <@> lineseq KP ->9
be2b1c74	196	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	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	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
be2b1c74	207	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	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	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