Commit 6cdce506 by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Spurious error on default parameter in protected operation

This patch fixes a spurious compiler error on a call to a protected
operation whose profile includes a defaulted in-parameter that is a call
to another protected function of the same object.

2018-07-31  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch6.adb (Expand_Protected_Subprogram_Call): Handle
	properly a protected call that includes a default parameter that
	is a call to a protected function of the same type.

gcc/testsuite/

	* gnat.dg/prot5.adb, gnat.dg/prot5_pkg.adb,
	gnat.dg/prot5_pkg.ads: New testcase.

From-SVN: r263101
parent c992e2e4
2018-07-31 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_Protected_Subprogram_Call): Handle
properly a protected call that includes a default parameter that
is a call to a protected function of the same type.
2018-07-31 Justin Squirek <squirek@adacore.com> 2018-07-31 Justin Squirek <squirek@adacore.com>
* lib-writ.adb (Write_With_Lines): Modfiy the generation of * lib-writ.adb (Write_With_Lines): Modfiy the generation of
......
...@@ -6387,6 +6387,30 @@ package body Exp_Ch6 is ...@@ -6387,6 +6387,30 @@ package body Exp_Ch6 is
then then
Rec := New_Occurrence_Of (First_Entity (Current_Scope), Sloc (N)); Rec := New_Occurrence_Of (First_Entity (Current_Scope), Sloc (N));
-- A default parameter of a protected operation may be a call to
-- a protected function of the type. This appears as an internal
-- call in the profile of the operation, but if the context is an
-- external call we must convert the call into an external one,
-- using the protected object that is the target, so that:
-- Prot.P (F)
-- is transformed into
-- Prot.P (Prot.F)
elsif Nkind (Parent (N)) = N_Procedure_Call_Statement
and then Nkind (Name (Parent (N))) = N_Selected_Component
and then Is_Protected_Type (Etype (Prefix (Name (Parent (N)))))
and then Is_Entity_Name (Name (N))
and then Scope (Entity (Name (N))) =
Etype (Prefix (Name (Parent (N))))
then
Rewrite (Name (N),
Make_Selected_Component (Sloc (N),
Prefix => New_Copy_Tree (Prefix (Name (Parent (N)))),
Selector_Name => Relocate_Node (Name (N))));
Analyze_And_Resolve (N);
return;
else else
-- If the context is the initialization procedure for a protected -- If the context is the initialization procedure for a protected
-- type, the call is legal because the called entity must be a -- type, the call is legal because the called entity must be a
......
2018-07-31 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/prot5.adb, gnat.dg/prot5_pkg.adb,
gnat.dg/prot5_pkg.ads: New testcase.
2018-07-31 Justin Squirek <squirek@adacore.com> 2018-07-31 Justin Squirek <squirek@adacore.com>
* gnat.dg/addr11.adb: New testcase. * gnat.dg/addr11.adb: New testcase.
......
-- { dg-do run }
-- { dg-options -gnata }
with Prot5_Pkg;
procedure Prot5 is
begin
Prot5_Pkg.P.Proc (10); -- explicit parameter
Prot5_Pkg.P.Proc (Prot5_Pkg.P.Get_Data); -- explicit call to protected operation
Prot5_Pkg.P.Proc; -- defaulted call.
pragma Assert (Prot5_Pkg.P.Get_Data = 80);
end Prot5;
package body Prot5_Pkg is
protected body P is
function Get_Data return Integer is
begin
return Data;
end Get_Data;
procedure Proc (A : Integer := Get_Data) is
begin
Data := A * 2;
end Proc;
end P;
end Prot5_Pkg;
package Prot5_Pkg is
protected P is
function Get_Data return Integer;
procedure Proc (A : Integer := Get_Data);
private
Data : Integer;
end P;
end Prot5_Pkg;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment