From a50584b8a63b57913d0f213b51403953f799c962 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Mon, 5 Aug 2024 15:53:12 -0700 Subject: ada: Missing legality check when type completed Refine previous fix to better handle tagged cases. gcc/ada/ * sem_ch6.adb (Check_Discriminant_Conformance): Immediately after calling Is_Immutably_Limited_Type, perform an additional test that one might reasonably imagine would instead have been part of Is_Immutably_Limited_Type. The new test is a call to a new function Has_Tagged_Limited_Partial_View whose implementation includes a call to Incomplete_Or_Partial_View, which cannot be easily be called from Is_Immutably_Limited_Type (because sem_aux, which is in the closure of the binder, cannot easily "with" sem_util). * sem_aux.adb (Is_Immutably_Limited): Include N_Derived_Type_Definition case when testing Limited_Present flag. --- gcc/ada/sem_aux.adb | 8 ++++---- gcc/ada/sem_ch6.adb | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 9903a2b..5edf667 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1118,12 +1118,12 @@ package body Sem_Aux is elsif Is_Private_Type (Btype) then - -- If Ent occurs in the completion of a limited private type, then - -- look for the word "limited" in the full view. + -- If Ent occurs in the completion of a private type, then + -- look for the word "limited" in the full view. if Nkind (Parent (Ent)) = N_Full_Type_Declaration - and then Nkind (Type_Definition (Parent (Ent))) = - N_Record_Definition + and then Nkind (Type_Definition (Parent (Ent))) in + N_Record_Definition | N_Derived_Type_Definition and then Limited_Present (Type_Definition (Parent (Ent))) then return True; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 86d7845..076fb89 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6432,6 +6432,25 @@ package body Sem_Ch6 is OldD : constant Boolean := Present (Expression (Parent (Old_Discr))); + function Has_Tagged_Limited_Partial_View + (Typ : Entity_Id) return Boolean; + -- Returns True iff Typ has a tagged limited partial view. + + ------------------------------------- + -- Has_Tagged_Limited_Partial_View -- + ------------------------------------- + + function Has_Tagged_Limited_Partial_View + (Typ : Entity_Id) return Boolean + is + Priv : constant Entity_Id := Incomplete_Or_Partial_View (Typ); + begin + return Present (Priv) + and then not Is_Incomplete_Type (Priv) + and then Is_Tagged_Type (Priv) + and then Limited_Present (Parent (Priv)); + end Has_Tagged_Limited_Partial_View; + begin if NewD or OldD then @@ -6463,6 +6482,13 @@ package body Sem_Ch6 is N_Access_Definition and then not Is_Immutably_Limited_Type (Defining_Identifier (N)) + + -- Check for a case that would be awkward to handle in + -- Is_Immutably_Limited_Type (because sem_aux can't + -- "with" sem_util). + + and then not Has_Tagged_Limited_Partial_View + (Defining_Identifier (N)) then Error_Msg_N ("(Ada 2005) default value for access discriminant " -- cgit v1.1