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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-31 Ed Schonberg <schonb...@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.--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -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
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot5.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot5_pkg.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot5_pkg.ads
@@ -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;
