diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 20 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/rep_clause8.adb | 19 |
4 files changed, 49 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7d8ea33..d8f7de6 100644 --- 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 cbae9c8..6e52272 100644 --- 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 d50b7b2..fa53a2f 100644 --- 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 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; |