[Ada] Fix internal error on predicate aspect with iterator
Commit Message
The semantic analysis of predicates involves a fair amount of tree
copying because of both semantic and implementation considerations, and
there is a difficulty with quantified expressions since they declare a
new entity that cannot be shared between the various copies of the tree.
This change implements a specific processing for it in New_Copy_Tree
that subsumes a couple of fixes made earlier for variants of the issue.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.ads (Is_Entity_Of_Quantified_Expression): Declare.
* sem_util.adb (Is_Entity_Of_Quantified_Expression): New
predicate.
(New_Copy_Tree): Deal with all entities of quantified
expressions.
* sem_ch13.adb (Build_Predicate_Functions): Get rid of
superfluous tree copying and remove obsolete code.
* sem_ch6.adb (Fully_Conformant_Expressions): Deal with all
entities of quantified expressions.
@@ -10231,16 +10231,13 @@ package body Sem_Ch13 is
Set_SCO_Pragma_Enabled (Sloc (Prag));
- -- Extract the arguments of the pragma. The expression itself
- -- is copied for use in the predicate function, to preserve the
- -- original version for ASIS use.
- -- Is this still needed???
+ -- Extract the arguments of the pragma
Arg1 := First (Pragma_Argument_Associations (Prag));
Arg2 := Next (Arg1);
Arg1 := Get_Pragma_Arg (Arg1);
- Arg2 := New_Copy_Tree (Get_Pragma_Arg (Arg2));
+ Arg2 := Get_Pragma_Arg (Arg2);
-- When the predicate pragma applies to the current type or its
-- full view, replace all occurrences of the subtype name with
@@ -10455,45 +10452,12 @@ package body Sem_Ch13 is
if Raise_Expression_Present then
declare
- function Reset_Loop_Variable
- (N : Node_Id) return Traverse_Result;
-
- procedure Reset_Loop_Variables is
- new Traverse_Proc (Reset_Loop_Variable);
-
- ------------------------
- -- Reset_Loop_Variable --
- ------------------------
-
- function Reset_Loop_Variable
- (N : Node_Id) return Traverse_Result
- is
- begin
- if Nkind (N) = N_Iterator_Specification then
- Set_Defining_Identifier (N,
- Make_Defining_Identifier
- (Sloc (N), Chars (Defining_Identifier (N))));
- end if;
-
- return OK;
- end Reset_Loop_Variable;
-
- -- Local variables
-
Map : constant Elist_Id := New_Elmt_List;
begin
Append_Elmt (Object_Entity, Map);
Append_Elmt (Object_Entity_M, Map);
Expr_M := New_Copy_Tree (Expr, Map => Map);
-
- -- The unanalyzed expression will be copied and appear in
- -- both functions. Normally expressions do not declare new
- -- entities, but quantified expressions do, so we need to
- -- create new entities for their bound variables, to prevent
- -- multiple definitions in gigi.
-
- Reset_Loop_Variables (Expr_M);
end;
end if;
@@ -10106,14 +10106,13 @@ package body Sem_Ch6 is
and then Discriminal_Link (Entity (E1)) =
Discriminal_Link (Entity (E2)))
- -- AI12-050: The loop variables of quantified expressions match
- -- if they have the same identifier, even though they may have
- -- different entities.
+ -- AI12-050: The entities of quantified expressions match if they
+ -- have the same identifier, even if they may be distinct nodes.
or else
(Chars (Entity (E1)) = Chars (Entity (E2))
- and then Ekind (Entity (E1)) = E_Loop_Parameter
- and then Ekind (Entity (E2)) = E_Loop_Parameter)
+ and then Is_Entity_Of_Quantified_Expression (Entity (E1))
+ and then Is_Entity_Of_Quantified_Expression (Entity (E2)))
-- A call to an instantiation of Unchecked_Conversion is
-- rewritten with the name of the generated function created for
@@ -17624,6 +17624,21 @@ package body Sem_Util is
end if;
end Is_Effectively_Volatile_Object_Shared;
+ ----------------------------------------
+ -- Is_Entity_Of_Quantified_Expression --
+ ----------------------------------------
+
+ function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean
+ is
+ Par : constant Node_Id := Parent (Id);
+
+ begin
+ return (Nkind (Par) = N_Loop_Parameter_Specification
+ or else Nkind (Par) = N_Iterator_Specification)
+ and then Defining_Identifier (Par) = Id
+ and then Nkind (Parent (Par)) = N_Quantified_Expression;
+ end Is_Entity_Of_Quantified_Expression;
+
-------------------
-- Is_Entry_Body --
-------------------
@@ -24622,22 +24637,20 @@ package body Sem_Util is
-- ??? this list is flaky, and may hide dormant bugs
-- Should functions be included???
- -- Loop parameters appear within quantified expressions and contain
- -- an entity declaration that must be replaced when the expander is
- -- active if the expression has been preanalyzed or analyzed.
+ -- Quantified expressions contain an entity declaration that must
+ -- always be replaced when the expander is active, even if it has
+ -- not been analyzed yet like e.g. in predicates.
- elsif Ekind (Id) not in
- E_Block | E_Constant | E_Label | E_Loop_Parameter |
- E_Procedure | E_Variable
+ elsif Ekind (Id) not in E_Block
+ | E_Constant
+ | E_Label
+ | E_Procedure
+ | E_Variable
+ and then not Is_Entity_Of_Quantified_Expression (Id)
and then not Is_Type (Id)
then
return;
- elsif Ekind (Id) = E_Loop_Parameter
- and then No (Etype (Condition (Parent (Parent (Id)))))
- then
- return;
-
-- Nothing to do when the entity was already visited
elsif NCT_Tables_In_Use
@@ -24661,9 +24674,12 @@ package body Sem_Util is
New_Id := New_Copy (Id);
-- Create a new name for the new entity because the back end needs
- -- distinct names for debugging purposes.
+ -- distinct names for debugging purposes, provided that the entity
+ -- has already been analyzed.
- Set_Chars (New_Id, New_Internal_Name ('T'));
+ if Ekind (Id) /= E_Void then
+ Set_Chars (New_Id, New_Internal_Name ('T'));
+ end if;
-- Update the Comes_From_Source and Sloc attributes of the entity in
-- case the caller has supplied new values.
@@ -2055,6 +2055,9 @@ package Sem_Util is
-- Determine whether an arbitrary node denotes an effectively volatile
-- object for reading (SPARK RM 7.1.2).
+ function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean;
+ -- Determine whether entity Id is the entity of a quantified expression
+
function Is_Entry_Body (Id : Entity_Id) return Boolean;
-- Determine whether entity Id is the body entity of an entry [family]