From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 31 Jul 2018 09:56:21 +0000 (+0000)
Subject: [Ada] Spurious error on default parameter in protected operation
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6cdce5064b7e2c30beec8a99f1b19869f14398a7;p=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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccb8aa428af..e54c9e0bb7a 100644
--- 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 f71cdab4703..224f4c76722 100644
--- 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 d7b99081f0d..6b4e6799d42 100644
--- 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
index 00000000000..b7243a6341a
--- /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
index 00000000000..58536c54f50
--- /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
index 00000000000..e488d09b78e
--- /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;