perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	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
	22	my $tests = 30;
	23	plan tests => $tests;
	24	SKIP: {
	25	skip "no perlio in this build", $tests unless $Config::Config{useperlio};
	26
	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
	35	#################################
	36
	37	use constant { # see also t/op/gv.t line 282
	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', ],
	70	};
	71
	72	use constant WEEKDAYS
	73	=> qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
	74
	75
	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	#################################
	87	pass("RENDER CONSTANT SUBS RETURNING SCALARS");
	88
	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]
	96	EOT_EOT
	97	is a constant sub, optimized to a $want->{$func}[0]
	98	EONT_EONT
	99
	100	}
	101
	102	pass("RENDER CALLS TO THOSE CONSTANT SUBS");
	103
	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);
	111	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	112	- <\@> lineseq KP ->3
	113	1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
	114	2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3
	115	EOT_EOT
	116	3 <1> leavesub[2 refs] K/REFC,1 ->(end)
	117	- <\@> lineseq KP ->3
	118	1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2
	119	2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3
	120	EONT_EONT
	121
	122	}
	123
	124	##############
	125	pass("MORE TESTS");
	126
	127	checkOptree ( name => 'myyes() as coderef',
	128	code => sub () { 1==1 },
	129	noanchors => 1,
	130	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	131	is a constant sub, optimized to a SPECIAL
	132	EOT_EOT
	133	is a constant sub, optimized to a SPECIAL
	134	EONT_EONT
	135
	136
	137	checkOptree ( name => 'myyes() as coderef',
	138	code => 'sub a() { 1==1 }; print a',
	139	noanchors => 1,
	140	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	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
	147	EOT_EOT
	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
	154	EONT_EONT
	155
	156
	157	checkOptree ( name => 'myno() as coderef',
	158	code => 'sub a() { 1!=1 }; print a',
	159	noanchors => 1,
	160	todo => '- SPECIAL sv_no renders as PVNV 0',
	161	expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
	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
	168	EOT_EOT
	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
	175	EONT_EONT
	176
	177
	178	checkOptree ( name => 'constant sub returning list',
	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
	184	# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
	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
	189	# 1 <;> nextstate(constant 685 constant.pm:121) v:*,& ->2
	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
	199	checkOptree ( name => 'call many in a print statement',
	200	code => \&printem,
	201	@open_todo,
	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
	211	# 6 <$> const[NV 1.414213] s ->7
	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
	222	# 6 <$> const(NV 1.414213) s ->7
	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