diff options
| author | Steve Baird <baird@adacore.com> | 2024-08-05 15:53:12 -0700 |
|---|---|---|
| committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-08-29 15:06:28 +0200 |
| commit | a50584b8a63b57913d0f213b51403953f799c962 (patch) | |
| tree | 2a60623499bf343cbc9f6f250c519a6b003afde7 /gcc | |
| parent | 499406992f48cc8da64448a107f95e681cea9039 (diff) | |
| download | gcc-a50584b8a63b57913d0f213b51403953f799c962.zip gcc-a50584b8a63b57913d0f213b51403953f799c962.tar.gz gcc-a50584b8a63b57913d0f213b51403953f799c962.tar.bz2 | |
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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/sem_aux.adb | 8 | ||||
| -rw-r--r-- | 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 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 " |