From 85f0ae3c54ad48e62ca02e61a1aa1ab3c8664142 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Wed, 6 Dec 2023 16:06:28 -0800 Subject: ada: Error compiling Ada 2022 object renaming with no subtype mark In some cases the compiler would crash or generate spurious errors compiling a legal object renaming declaration that lacks a subtype mark. In addition to fixing the immediate problem, change Atree.Copy_Slots so that attempts to modify either the Empty or the Error nodes (e.g., by passing one of them as the target in a call to Rewrite) are ineffective. Cope with the consequences of this. gcc/ada/ * sem_ch8.adb (Check_Constrained_Object): Before updating the subtype mark of an object renaming declaration by calling Rewrite, first check whether the destination of the Rewrite call exists. * atree.adb (Copy_Slots): Return without performing any updates if Destination equals Empty or Error, or if Source equals Empty. Any of those conditions indicates an error case. * sem_ch12.adb (Analyze_Formal_Derived_Type): Avoid cascading errors. * sem_ch3.adb (Analyze_Number_Declaration): In an error case, do not pass Error as destination in a call to Rewrite. (Find_Type_Of_Subtype_Indic): In an error case, do not pass Error or Empty as destination in a call to Rewrite. --- gcc/ada/sem_ch3.adb | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'gcc/ada/sem_ch3.adb') diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index a6bc8c9..70cf772 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3668,7 +3668,7 @@ package body Sem_Ch3 is -------------------------------- procedure Analyze_Number_Declaration (N : Node_Id) is - E : constant Node_Id := Expression (N); + E : Node_Id := Expression (N); Id : constant Entity_Id := Defining_Identifier (N); Index : Interp_Index; It : Interp; @@ -3694,14 +3694,13 @@ package body Sem_Ch3 is Set_Is_Pure (Id, Is_Pure (Current_Scope)); - -- Process expression, replacing error by integer zero, to avoid - -- cascaded errors or aborts further along in the processing - -- Replace Error by integer zero, which seems least likely to cause -- cascaded errors. if E = Error then - Rewrite (E, Make_Integer_Literal (Sloc (E), Uint_0)); + pragma Assert (Serious_Errors_Detected > 0); + E := Make_Integer_Literal (Sloc (N), Uint_0); + Set_Expression (N, E); Set_Error_Posted (E); end if; @@ -18615,7 +18614,10 @@ package body Sem_Ch3 is -- Otherwise we have a subtype mark without a constraint elsif Error_Posted (S) then - Rewrite (S, New_Occurrence_Of (Any_Id, Sloc (S))); + -- Don't rewrite if S is Empty or Error + if S > Empty_Or_Error then + Rewrite (S, New_Occurrence_Of (Any_Id, Sloc (S))); + end if; return Any_Type; else -- cgit v1.1