The compiler does not report an error on a generic type that has a
representation clause when its ultimate parent is not a generic formal.

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

2019-07-09  Javier Miranda  <mira...@adacore.com>

gcc/ada/

        * sem_ch13.adb (Rep_Item_Too_Early): Representation clauses are
        not allowed for a derivation of a generic type. Extend the
        current test to check that none of the parents is a generic
        type.

gcc/testsuite/

        * gnat.dg/rep_clause8.adb: New testcase.
--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -12548,6 +12548,24 @@ package body Sem_Ch13 is
    ------------------------
 
    function Rep_Item_Too_Early (T : Entity_Id; N : Node_Id) return Boolean is
+      function Has_Generic_Parent (E : Entity_Id) return Boolean;
+      --  Return True if any ancestor is a generic type
+
+      function Has_Generic_Parent (E : Entity_Id) return Boolean is
+         Ancestor_Type : Entity_Id := Etype (E);
+
+      begin
+         while Present (Ancestor_Type)
+           and then not Is_Generic_Type (Ancestor_Type)
+           and then Etype (Ancestor_Type) /= Ancestor_Type
+         loop
+            Ancestor_Type := Etype (Ancestor_Type);
+         end loop;
+
+         return Present (Ancestor_Type)
+                  and then Is_Generic_Type (Ancestor_Type);
+      end Has_Generic_Parent;
+
    begin
       --  Cannot apply non-operational rep items to generic types
 
@@ -12555,7 +12573,7 @@ package body Sem_Ch13 is
          return False;
 
       elsif Is_Type (T)
-        and then Is_Generic_Type (Root_Type (T))
+        and then Has_Generic_Parent (T)
         and then (Nkind (N) /= N_Pragma
                    or else Get_Pragma_Id (N) /= Pragma_Convention)
       then

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/rep_clause8.adb
@@ -0,0 +1,19 @@
+procedure Rep_Clause8 is
+   package Pack is
+      type Root is tagged record
+         Comp : Integer;
+      end record;
+   end Pack;
+   use Pack;
+
+   generic
+      type Formal_Root is new Root with private;
+   package Gen_Derived is
+      type Deriv is new Formal_Root with null record
+        with Size => 300; --  { dg-error "representation item not allowed for generic type" }
+   end Gen_Derived;
+
+   package Inst_Derived is new Gen_Derived (Root);
+begin
+   null;
+end;

Reply via email to