[Ada] Missing error on generic type with representation clause

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.

2019-07-09  Javier Miranda  <miranda@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.

From-SVN: r273283

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7d8ea33d5557124b23f414ab24b34486d440f796..d8f7de624dbe96fb5b7f08ab31a9299e561c3774 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-09  Javier Miranda  <miranda@adacore.com>
+
+       * 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.
+
 2019-07-09  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_ch9.adb, exp_util.adb, repinfo.adb, sem_ch12.adb,

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index cbae9c8d4a34d9292ed88f6f57d9cceabd16662c..6e52272ad4a5b705532302a6e19d8d5c01369e70 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d50b7b2097f15a236f688ae1a21d91167d34ecbc..fa53a2fc46107da5a4a918c32aacf692fe73919d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-09  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/rep_clause8.adb: New testcase.
+
 2019-07-09  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/equal7.adb, gnat.dg/equal7_pkg.adb,

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