https://gcc.gnu.org/g:8fdda43b8f2edd2bf36574ba1f1f9968076047b9
commit r17-4601-g8fdda43b8f2edd2bf36574ba1f1f9968076047b9 Author: Eric Botcazou <[email protected]> Date: Wed Sep 23 11:16:17 2026 +0200 Ada: Fix Program_Error raised on ill-formed quantified expression This occurs for the argument of pragma Assert, Check, Loop_Invariant, etc. The testcase trips on another issue for the renaming of a reference to the 'Old attribute, which is fixed by removing essentially unused code. gcc/ada/ * sem_ch8.adb (Get_Object_Name): Delete. (Analyze_Object_Renaming): Use Is_Entity_Name to detect names. * sem_prag.adb (Analyze_Pragma) <Pragma_Assert>: Detect ill-formed quantified expressions and give an error. <Pragma_Check>: Likewise. * sem_res.ads (Malformed_Quantified_Expression): New procedure. * sem_res.adb (Malformed_Quantified_Expression): Likewise. (Resolve): Call Malformed_Quantified_Expression to give the error about ill-formed quantified expressions. Diff: --- gcc/ada/sem_ch8.adb | 40 ++-------------------------------------- gcc/ada/sem_prag.adb | 18 ++++++++++++++++-- gcc/ada/sem_res.adb | 51 ++++++++++++++++++++++++++++----------------------- gcc/ada/sem_res.ads | 10 ++++------ 4 files changed, 50 insertions(+), 69 deletions(-) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index e8490bc503e9..661aa6beef3d 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -776,10 +776,6 @@ package body Sem_Ch8 is -- has already established its actual subtype. This is only relevant -- if the renamed object is an explicit dereference. - function Get_Object_Name (Nod : Node_Id) return Node_Id; - -- Obtain the name of the object from node Nod which is being renamed by - -- the object renaming declaration N. - function Find_Raise_Node (N : Node_Id) return Traverse_Result; -- Process one node in search for N_Raise_xxx_Error nodes. -- Return Abandon if found, OK otherwise. @@ -908,38 +904,6 @@ package body Sem_Ch8 is end if; end Check_Constrained_Object; - --------------------- - -- Get_Object_Name -- - --------------------- - - function Get_Object_Name (Nod : Node_Id) return Node_Id is - Obj_Nam : Node_Id; - - begin - Obj_Nam := Nod; - while Present (Obj_Nam) loop - case Nkind (Obj_Nam) is - when N_Attribute_Reference - | N_Explicit_Dereference - | N_Indexed_Component - | N_Slice - => - Obj_Nam := Prefix (Obj_Nam); - - when N_Selected_Component => - Obj_Nam := Selector_Name (Obj_Nam); - - when N_Qualified_Expression | N_Type_Conversion => - Obj_Nam := Expression (Obj_Nam); - - when others => - exit; - end case; - end loop; - - return Obj_Nam; - end Get_Object_Name; - -- Start of processing for Analyze_Object_Renaming begin @@ -1387,9 +1351,9 @@ package body Sem_Ch8 is return; end if; - if Ada_Version >= Ada_2005 and then Nkind (Nam) in N_Has_Entity then + if Ada_Version >= Ada_2005 and then Is_Entity_Name (Nam) then declare - Nam_Ent : constant Entity_Id := Entity (Get_Object_Name (Nam)); + Nam_Ent : constant Entity_Id := Entity (Nam); Nam_Decl : constant Node_Id := Declaration_Node (Nam_Ent); begin diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 29ef2a46a44f..827192ace384 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14785,12 +14785,19 @@ package body Sem_Prag is Check_Arg_Order (Names); Mark_Ghost_Pragma (N, Current_Scope); + -- Diagnose the case of a quantified expression being mistaken + -- for an iterated component association, because the user has + -- forgotten the "all" or "some" keyword after "for". + + if Nkind (Arg_Check) = N_Iterated_Component_Association then + Malformed_Quantified_Expression (Arg_Check); + -- Special processing for Loop_Invariant, Loop_Variant or for -- other cases where a Loop_Entry attribute is present. If the -- assertion pragma contains attribute Loop_Entry, ensure that -- the related pragma is within a loop. - if Prag_Id = Pragma_Loop_Invariant + elsif Prag_Id = Pragma_Loop_Invariant or else Prag_Id = Pragma_Loop_Variant or else Contains_Loop_Entry (Arg_Check) then @@ -15982,10 +15989,17 @@ package body Sem_Prag is Preanalyze_And_Resolve (Arg_Message, Standard_String); end if; + -- Diagnose the case of a quantified expression being mistaken + -- for an iterated component association, because the user has + -- forgotten the "all" or "some" keyword after "for". + + if Nkind (Arg_Check) = N_Iterated_Component_Association then + Malformed_Quantified_Expression (Arg_Check); + -- When expansion is active but check is not, only preanalyze the -- boolean to avoid pulling useless dependencies. - if Expander_Active and Is_Ignored_In_Codegen (N) then + elsif Expander_Active and Is_Ignored_In_Codegen (N) then In_Assertion_Expr := In_Assertion_Expr + 1; Preanalyze_And_Resolve (Arg_Check, Any_Boolean); In_Assertion_Expr := In_Assertion_Expr - 1; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1bea0d6a600b..078e32c42a14 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1976,6 +1976,28 @@ package body Sem_Res is end if; end Make_Call_Into_Operator; + ------------------------------------- + -- Malformed_Quantified_Expression -- + ------------------------------------- + + procedure Malformed_Quantified_Expression (N : Node_Id) is + begin + -- Because the error message starts with "missing ALL", we automatically + -- benefit from the associated CODEFIX, which requires that the message + -- is located on the identifier following "for" in order for the CODEFIX + -- to insert "all" in the right place. + + if Present (Iterator_Specification (N)) then + Error_Msg_N -- CODEFIX + ("missing ALL or SOME in quantified expression", + Defining_Identifier (Iterator_Specification (N))); + else + Error_Msg_N -- CODEFIX + ("missing ALL or SOME in quantified expression", + Defining_Identifier (N)); + end if; + end Malformed_Quantified_Expression; + ------------------- -- Operator_Kind -- ------------------- @@ -3221,35 +3243,18 @@ package body Sem_Res is Error_Msg_N ("\use -gnatf for details", N); end if; - -- Recognize the case of a quantified expression being mistaken - -- for an iterated component association because the user - -- forgot the "all" or "some" keyword after "for". Because the - -- error message starts with "missing ALL", we automatically - -- benefit from the associated CODEFIX, which requires that - -- the message is located on the identifier following "for" - -- in order for the CODEFIX to insert "all" in the right place. + -- Diagnose the case of a quantified expression being mistaken + -- for an iterated component association, because the user has + -- forgotten the "all" or "some" keyword after "for". elsif Nkind (N) = N_Aggregate + and then Is_Boolean_Type (Typ) and then List_Length (Component_Associations (N)) = 1 and then Nkind (First (Component_Associations (N))) = N_Iterated_Component_Association - and then Is_Boolean_Type (Typ) then - if Present - (Iterator_Specification - (First (Component_Associations (N)))) - then - Error_Msg_N -- CODEFIX - ("missing ALL or SOME in quantified expression", - Defining_Identifier - (Iterator_Specification - (First (Component_Associations (N))))); - else - Error_Msg_N -- CODEFIX - ("missing ALL or SOME in quantified expression", - Defining_Identifier - (First (Component_Associations (N)))); - end if; + Malformed_Quantified_Expression + (First (Component_Associations (N))); -- For an operator with no interpretation, check whether one of -- its operands may be a user-defined literal. diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads index 54902ac9fce0..b2b84239e36c 100644 --- a/gcc/ada/sem_res.ads +++ b/gcc/ada/sem_res.ads @@ -95,6 +95,10 @@ package Sem_Res is -- interpolated expression; used to improve the clarity of reported -- error messages. + procedure Malformed_Quantified_Expression (N : Node_Id); + -- N is an N_Iterated_Component_Association in a boolean context. Give an + -- error about a malformed quantified expression. + procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id); -- Performs a preanalysis of expression node N. During preanalysis, N is -- analyzed and then resolved against type T, but no expansion is carried @@ -160,10 +164,4 @@ package Sem_Res is Report_Errs : Boolean := True) return Boolean; -- Specific version of Valid_Conversion for when Target_Type is tagged -private - procedure Resolve_Implicit_Type (N : Node_Id) renames Resolve; - pragma Inline (Resolve_Implicit_Type); - -- We use this renaming to make the application of Inline very explicit to - -- this version, since other versions of Resolve are not inlined. - end Sem_Res;
