diff mbox series

[Ada] Spurious error on default parameter in protected operation

Message ID 20180731095716.GA124977@adacore.com
State New
Headers show
Series [Ada] Spurious error on default parameter in protected operation | expand

Commit Message

Pierre-Marie de Rodat July 31, 2018, 9:57 a.m. UTC 
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  <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.
diff mbox series

Patch

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