Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 165755) +++ exp_aggr.adb (working copy) @@ -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; Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 165755) +++ exp_ch3.adb (working copy) @@ -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);