diff options
| author | Steve Baird <baird@adacore.com> | 2023-11-15 13:13:04 -0800 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2023-11-30 11:12:46 +0100 |
| commit | 6a5eb72be832d308be93ea9f6a07087aa49024e9 (patch) | |
| tree | db09c8a456039894153bb6e06f7e34dc68f27136 /gcc | |
| parent | 925f96eab82bad8e237887d5860442d012b68e36 (diff) | |
| download | gcc-6a5eb72be832d308be93ea9f6a07087aa49024e9.zip gcc-6a5eb72be832d308be93ea9f6a07087aa49024e9.tar.gz gcc-6a5eb72be832d308be93ea9f6a07087aa49024e9.tar.bz2 | |
ada: Too-strict conformance checking for formal discriminated type
The discriminant subtype conformance check for an actual parameter
corresponding to a generic formal discriminated type was too strict and
could incorrectly reject legal instantiations.
gcc/ada/
* sem_ch12.adb (Validate_Discriminated_Formal_Type): Replace
Entity_Id equality test with a call to Subtypes_Match. Distinct
subtypes which are statically matching should pass this test.
(Check_Discriminated_Formal): Replace Entity_Id equality test with
a call to Subtypes_Statically_Match (preceded by a check that the
preconditions for the call are satisfied).
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 7c645c4..ea85e88 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -14001,9 +14001,10 @@ package body Sem_Ch12 is and then (Ekind (Base_Type (Etype (Actual_Discr)))) = E_Anonymous_Access_Type and then - Get_Instance_Of - (Designated_Type (Base_Type (Formal_Subt))) = - Designated_Type (Base_Type (Etype (Actual_Discr))) + Subtypes_Match + (Get_Instance_Of + (Designated_Type (Base_Type (Formal_Subt))), + Designated_Type (Base_Type (Etype (Actual_Discr)))) then null; @@ -17322,8 +17323,14 @@ package body Sem_Ch12 is and then (Ekind (Base_Type (Etype (Actual_Discr)))) = E_Anonymous_Access_Type and then - Designated_Type (Base_Type (Formal_Subt)) = - Designated_Type (Base_Type (Etype (Actual_Discr))) + Base_Type + (Designated_Type (Base_Type (Formal_Subt))) = + Base_Type + (Designated_Type (Base_Type (Etype (Actual_Discr)))) + and then + Subtypes_Statically_Match + (Designated_Type (Base_Type (Formal_Subt)), + Designated_Type (Base_Type (Etype (Actual_Discr)))) then null; |