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;