From: Steve Baird <ba...@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aux.adb | 8 ++++---- gcc/ada/sem_ch6.adb | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 9903a2b6a16..5edf6675474 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 86d784543f3..076fb89c7b5 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 " -- 2.45.2