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.
Tested on x86-64/Linux, applied on the mainline.
2026-09-23 Eric Botcazou <[email protected]>
* 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.
--
Eric Botcazoudiff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index e8490bc503e..661aa6beef3 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 29ef2a46a44..827192ace38 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 1bea0d6a600..078e32c42a1 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 54902ac9fce..b2b84239e36 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;
