Skip to content

R
riscv-gcc-1
Commit d3a26d5d by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r185143
parent f91510fc
Showing with 399 additions and 312 deletions
gcc/ada/ChangeLog
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> 2012-03-09 Vasiliy Fofanov <fofanov@adacore.com>
* a-direct.adb: Do not strip the trailing directory separator * a-direct.adb: Do not strip the trailing directory separator
......
gcc/ada/a-direct.adb
...@@ -514,10 +514,10 @@ package body Ada.Directories is ...@@ -514,10 +514,10 @@ package body Ada.Directories is
begin begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address); Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
-- We need to resolve links because of A.16(47), since we must not -- We need to resolve links because of RM A.16(47), which requires
-- return alternative names for files -- that we not return alternative names for files.
return Normalize_Pathname (Buffer (1 .. Path_Len));
return Normalize_Pathname (Buffer (1 .. Path_Len));
end Current_Directory; end Current_Directory;
---------------------- ----------------------
......
gcc/ada/comperr.adb
...@@ -502,8 +502,9 @@ package body Comperr is ...@@ -502,8 +502,9 @@ package body Comperr is
when N_Package_Renaming_Declaration => when N_Package_Renaming_Declaration =>
Unit_Name := Defining_Unit_Name (Main); Unit_Name := Defining_Unit_Name (Main);
-- No SCIL file generated for generic package declarations
when N_Generic_Package_Declaration => when N_Generic_Package_Declaration =>
-- No SCIL file generated for generic package declarations
return; return;
-- Should never happen, but can be ignored in production -- Should never happen, but can be ignored in production
......
gcc/ada/exp_ch5.adb
...@@ -107,6 +107,9 @@ package body Exp_Ch5 is ...@@ -107,6 +107,9 @@ package body Exp_Ch5 is
-- Expand loop over arrays and containers that uses the form "for X of C" -- Expand loop over arrays and containers that uses the form "for X of C"
-- with an optional subtype mark, or "for Y in 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); procedure Expand_Predicated_Loop (N : Node_Id);
-- Expand for loop over predicated subtype -- Expand for loop over predicated subtype
...@@ -2946,369 +2949,432 @@ package body Exp_Ch5 is ...@@ -2946,369 +2949,432 @@ package body Exp_Ch5 is
-- Processing for arrays -- Processing for arrays
if Is_Array_Type (Container_Typ) then if Is_Array_Type (Container_Typ) then
Expand_Iterator_Loop_Over_Array (N);
return;
end if;
-- for Element of Array loop -- Processing for containers
--
-- This case requires an internally generated cursor to iterate over
-- the array.
if Of_Present (I_Spec) then -- For an "of" iterator the name is a container expression, which
Iterator := Make_Temporary (Loc, 'C'); -- is transformed into a call to the default iterator.
-- Generate: -- For an iterator of the form "in" the name is a function call
-- Element : Component_Type renames Container (Iterator); -- that delivers an iterator type.
Prepend_To (Stats, -- In both cases, analysis of the iterator has introduced an object
Make_Object_Renaming_Declaration (Loc, -- declaration to capture the domain, so that Container is an entity.
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)))));
-- 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 else
Iterator := Id; Pack := Scope (Container_Typ);
end if; end if;
-- Generate: Iter_Type := Etype (Name (I_Spec));
-- for Iterator in [reverse] Container'Range loop
-- Element : Component_Type renames Container (Iterator);
-- -- for the "of" form
-- <original loop statements> -- The "of" case uses an internally generated cursor whose type
-- end loop; -- 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 := if Of_Present (I_Spec) then
Make_Loop_Statement (Loc, declare
Iteration_Scheme => Default_Iter : constant Entity_Id :=
Make_Iteration_Scheme (Loc, Entity
Loop_Parameter_Specification => (Find_Aspect
Make_Loop_Parameter_Specification (Loc, (Etype (Container),
Defining_Identifier => Iterator, Aspect_Default_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);
-- Processing for containers Container_Arg : Node_Id;
Ent : Entity_Id;
else begin
-- For an "of" iterator the name is a container expression, which Cursor := Make_Temporary (Loc, 'I');
-- is transformed into a call to the default iterator.
-- For an iterator of the form "in" the name is a function call -- For an container element iterator, the iterator type
-- that delivers an iterator type. -- is obtained from the corresponding aspect.
-- In both cases, analysis of the iterator has introduced an object Iter_Type := Etype (Default_Iter);
-- declaration to capture the domain, so that Container is an entity. Pack := Scope (Iter_Type);
-- The for loop is expanded into a while loop which uses a container -- Rewrite domain of iteration as a call to the default
-- specific cursor to desgnate each element. -- 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; if Base_Type (Etype (Container)) =
-- Cursor : Cursor_type := First (Iter); Base_Type (Etype (First_Formal (Default_Iter)))
-- while Has_Element (Iter) loop then
-- declare Container_Arg := New_Copy_Tree (Container);
-- -- The block is added when Element_Type is controlled
-- Obj : Pack.Element_Type := Element (Cursor); else
-- -- for the "of" loop form Container_Arg :=
-- begin Make_Type_Conversion (Loc,
-- <original loop statements> Subtype_Mark =>
-- end; New_Occurrence_Of
(Etype (First_Formal (Default_Iter)), Loc),
Expression => New_Copy_Tree (Container));
end if;
-- Cursor := Iter.Next (Cursor); Rewrite (Name (I_Spec),
-- end loop; 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 -- Generate:
-- uses Last and the step becomes Prev. Pack is the name of the -- Id : Element_Type renames Container (Cursor);
-- scope where the container package is instantiated. -- 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 declare
Element_Type : constant Entity_Id := Etype (Id); Rhs : Node_Id;
Iter_Type : Entity_Id;
Pack : Entity_Id;
Decl : Node_Id;
Name_Init : Name_Id;
Name_Step : Name_Id;
begin begin
-- The type of the iterator is the return type of the Iterate Rhs :=
-- function used. For the "of" form this is the default iterator Make_Function_Call (Loc,
-- for the type, otherwise it is the type of the explicit Name =>
-- function used in the iterator specification. The most common Make_Selected_Component (Loc,
-- case will be an Iterate function in the container package. Prefix => New_Reference_To (Iterator, Loc),
Selector_Name => Make_Identifier (Loc, Name_Step)),
-- The primitive operations of the container type may not be Parameter_Associations => New_List (
-- use-visible, so we introduce the name of the enclosing package New_Reference_To (Cursor, Loc)));
-- 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;
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 -- Generate:
-- is found in the container package. The domain of iteration -- while Iterator.Has_Element loop
-- is expanded into a call to the default Iterator function, but -- <Stats>
-- this expansion does not take place in quantified expressions -- end loop;
-- that are analyzed with expansion disabled, and in that case the
-- type of the iterator must be obtained from the aspect.
if Of_Present (I_Spec) then -- Has_Element is the second actual in the iterator package
declare
Default_Iter : constant Entity_Id :=
Entity
(Find_Aspect
(Etype (Container),
Aspect_Default_Iterator));
Container_Arg : Node_Id; New_Loop :=
Ent : Entity_Id; 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 -- I : Iterator_Type renames Container;
Cursor := Make_Temporary (Loc, 'I'); -- C : Cursor_Type := Container.[First | Last];
-- For an container element iterator, the iterator type Insert_Action (N,
-- is obtained from the corresponding aspect. 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); -- Create declaration for cursor
Pack := Scope (Iter_Type);
-- Rewrite domain of iteration as a call to the default declare
-- iterator for the container type. If the container is Decl : Node_Id;
-- 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.
if Base_Type (Etype (Container)) = begin
Base_Type (Etype (First_Formal (Default_Iter))) Decl :=
then Make_Object_Declaration (Loc,
Container_Arg := New_Copy_Tree (Container); 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 -- The cursor is only modified in expanded code, so it appears
Container_Arg := -- as unassigned to the warning machinery. We must suppress
Make_Type_Conversion (Loc, -- this spurious warning explicitly.
Subtype_Mark =>
New_Occurrence_Of
(Etype (First_Formal (Default_Iter)), Loc),
Expression => New_Copy_Tree (Container));
end if;
Rewrite (Name (I_Spec), Set_Warnings_Off (Cursor);
Make_Function_Call (Loc, Set_Assignment_OK (Decl);
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;
-- Generate: Insert_Action (N, Decl);
-- Id : Element_Type renames Container (Cursor); end;
-- 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 -- If the range of iteration is given by a function call that
Prepend_To (Stats, Decl); -- returns a container, the finalization actions have been saved
end if; -- in the Condition_Actions of the iterator. Insert them now at
end; -- the head of the loop.
-- X in Iterate (S) : type of iterator is type of explicitly if Present (Condition_Actions (Isc)) then
-- given Iterate function, and the loop variable is the cursor. Insert_List_Before (N, Condition_Actions (Isc));
-- It will be assigned in the loop and must be a variable. end if;
end;
else Rewrite (N, New_Loop);
Cursor := Id; Analyze (N);
Set_Ekind (Cursor, E_Variable); end Expand_Iterator_Loop;
end if;
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 begin
-- cursor. -- for Element of Array loop
-- Analysis of the expanded loop will verify that the container -- This case requires an internally generated cursor to iterate over
-- has a reverse iterator. -- the array.
if Reverse_Present (I_Spec) then if Of_Present (I_Spec) then
Name_Init := Name_Last; Iterator := Make_Temporary (Loc, 'C');
Name_Step := Name_Previous;
else -- Generate:
Name_Init := Name_First; -- Element : Component_Type renames Array (Iterator);
Name_Step := Name_Next;
end if;
-- For both iterator forms, add a call to the step operation to Ind_Comp :=
-- advance the cursor. Generate: 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 else
Rhs : Node_Id; Iterator := Id;
end if;
begin -- Generate:
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)));
Append_To (Stats, -- for Iterator in [reverse] Array'Range (Array_Dim) loop
Make_Assignment_Statement (Loc, -- Element : Component_Type renames Array (Iterator);
Name => New_Occurrence_Of (Cursor, Loc), -- <original loop statements>
Expression => Rhs)); -- end loop;
end;
-- Generate: Core_Loop :=
-- while Iterator.Has_Element loop Make_Loop_Statement (Loc,
-- <Stats> Iteration_Scheme =>
-- end loop; 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, Make_Loop_Statement (Loc,
Iteration_Scheme => Iteration_Scheme =>
Make_Iteration_Scheme (Loc, Make_Iteration_Scheme (Loc,
Condition => Loop_Parameter_Specification =>
Make_Function_Call (Loc, Make_Loop_Parameter_Specification (Loc,
Name => Defining_Identifier => Iterator,
New_Occurrence_Of ( Discrete_Subtype_Definition =>
Next_Entity (First_Entity (Pack)), Loc), Make_Attribute_Reference (Loc,
Parameter_Associations => Prefix => Relocate_Node (Array_Node),
New_List ( Attribute_Name => Name_Range,
New_Reference_To (Cursor, Loc)))), Expressions => New_List (
Make_Integer_Literal (Loc, Array_Dim - Dim))),
Statements => Stats, Reverse_Present => Reverse_Present (I_Spec))),
End_Label => Empty); Statements => New_List (Core_Loop),
End_Label => Empty);
-- Create the declarations for Iterator and cursor and insert them
-- before the source loop. Given that the domain of iteration is -- Update the previously created object renaming declaration with
-- already an entity, the iterator is just a renaming of that -- the new iterator.
-- entity. Possible optimization ???
-- Generate: Prepend_To (Expressions (Ind_Comp),
New_Reference_To (Iterator, Loc));
-- I : Iterator_Type renames Container; end loop;
-- 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;
end if; end if;
Rewrite (N, New_Loop); Rewrite (N, Core_Loop);
Analyze (N); Analyze (N);
end Expand_Iterator_Loop; end Expand_Iterator_Loop_Over_Array;
----------------------------- -----------------------------
-- Expand_N_Loop_Statement -- -- Expand_N_Loop_Statement --
......
gcc/ada/freeze.adb
...@@ -2136,8 +2136,7 @@ package body Freeze is ...@@ -2136,8 +2136,7 @@ package body Freeze is
(Rec, Attribute_Scalar_Storage_Order); (Rec, Attribute_Scalar_Storage_Order);
if Present (ADC) if Present (ADC)
and then and then Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
then then
if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
Error_Msg_N Error_Msg_N
...@@ -2147,7 +2146,6 @@ package body Freeze is ...@@ -2147,7 +2146,6 @@ package body Freeze is
Error_Msg_N Error_Msg_N
("Scalar_Storage_Order Low_Order_First is inconsistent with" ("Scalar_Storage_Order Low_Order_First is inconsistent with"
& " Bit_Order", ADC); & " Bit_Order", ADC);
end if; end if;
end if; end if;
......
gcc/ada/s-taskin.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -137,6 +137,7 @@ package body System.Tasking is ...@@ -137,6 +137,7 @@ package body System.Tasking is
T.Common.Fall_Back_Handler := null; T.Common.Fall_Back_Handler := null;
T.Common.Specific_Handler := null; T.Common.Specific_Handler := null;
T.Common.Debug_Events := (others => False); T.Common.Debug_Events := (others => False);
T.Common.Task_Image_Len := 0;
if T.Common.Parent = null then if T.Common.Parent = null then
......
gcc/ada/uintp.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,7 +32,7 @@ ...@@ -32,7 +32,7 @@
-- Support for universal integer arithmetic -- Support for universal integer arithmetic
-- WARNING: There is a C version of this package. Any changes to this -- 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 Alloc;
with Table; with Table;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment