mirror of git://gcc.gnu.org/git/gcc.git
[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
This commit is contained in:
parent
c992e2e4bd
commit
6cdce5064b
|
|
@ -1,3 +1,9 @@
|
|||
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>
|
||||
|
||||
* lib-writ.adb (Write_With_Lines): Modfiy the generation of
|
||||
|
|
|
|||
|
|
@ -6387,6 +6387,30 @@ package body Exp_Ch6 is
|
|||
then
|
||||
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
|
||||
-- If the context is the initialization procedure for a protected
|
||||
-- type, the call is legal because the called entity must be a
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
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>
|
||||
|
||||
* gnat.dg/addr11.adb: New testcase.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
-- { 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;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
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;
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
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;
|
||||
Loading…
Reference in New Issue