[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccb8aa428af51db1c1fe01bf1250b6f571e11750..e54c9e0bb7a859af602148162a9064b065c8efe3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f71cdab4703707fffd9a3c3f0873b6e09111a13e..224f4c76722f05c3973337281debb18daab286a6 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d7b99081f0dd09f47f14b085bfabd4334b2d7484..6b4e6799d423de0bac736495e170ebd411b61682 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gnat.dg/prot5.adb b/gcc/testsuite/gnat.dg/prot5.adb
new file mode 100644 (file)
index 0000000..b7243a6
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/prot5_pkg.adb b/gcc/testsuite/gnat.dg/prot5_pkg.adb
new file mode 100644 (file)
index 0000000..58536c5
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/prot5_pkg.ads b/gcc/testsuite/gnat.dg/prot5_pkg.ads
new file mode 100644 (file)
index 0000000..e488d09
--- /dev/null
+++ b/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;