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.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-08-21  Ed Schonberg  <schonb...@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.
--- gcc/ada/sem_ch6.adb
+++ 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;
 

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

Reply via email to