[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};

my @open_todo;
sub open_todo {
    if (((caller 0)[10]||{})->{open}) {
	@open_todo = (skip => "\$^OPEN is set");
    }
}
open_todo;

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

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