diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/a-direct.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/comperr.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 670 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-taskin.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/uintp.ads | 4 |
7 files changed, 399 insertions, 312 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90f87dd..61dc3bef 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2012-03-09 Robert Dewar <dewar@adacore.com> + + * a-direct.adb, comperr.adb, freeze.adb: Minor reformatting. + +2012-03-09 Arnaud Charlet <charlet@adacore.com> + + * s-taskin.adb (Initialize_ATCB): Set Task_Image_Len to + 0 so that we never access this field uninitialized (e.g. in + Task_Primitives.Operations.Enter_Task for the environment task). + +2012-03-09 Vincent Pucci <pucci@adacore.com> + + * exp_ch5.adb (Expand_Iterator_Loop): + Call to Expand_Iterator_Loop_Over_Array added. + (Expand_Iterator_Loop_Over_Array): New routine. Expansion of + "of" iterator loop over arrays. Multidimensional array case added. + +2012-03-09 Eric Botcazou <ebotcazou@adacore.com> + + * uintp.ads: Fix minor pasto in comment. + 2012-03-09 Vasiliy Fofanov <fofanov@adacore.com> * a-direct.adb: Do not strip the trailing directory separator diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index 88e1d72..903440b 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -514,10 +514,10 @@ package body Ada.Directories is begin Local_Get_Current_Dir (Buffer'Address, Path_Len'Address); - -- We need to resolve links because of A.16(47), since we must not - -- return alternative names for files - return Normalize_Pathname (Buffer (1 .. Path_Len)); + -- We need to resolve links because of RM A.16(47), which requires + -- that we not return alternative names for files. + return Normalize_Pathname (Buffer (1 .. Path_Len)); end Current_Directory; ---------------------- diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 207beb8..ac620e6 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -502,8 +502,9 @@ package body Comperr is when N_Package_Renaming_Declaration => Unit_Name := Defining_Unit_Name (Main); + -- No SCIL file generated for generic package declarations + when N_Generic_Package_Declaration => - -- No SCIL file generated for generic package declarations return; -- Should never happen, but can be ignored in production diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 2b170a6..6d8e053 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -107,6 +107,9 @@ package body Exp_Ch5 is -- Expand loop over arrays and containers that uses the form "for X of C" -- with an optional subtype mark, or "for Y in C". + procedure Expand_Iterator_Loop_Over_Array (N : Node_Id); + -- Expand loop over arrays that uses the form "for X of C" + procedure Expand_Predicated_Loop (N : Node_Id); -- Expand for loop over predicated subtype @@ -2946,369 +2949,432 @@ package body Exp_Ch5 is -- Processing for arrays if Is_Array_Type (Container_Typ) then + Expand_Iterator_Loop_Over_Array (N); + return; + end if; - -- for Element of Array loop - -- - -- This case requires an internally generated cursor to iterate over - -- the array. + -- Processing for containers - if Of_Present (I_Spec) then - Iterator := Make_Temporary (Loc, 'C'); + -- For an "of" iterator the name is a container expression, which + -- is transformed into a call to the default iterator. - -- Generate: - -- Element : Component_Type renames Container (Iterator); + -- For an iterator of the form "in" the name is a function call + -- that delivers an iterator type. - Prepend_To (Stats, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Id, - Subtype_Mark => - New_Reference_To (Component_Type (Container_Typ), Loc), - Name => - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Container), - Expressions => New_List ( - New_Reference_To (Iterator, Loc))))); + -- In both cases, analysis of the iterator has introduced an object + -- declaration to capture the domain, so that Container is an entity. - -- for Index in Array loop + -- The for loop is expanded into a while loop which uses a container + -- specific cursor to desgnate each element. - -- This case utilizes the already given iterator name + -- Iter : Iterator_Type := Container.Iterate; + -- Cursor : Cursor_type := First (Iter); + -- while Has_Element (Iter) loop + -- declare + -- -- The block is added when Element_Type is controlled + -- Obj : Pack.Element_Type := Element (Cursor); + -- -- for the "of" loop form + -- begin + -- <original loop statements> + -- end; + + -- Cursor := Iter.Next (Cursor); + -- end loop; + + -- If "reverse" is present, then the initialization of the cursor + -- uses Last and the step becomes Prev. Pack is the name of the + -- scope where the container package is instantiated. + + declare + Element_Type : constant Entity_Id := Etype (Id); + Iter_Type : Entity_Id; + Pack : Entity_Id; + Decl : Node_Id; + Name_Init : Name_Id; + Name_Step : Name_Id; + + begin + -- The type of the iterator is the return type of the Iterate + -- function used. For the "of" form this is the default iterator + -- for the type, otherwise it is the type of the explicit + -- function used in the iterator specification. The most common + -- case will be an Iterate function in the container package. + + -- The primitive operations of the container type may not be + -- use-visible, so we introduce the name of the enclosing package + -- in the declarations below. The Iterator type is declared in a + -- an instance within the container package itself. + + -- If the container type is a derived type, the cursor type is + -- found in the package of the parent type. + + if Is_Derived_Type (Container_Typ) then + Pack := Scope (Root_Type (Container_Typ)); else - Iterator := Id; + Pack := Scope (Container_Typ); end if; - -- Generate: - -- for Iterator in [reverse] Container'Range loop - -- Element : Component_Type renames Container (Iterator); - -- -- for the "of" form + Iter_Type := Etype (Name (I_Spec)); - -- <original loop statements> - -- end loop; + -- The "of" case uses an internally generated cursor whose type + -- is found in the container package. The domain of iteration + -- is expanded into a call to the default Iterator function, but + -- this expansion does not take place in quantified expressions + -- that are analyzed with expansion disabled, and in that case the + -- type of the iterator must be obtained from the aspect. - New_Loop := - Make_Loop_Statement (Loc, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Loop_Parameter_Specification => - Make_Loop_Parameter_Specification (Loc, - Defining_Identifier => Iterator, - Discrete_Subtype_Definition => - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Container), - Attribute_Name => Name_Range), - Reverse_Present => Reverse_Present (I_Spec))), - Statements => Stats, - End_Label => Empty); + if Of_Present (I_Spec) then + declare + Default_Iter : constant Entity_Id := + Entity + (Find_Aspect + (Etype (Container), + Aspect_Default_Iterator)); - -- Processing for containers + Container_Arg : Node_Id; + Ent : Entity_Id; - else - -- For an "of" iterator the name is a container expression, which - -- is transformed into a call to the default iterator. + begin + Cursor := Make_Temporary (Loc, 'I'); - -- For an iterator of the form "in" the name is a function call - -- that delivers an iterator type. + -- For an container element iterator, the iterator type + -- is obtained from the corresponding aspect. - -- In both cases, analysis of the iterator has introduced an object - -- declaration to capture the domain, so that Container is an entity. + Iter_Type := Etype (Default_Iter); + Pack := Scope (Iter_Type); - -- The for loop is expanded into a while loop which uses a container - -- specific cursor to desgnate each element. + -- Rewrite domain of iteration as a call to the default + -- iterator for the container type. If the container is + -- a derived type and the aspect is inherited, convert + -- container to parent type. The Cursor type is also + -- inherited from the scope of the parent. - -- Iter : Iterator_Type := Container.Iterate; - -- Cursor : Cursor_type := First (Iter); - -- while Has_Element (Iter) loop - -- declare - -- -- The block is added when Element_Type is controlled + if Base_Type (Etype (Container)) = + Base_Type (Etype (First_Formal (Default_Iter))) + then + Container_Arg := New_Copy_Tree (Container); - -- Obj : Pack.Element_Type := Element (Cursor); - -- -- for the "of" loop form - -- begin - -- <original loop statements> - -- end; + else + Container_Arg := + Make_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of + (Etype (First_Formal (Default_Iter)), Loc), + Expression => New_Copy_Tree (Container)); + end if; - -- Cursor := Iter.Next (Cursor); - -- end loop; + Rewrite (Name (I_Spec), + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Default_Iter, Loc), + Parameter_Associations => + New_List (Container_Arg))); + Analyze_And_Resolve (Name (I_Spec)); + + -- Find cursor type in proper iterator package, which is an + -- instantiation of Iterator_Interfaces. + + Ent := First_Entity (Pack); + while Present (Ent) loop + if Chars (Ent) = Name_Cursor then + Set_Etype (Cursor, Etype (Ent)); + exit; + end if; + Next_Entity (Ent); + end loop; - -- If "reverse" is present, then the initialization of the cursor - -- uses Last and the step becomes Prev. Pack is the name of the - -- scope where the container package is instantiated. + -- Generate: + -- Id : Element_Type renames Container (Cursor); + -- This assumes that the container type has an indexing + -- operation with Cursor. The check that this operation + -- exists is performed in Check_Container_Indexing. + + Decl := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => + New_Reference_To (Element_Type, Loc), + Name => + Make_Indexed_Component (Loc, + Prefix => Relocate_Node (Container_Arg), + Expressions => + New_List (New_Occurrence_Of (Cursor, Loc)))); + + -- If the container holds controlled objects, wrap the loop + -- statements and element renaming declaration with a block. + -- This ensures that the result of Element (Cusor) is + -- cleaned up after each iteration of the loop. + + if Needs_Finalization (Element_Type) then + + -- Generate: + -- declare + -- Id : Element_Type := Element (curosr); + -- begin + -- <original loop statements> + -- end; + + Stats := New_List ( + Make_Block_Statement (Loc, + Declarations => New_List (Decl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stats))); + + -- Elements do not need finalization + + else + Prepend_To (Stats, Decl); + end if; + end; + + -- X in Iterate (S) : type of iterator is type of explicitly + -- given Iterate function, and the loop variable is the cursor. + -- It will be assigned in the loop and must be a variable. + + else + Cursor := Id; + Set_Ekind (Cursor, E_Variable); + end if; + + Iterator := Make_Temporary (Loc, 'I'); + + -- Determine the advancement and initialization steps for the + -- cursor. + + -- Analysis of the expanded loop will verify that the container + -- has a reverse iterator. + + if Reverse_Present (I_Spec) then + Name_Init := Name_Last; + Name_Step := Name_Previous; + + else + Name_Init := Name_First; + Name_Step := Name_Next; + end if; + + -- For both iterator forms, add a call to the step operation to + -- advance the cursor. Generate: + + -- Cursor := Iterator.Next (Cursor); + + -- or else + + -- Cursor := Next (Cursor); declare - Element_Type : constant Entity_Id := Etype (Id); - Iter_Type : Entity_Id; - Pack : Entity_Id; - Decl : Node_Id; - Name_Init : Name_Id; - Name_Step : Name_Id; + Rhs : Node_Id; begin - -- The type of the iterator is the return type of the Iterate - -- function used. For the "of" form this is the default iterator - -- for the type, otherwise it is the type of the explicit - -- function used in the iterator specification. The most common - -- case will be an Iterate function in the container package. - - -- The primitive operations of the container type may not be - -- use-visible, so we introduce the name of the enclosing package - -- in the declarations below. The Iterator type is declared in a - -- an instance within the container package itself. - - -- If the container type is a derived type, the cursor type is - -- found in the package of the parent type. - - if Is_Derived_Type (Container_Typ) then - Pack := Scope (Root_Type (Container_Typ)); - else - Pack := Scope (Container_Typ); - end if; + Rhs := + Make_Function_Call (Loc, + Name => + Make_Selected_Component (Loc, + Prefix => New_Reference_To (Iterator, Loc), + Selector_Name => Make_Identifier (Loc, Name_Step)), + Parameter_Associations => New_List ( + New_Reference_To (Cursor, Loc))); - Iter_Type := Etype (Name (I_Spec)); + Append_To (Stats, + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Cursor, Loc), + Expression => Rhs)); + end; - -- The "of" case uses an internally generated cursor whose type - -- is found in the container package. The domain of iteration - -- is expanded into a call to the default Iterator function, but - -- this expansion does not take place in quantified expressions - -- that are analyzed with expansion disabled, and in that case the - -- type of the iterator must be obtained from the aspect. + -- Generate: + -- while Iterator.Has_Element loop + -- <Stats> + -- end loop; - if Of_Present (I_Spec) then - declare - Default_Iter : constant Entity_Id := - Entity - (Find_Aspect - (Etype (Container), - Aspect_Default_Iterator)); + -- Has_Element is the second actual in the iterator package - Container_Arg : Node_Id; - Ent : Entity_Id; + New_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Occurrence_Of ( + Next_Entity (First_Entity (Pack)), Loc), + Parameter_Associations => + New_List (New_Reference_To (Cursor, Loc)))), + + Statements => Stats, + End_Label => Empty); + + -- Create the declarations for Iterator and cursor and insert them + -- before the source loop. Given that the domain of iteration is + -- already an entity, the iterator is just a renaming of that + -- entity. Possible optimization ??? + -- Generate: - begin - Cursor := Make_Temporary (Loc, 'I'); + -- I : Iterator_Type renames Container; + -- C : Cursor_Type := Container.[First | Last]; - -- For an container element iterator, the iterator type - -- is obtained from the corresponding aspect. + Insert_Action (N, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Iterator, + Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), + Name => Relocate_Node (Name (I_Spec)))); - Iter_Type := Etype (Default_Iter); - Pack := Scope (Iter_Type); + -- Create declaration for cursor - -- Rewrite domain of iteration as a call to the default - -- iterator for the container type. If the container is - -- a derived type and the aspect is inherited, convert - -- container to parent type. The Cursor type is also - -- inherited from the scope of the parent. + declare + Decl : Node_Id; - if Base_Type (Etype (Container)) = - Base_Type (Etype (First_Formal (Default_Iter))) - then - Container_Arg := New_Copy_Tree (Container); + begin + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => + New_Occurrence_Of (Etype (Cursor), Loc), + Expression => + Make_Selected_Component (Loc, + Prefix => New_Reference_To (Iterator, Loc), + Selector_Name => + Make_Identifier (Loc, Name_Init))); - else - Container_Arg := - Make_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of - (Etype (First_Formal (Default_Iter)), Loc), - Expression => New_Copy_Tree (Container)); - end if; + -- The cursor is only modified in expanded code, so it appears + -- as unassigned to the warning machinery. We must suppress + -- this spurious warning explicitly. - Rewrite (Name (I_Spec), - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Default_Iter, Loc), - Parameter_Associations => - New_List (Container_Arg))); - Analyze_And_Resolve (Name (I_Spec)); - - -- Find cursor type in proper iterator package, which is an - -- instantiation of Iterator_Interfaces. - - Ent := First_Entity (Pack); - while Present (Ent) loop - if Chars (Ent) = Name_Cursor then - Set_Etype (Cursor, Etype (Ent)); - exit; - end if; - Next_Entity (Ent); - end loop; + Set_Warnings_Off (Cursor); + Set_Assignment_OK (Decl); - -- Generate: - -- Id : Element_Type renames Container (Cursor); - -- This assumes that the container type has an indexing - -- operation with Cursor. The check that this operation - -- exists is performed in Check_Container_Indexing. - - Decl := - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Id, - Subtype_Mark => - New_Reference_To (Element_Type, Loc), - Name => - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Container_Arg), - Expressions => - New_List (New_Occurrence_Of (Cursor, Loc)))); - - -- If the container holds controlled objects, wrap the loop - -- statements and element renaming declaration with a block. - -- This ensures that the result of Element (Cusor) is - -- cleaned up after each iteration of the loop. - - if Needs_Finalization (Element_Type) then - - -- Generate: - -- declare - -- Id : Element_Type := Element (curosr); - -- begin - -- <original loop statements> - -- end; - - Stats := New_List ( - Make_Block_Statement (Loc, - Declarations => New_List (Decl), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stats))); - - -- Elements do not need finalization + Insert_Action (N, Decl); + end; - else - Prepend_To (Stats, Decl); - end if; - end; + -- If the range of iteration is given by a function call that + -- returns a container, the finalization actions have been saved + -- in the Condition_Actions of the iterator. Insert them now at + -- the head of the loop. - -- X in Iterate (S) : type of iterator is type of explicitly - -- given Iterate function, and the loop variable is the cursor. - -- It will be assigned in the loop and must be a variable. + if Present (Condition_Actions (Isc)) then + Insert_List_Before (N, Condition_Actions (Isc)); + end if; + end; - else - Cursor := Id; - Set_Ekind (Cursor, E_Variable); - end if; + Rewrite (N, New_Loop); + Analyze (N); + end Expand_Iterator_Loop; - Iterator := Make_Temporary (Loc, 'I'); + ------------------------------------- + -- Expand_Iterator_Loop_Over_Array -- + ------------------------------------- + + procedure Expand_Iterator_Loop_Over_Array (N : Node_Id) is + Isc : constant Node_Id := Iteration_Scheme (N); + I_Spec : constant Node_Id := Iterator_Specification (Isc); + Array_Node : constant Node_Id := Name (I_Spec); + Array_Typ : constant Entity_Id := Base_Type (Etype (Array_Node)); + Array_Dim : constant Pos := Number_Dimensions (Array_Typ); + Id : constant Entity_Id := Defining_Identifier (I_Spec); + Loc : constant Source_Ptr := Sloc (N); + Stats : constant List_Id := Statements (N); + Core_Loop : Node_Id; + Ind_Comp : Node_Id; + Iterator : Entity_Id; + + -- Start of processing for Expand_Iterator_Loop_Over_Array - -- Determine the advancement and initialization steps for the - -- cursor. + begin + -- for Element of Array loop - -- Analysis of the expanded loop will verify that the container - -- has a reverse iterator. + -- This case requires an internally generated cursor to iterate over + -- the array. - if Reverse_Present (I_Spec) then - Name_Init := Name_Last; - Name_Step := Name_Previous; + if Of_Present (I_Spec) then + Iterator := Make_Temporary (Loc, 'C'); - else - Name_Init := Name_First; - Name_Step := Name_Next; - end if; + -- Generate: + -- Element : Component_Type renames Array (Iterator); - -- For both iterator forms, add a call to the step operation to - -- advance the cursor. Generate: + Ind_Comp := + Make_Indexed_Component (Loc, + Prefix => Relocate_Node (Array_Node), + Expressions => New_List (New_Reference_To (Iterator, Loc))); - -- Cursor := Iterator.Next (Cursor); + Prepend_To (Stats, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => + New_Reference_To (Component_Type (Array_Typ), Loc), + Name => Ind_Comp)); - -- or else + -- for Index in Array loop - -- Cursor := Next (Cursor); + -- This case utilizes the already given iterator name - declare - Rhs : Node_Id; + else + Iterator := Id; + end if; - begin - Rhs := - Make_Function_Call (Loc, - Name => - Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), - Selector_Name => Make_Identifier (Loc, Name_Step)), - Parameter_Associations => New_List ( - New_Reference_To (Cursor, Loc))); + -- Generate: - Append_To (Stats, - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Cursor, Loc), - Expression => Rhs)); - end; + -- for Iterator in [reverse] Array'Range (Array_Dim) loop + -- Element : Component_Type renames Array (Iterator); + -- <original loop statements> + -- end loop; - -- Generate: - -- while Iterator.Has_Element loop - -- <Stats> - -- end loop; + Core_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Iterator, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Array_Node), + Attribute_Name => Name_Range, + Expressions => New_List ( + Make_Integer_Literal (Loc, Array_Dim))), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => Stats, + End_Label => Empty); + + -- Processing for multidimensional array + + if Array_Dim > 1 then + for Dim in 1 .. Array_Dim - 1 loop + Iterator := Make_Temporary (Loc, 'C'); - -- Has_Element is the second actual in the iterator package + -- Generate the dimension loops starting from the innermost one - New_Loop := + -- for Iterator in [reverse] Array'Range (Array_Dim - Dim) loop + -- <core loop> + -- end loop; + + Core_Loop := Make_Loop_Statement (Loc, Iteration_Scheme => Make_Iteration_Scheme (Loc, - Condition => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of ( - Next_Entity (First_Entity (Pack)), Loc), - Parameter_Associations => - New_List ( - New_Reference_To (Cursor, Loc)))), - - Statements => Stats, - End_Label => Empty); - - -- Create the declarations for Iterator and cursor and insert them - -- before the source loop. Given that the domain of iteration is - -- already an entity, the iterator is just a renaming of that - -- entity. Possible optimization ??? - -- Generate: - - -- I : Iterator_Type renames Container; - -- C : Cursor_Type := Container.[First | Last]; - - Insert_Action (N, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Iterator, - Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), - Name => Relocate_Node (Name (I_Spec)))); - - -- Create declaration for cursor - - declare - Decl : Node_Id; - - begin - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cursor, - Object_Definition => - New_Occurrence_Of (Etype (Cursor), Loc), - Expression => - Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), - Selector_Name => - Make_Identifier (Loc, Name_Init))); - - -- The cursor is only modified in expanded code, so it appears - -- as unassigned to the warning machinery. We must suppress - -- this spurious warning explicitly. - - Set_Warnings_Off (Cursor); - Set_Assignment_OK (Decl); - - Insert_Action (N, Decl); - end; - - -- If the range of iteration is given by a function call that - -- returns a container, the finalization actions have been saved - -- in the Condition_Actions of the iterator. Insert them now at - -- the head of the loop. - - if Present (Condition_Actions (Isc)) then - Insert_List_Before (N, Condition_Actions (Isc)); - end if; - end; + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Iterator, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Array_Node), + Attribute_Name => Name_Range, + Expressions => New_List ( + Make_Integer_Literal (Loc, Array_Dim - Dim))), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => New_List (Core_Loop), + End_Label => Empty); + + -- Update the previously created object renaming declaration with + -- the new iterator. + + Prepend_To (Expressions (Ind_Comp), + New_Reference_To (Iterator, Loc)); + end loop; end if; - Rewrite (N, New_Loop); + Rewrite (N, Core_Loop); Analyze (N); - end Expand_Iterator_Loop; + end Expand_Iterator_Loop_Over_Array; ----------------------------- -- Expand_N_Loop_Statement -- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 51e87ac..fc76000 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2136,8 +2136,7 @@ package body Freeze is (Rec, Attribute_Scalar_Storage_Order); if Present (ADC) - and then - Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) + and then Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) then if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then Error_Msg_N @@ -2147,7 +2146,6 @@ package body Freeze is Error_Msg_N ("Scalar_Storage_Order Low_Order_First is inconsistent with" & " Bit_Order", ADC); - end if; end if; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index 17af062..519626c 100644 --- a/gcc/ada/s-taskin.adb +++ b/gcc/ada/s-taskin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -137,6 +137,7 @@ package body System.Tasking is T.Common.Fall_Back_Handler := null; T.Common.Specific_Handler := null; T.Common.Debug_Events := (others => False); + T.Common.Task_Image_Len := 0; if T.Common.Parent = null then diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index 3886371..41c6ff5 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,7 +32,7 @@ -- Support for universal integer arithmetic -- WARNING: There is a C version of this package. Any changes to this --- source file must be properly reflected in the C header file sinfo.h +-- source file must be properly reflected in the C header file uintp.h with Alloc; with Table; |