[Ada] Spurious error on overriding protected function in instance

The conformance between an overriding protected operation with
progenitors and the overridden interface operation requires subtype
conformance; requiring equality of return types in the case of a
function is too restrictive and leads to spurious errors when the return
type is a generic actual.

2018-08-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch6.adb (Check_Synchronized_Overriding): The conformance
	between an overriding protected operation and the overridden
	abstract progenitor operation requires subtype conformance;
	requiring equality of return types in the case of a function is
	too restrictive and leads to spurious errors when the return
	type is a generic actual.

gcc/testsuite/

	* gnat.dg/prot6.adb, gnat.dg/prot6.ads: New testcase.

From-SVN: r263731

5 files changed, 67 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 98045633fbf..ff886ebd789 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,14 @@
 2018-08-21  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_ch6.adb (Check_Synchronized_Overriding): The conformance
+	between an overriding protected operation and the overridden
+	abstract progenitor operation requires subtype conformance;
+	requiring equality of return types in the case of a function is
+	too restrictive and leads to spurious errors when the return
+	type is a generic actual.
+
+2018-08-21  Ed Schonberg  <schonberg@adacore.com>
+
 	* exp_ch9.adb (Expand_N_Timed_Entry_Call,
 	Expand_Conditional_Entry_Call): Use Reset_Scopes_Of to set
 	properly the scope of all entities created in blocks generated
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 2dd9d2f4287..2ddd3d35767 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7440,13 +7440,15 @@ package body Sem_Ch6 is
                end;
 
             --  Functions can override abstract interface functions
+            --  Return types must be subtype conformant.
 
             elsif Ekind (Def_Id) = E_Function
               and then Ekind (Subp) = E_Function
               and then Matches_Prefixed_View_Profile
                          (Parameter_Specifications (Parent (Def_Id)),
                           Parameter_Specifications (Parent (Subp)))
-              and then Etype (Def_Id) = Etype (Subp)
+              and then Conforming_Types (Etype (Def_Id), Etype (Subp),
+                Subtype_Conformant)
             then
                Candidate := Subp;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index eccca9b0349..ddc6e0dc13b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
 2018-08-21  Ed Schonberg  <schonberg@adacore.com>
 
+	* gnat.dg/prot6.adb, gnat.dg/prot6.ads: New testcase.
+
+2018-08-21  Ed Schonberg  <schonberg@adacore.com>
+
 	* gnat.dg/access5.adb, gnat.dg/access5.ads: New testcase.
 
 2018-08-21  Eric Botcazou  <ebotcazou@adacore.com>
diff --git a/gcc/testsuite/gnat.dg/prot6.adb b/gcc/testsuite/gnat.dg/prot6.adb
new file mode 100644
index 00000000000..f33b0a2429d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot6.adb
@@ -0,0 +1,20 @@
+--  { dg-do compile }
+--  { dg-options "-gnatc" }
+
+package body Prot6 is
+
+   protected body My_Type is
+
+      procedure Set (D : Integer) is
+      begin
+         I := D;
+      end Set;
+
+      function Get return Integer is
+      begin
+         return I;
+      end Get;
+   end My_Type;
+
+   procedure Dummy is null;
+end Prot6;
diff --git a/gcc/testsuite/gnat.dg/prot6.ads b/gcc/testsuite/gnat.dg/prot6.ads
new file mode 100644
index 00000000000..d8e27e0a73b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot6.ads
@@ -0,0 +1,31 @@
+package Prot6 is
+
+   generic
+      type TD is private;
+      type TI is synchronized interface;
+   package Set_Get is
+      type T is synchronized interface and TI;
+
+      procedure Set (E : in out T; D : TD) is abstract;
+      function Get (E : T) return TD is abstract;
+   end Set_Get;
+
+   type My_Type_Interface is synchronized interface;
+
+   package Set_Get_Integer is
+     new Set_Get (TD => Integer,
+                  TI => My_Type_Interface);
+   use Set_Get_Integer;
+
+   protected type My_Type is
+        new Set_Get_Integer.T with
+
+      overriding procedure Set (D : Integer);
+      overriding function Get return Integer;
+   private
+      I : Integer;
+   end My_Type;
+
+   procedure Dummy;
+
+end Prot6;