===================================================================
@@ -227,7 +227,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id;
-- This recursive routine returns a list of statements containing the
-- loops and assignments that are needed for the expansion of the array
@@ -244,7 +244,7 @@ package body Exp_Aggr is
--
-- Scalar_Comp is True if the component type of the aggregate is scalar.
--
- -- Indices is the current list of expressions used to index the
+ -- Indexes is the current list of expressions used to index the
-- object we are writing into.
--
-- Flist is an expression representing the finalization list on which
@@ -701,7 +701,7 @@ package body Exp_Aggr is
Index : Node_Id;
Into : Node_Id;
Scalar_Comp : Boolean;
- Indices : List_Id := No_List;
+ Indexes : List_Id := No_List;
Flist : Node_Id := Empty) return List_Id
is
Loc : constant Source_Ptr := Sloc (N);
@@ -728,7 +728,7 @@ package body Exp_Aggr is
-- N to Build_Loop contains no sub-aggregates, then this function
-- returns the assignment statement:
--
- -- Into (Indices, Ind) := Expr;
+ -- Into (Indexes, Ind) := Expr;
--
-- Otherwise we call Build_Code recursively
--
@@ -741,7 +741,7 @@ package body Exp_Aggr is
-- This routine returns the for loop statement
--
-- for J in Index_Base'(L) .. Index_Base'(H) loop
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively.
@@ -756,7 +756,7 @@ package body Exp_Aggr is
-- J : Index_Base := L;
-- while J < H loop
-- J := Index_Base'Succ (J);
- -- Into (Indices, J) := Expr;
+ -- Into (Indexes, J) := Expr;
-- end loop;
--
-- Otherwise we call Build_Code recursively
@@ -942,7 +942,7 @@ package body Exp_Aggr is
F : Entity_Id;
A : Node_Id;
- New_Indices : List_Id;
+ New_Indexes : List_Id;
Indexed_Comp : Node_Id;
Expr_Q : Node_Id;
Comp_Type : Entity_Id := Empty;
@@ -982,13 +982,13 @@ package body Exp_Aggr is
-- Start of processing for Gen_Assign
begin
- if No (Indices) then
- New_Indices := New_List;
+ if No (Indexes) then
+ New_Indexes := New_List;
else
- New_Indices := New_Copy_List_Tree (Indices);
+ New_Indexes := New_Copy_List_Tree (Indexes);
end if;
- Append_To (New_Indices, Ind);
+ Append_To (New_Indexes, Ind);
if Present (Flist) then
F := New_Copy_Tree (Flist);
@@ -1014,7 +1014,7 @@ package body Exp_Aggr is
Index => Next_Index (Index),
Into => Into,
Scalar_Comp => Scalar_Comp,
- Indices => New_Indices,
+ Indexes => New_Indexes,
Flist => F));
end if;
@@ -1024,7 +1024,7 @@ package body Exp_Aggr is
Checks_Off
(Make_Indexed_Component (Loc,
Prefix => New_Copy_Tree (Into),
- Expressions => New_Indices));
+ Expressions => New_Indexes));
Set_Assignment_OK (Indexed_Comp);
@@ -1045,7 +1045,7 @@ package body Exp_Aggr is
Comp_Type := Component_Type (Etype (N));
pragma Assert (Comp_Type = Ctype); -- AI-287
- elsif Present (Next (First (New_Indices))) then
+ elsif Present (Next (First (New_Indexes))) then
-- Ada 2005 (AI-287): Do nothing in case of default initialized
-- component because we have received the component type in
@@ -3946,9 +3946,9 @@ package body Exp_Aggr is
exit Component_Loop;
- -- Case of a subtype mark
+ -- Case of a subtype mark, identifier or expanded name
- elsif Nkind (Choice) = N_Identifier
+ elsif Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Lo := Type_Low_Bound (Etype (Choice));
@@ -4217,7 +4217,7 @@ package body Exp_Aggr is
Comp : Node_Id;
Decl : Node_Id;
Typ : constant Entity_Id := Etype (N);
- Indices : constant List_Id := New_List;
+ Indexes : constant List_Id := New_List;
Num : Int;
Sub_Agg : Node_Id;
@@ -4239,7 +4239,7 @@ package body Exp_Aggr is
Next (Comp);
end loop;
- Append_To (Indices,
+ Append_To (Indexes,
Make_Range (Loc,
Low_Bound => Make_Integer_Literal (Loc, 1),
High_Bound => Make_Integer_Literal (Loc, Num)));
@@ -4255,7 +4255,7 @@ package body Exp_Aggr is
Make_Range (Loc,
Low_Bound => Aggr_Low (D),
High_Bound => Aggr_High (D)),
- Indices);
+ Indexes);
end loop;
end if;
@@ -4264,10 +4264,10 @@ package body Exp_Aggr is
Defining_Identifier => Agg_Type,
Type_Definition =>
Make_Constrained_Array_Definition (Loc,
- Discrete_Subtype_Definitions => Indices,
- Component_Definition =>
+ Discrete_Subtype_Definitions => Indexes,
+ Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present => False,
+ Aliased_Present => False,
Subtype_Indication =>
New_Occurrence_Of (Component_Type (Typ), Loc))));
@@ -4940,6 +4940,41 @@ package body Exp_Aggr is
-------------------------
function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+ function Is_Safe_Index (Indx : Node_Id) return Boolean;
+ -- If the left-hand side includes an indexed component, check that
+ -- the indexes are free of side-effect.
+
+ -------------------
+ -- Is_Safe_Index --
+ -------------------
+
+ function Is_Safe_Index (Indx : Node_Id) return Boolean is
+ begin
+ if Is_Entity_Name (Indx) then
+ return True;
+
+ elsif Nkind (Indx) = N_Integer_Literal then
+ return True;
+
+ elsif Nkind (Indx) = N_Function_Call
+ and then Is_Entity_Name (Name (Indx))
+ and then
+ Has_Pragma_Pure_Function (Entity (Name (Indx)))
+ then
+ return True;
+
+ elsif Nkind (Indx) = N_Type_Conversion
+ and then Is_Safe_Index (Expression (Indx))
+ then
+ return True;
+
+ else
+ return False;
+ end if;
+ end Is_Safe_Index;
+
+ -- Start of processing for Safe_Left_Hand_Side
+
begin
if Is_Entity_Name (N) then
return True;
@@ -4952,10 +4987,13 @@ package body Exp_Aggr is
elsif Nkind (N) = N_Indexed_Component
and then Safe_Left_Hand_Side (Prefix (N))
and then
- (Is_Entity_Name (First (Expressions (N)))
- or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+ Is_Safe_Index (First (Expressions (N)))
then
return True;
+
+ elsif Nkind (N) = N_Unchecked_Type_Conversion then
+ return Safe_Left_Hand_Side (Expression (N));
+
else
return False;
end if;
@@ -6101,7 +6139,7 @@ package body Exp_Aggr is
Index => First_Index (Typ),
Into => Target,
Scalar_Comp => Is_Scalar_Type (Component_Type (Typ)),
- Indices => No_List,
+ Indexes => No_List,
Flist => Flist);
end if;
end Late_Expansion;
===================================================================
@@ -5858,6 +5858,11 @@ package body Exp_Ch3 is
Set_TSS (Typ, Fent);
Set_Is_Pure (Fent);
+ -- The Pure flag will be reset is the current context is not pure.
+ -- For optimization purposes and constant-folding, indicate that the
+ -- Rep_To_Pos function can be considered free of side effects.
+
+ Set_Has_Pragma_Pure_Function (Fent);
if not Debug_Generated_Code then
Set_Debug_Info_Off (Fent);