diff mbox series

[COMMITTED] ada: Too-strict conformance checking for formal discriminated type

Message ID 20231130101904.3094006-1-poulhies@adacore.com
State Committed
Commit 6a5eb72be832d308be93ea9f6a07087aa49024e9
Headers
Series [COMMITTED] ada: Too-strict conformance checking for formal discriminated type |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-arm warning Patch is already merged
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 warning Patch is already merged

Commit Message

Marc Poulhiès Nov. 30, 2023, 10:19 a.m. UTC 
  From: Steve Baird <baird@adacore.com>

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).

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_ch12.adb | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 7c645c490ae..ea85e88d753 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;