[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',
	      prog	=> 'sub a() { 1==1 }; print a',
	      noanchors => 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,
	      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


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',
36932700	129	prog => 'sub a() { 1==1 }; print a',
2018a5c3	130	noanchors => 1,
2018a5c3	131	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700	132	# 6 <@> leave[1 ref] vKP/REFC ->(end)
	133	# 1 <0> enter ->2
	134	# 2 <;> nextstate(main 2 -e:1) v:{ ->3
	135	# 5 <@> print vK ->6
	136	# 3 <0> pushmark s ->4
	137	# 4 <$> const[SPECIAL sv_yes] s ->5
2018a5c3	138	EOT_EOT
36932700	139	# 6 <@> leave[1 ref] vKP/REFC ->(end)
	140	# 1 <0> enter ->2
	141	# 2 <;> nextstate(main 2 -e:1) v:{ ->3
	142	# 5 <@> print vK ->6
	143	# 3 <0> pushmark s ->4
	144	# 4 <$> const(SPECIAL sv_yes) s ->5
2018a5c3	145	EONT_EONT
2018a5c3	146
d51cf0c9	147
36932700	148	# Need to do this as a prog, not code, as only the first constant to use
	149	# PL_sv_no actually gets to use the real thing - every one following is
	150	# copied.
f9f861ec	151	checkOptree ( name => 'myno() as coderef',
36932700	152	prog => 'sub a() { 1!=1 }; print a',
d51cf0c9	153	noanchors => 1,
d51cf0c9	154	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
36932700	155	# 6 <@> leave[1 ref] vKP/REFC ->(end)
	156	# 1 <0> enter ->2
	157	# 2 <;> nextstate(main 2 -e:1) v:{ ->3
	158	# 5 <@> print vK ->6
	159	# 3 <0> pushmark s ->4
	160	# 4 <$> const[SPECIAL sv_no] s ->5
d51cf0c9	161	EOT_EOT
36932700	162	# 6 <@> leave[1 ref] vKP/REFC ->(end)
	163	# 1 <0> enter ->2
	164	# 2 <;> nextstate(main 2 -e:1) v:{ ->3
	165	# 5 <@> print vK ->6
	166	# 3 <0> pushmark s ->4
	167	# 4 <$> const(SPECIAL sv_no) s ->5
d51cf0c9	168	EONT_EONT
	169
	170
2018a5c3	171	checkOptree ( name => 'constant sub returning list',
d51cf0c9	172	code => \&WEEKDAYS,
	173	noanchors => 1,
	174	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	175	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	176	# - <@> lineseq K ->3
dbeafbd1	177	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1	178	# 2 <0> padav[@list:FAKE:m:96] ->3
d51cf0c9	179	EOT_EOT
	180	# 3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	181	# - <@> lineseq K ->3
dbeafbd1	182	# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2
dbeafbd1	183	# 2 <0> padav[@list:FAKE:m:71] ->3
d51cf0c9	184	EONT_EONT
	185
	186
	187	sub printem {
	188	printf "myint %d mystr %s myfl %f pi %f\n"
	189	, myint, mystr, myfl, pi;
	190	}
	191
2018a5c3	192	checkOptree ( name => 'call many in a print statement',
d51cf0c9	193	code => \&printem,
be2b1c74	194	strip_open_hints => 1,
d51cf0c9	195	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	196	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	197	# - <@> lineseq KP ->9
be2b1c74	198	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	199	# 8 <@> prtf sK ->9
	200	# 2 <0> pushmark s ->3
	201	# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4
	202	# 4 <$> const[IV 42] s ->5
	203	# 5 <$> const[PV "hithere"] s ->6
f9f861ec	204	# 6 <$> const[NV 1.414213] s ->7
d51cf0c9	205	# 7 <$> const[NV 3.14159] s ->8
	206	EOT_EOT
	207	# 9 <1> leavesub[1 ref] K/REFC,1 ->(end)
	208	# - <@> lineseq KP ->9
be2b1c74	209	# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2
d51cf0c9	210	# 8 <@> prtf sK ->9
	211	# 2 <0> pushmark s ->3
	212	# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4
	213	# 4 <$> const(IV 42) s ->5
	214	# 5 <$> const(PV "hithere") s ->6
f9f861ec	215	# 6 <$> const(NV 1.414213) s ->7
d51cf0c9	216	# 7 <$> const(NV 3.14159) s ->8
	217	EONT_EONT
	218
	219
	220	} #skip
	221
	222	__END__
	223
	224	=head NB
	225
	226	Optimized constant subs are stored as bare scalars in the stash
	227	(package hash), which formerly held only GVs (typeglobs).
	228
	229	But you cant create them manually - you cant assign a scalar to a
	230	stash element, and expect it to work like a constant-sub, even if you
	231	provide a prototype.
	232
	233	This is a feature; alternative is too much action-at-a-distance. The
	234	following test demonstrates - napier is not seen as a function at all,
	235	much less an optimized one.
	236
	237	=cut
	238
	239	checkOptree ( name => 'not evertnapier',
	240	code => \&napier,
	241	noanchors => 1,
	242	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	243	has no START
	244	EOT_EOT
	245	has no START
	246	EONT_EONT
	247
	248