Commit f672a756 by Arnaud Charlet

[multiple changes]

2011-09-27  Pascal Obry  <obry@adacore.com>

	* s-taspri-posix-noaltstack.ads (RW_Lock): This type is now defined as
	OS_Interface.pthread_rwlock_t.

2011-09-27  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb, a-cimutr.adb, a-cimutr.ads, gnat1drv.adb, a-comutr.adb,
	a-comutr.ads, exp_dist.adb, a-cbmutr.adb, a-cbmutr.ads,
	sem_ch5.adb, sem_util.adb: Minor reformatting.

From-SVN: r179252
parent 7a44cb69
2011-09-27 Pascal Obry <obry@adacore.com> 2011-09-27 Pascal Obry <obry@adacore.com>
* s-taspri-posix-noaltstack.ads (RW_Lock): This type is now defined as
OS_Interface.pthread_rwlock_t.
2011-09-27 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, a-cimutr.adb, a-cimutr.ads, gnat1drv.adb, a-comutr.adb,
a-comutr.ads, exp_dist.adb, a-cbmutr.adb, a-cbmutr.ads,
sem_ch5.adb, sem_util.adb: Minor reformatting.
2011-09-27 Pascal Obry <obry@adacore.com>
* s-taprop.ads (Initialize_Lock)[RW_Lock]: New spec for r/w lock. * s-taprop.ads (Initialize_Lock)[RW_Lock]: New spec for r/w lock.
(Finalize_Lock)[RW_Lock]: Likewise. (Finalize_Lock)[RW_Lock]: Likewise.
(Write_Lock)[RW_Lock]: Likewise. (Write_Lock)[RW_Lock]: Likewise.
......
...@@ -1741,15 +1741,10 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1741,15 +1741,10 @@ package body Ada.Containers.Bounded_Multiway_Trees is
begin begin
return return
Iterator'(Container'Unrestricted_Access, Iterator'(Container'Unrestricted_Access,
First_Child (Root_Cursor), From_Root => True); First_Child (Root_Cursor),
From_Root => True);
end Iterate; end Iterate;
function Iterate_Subtree (Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
---------------------- ----------------------
-- Iterate_Children -- -- Iterate_Children --
---------------------- ----------------------
...@@ -1818,6 +1813,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1818,6 +1813,14 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- Iterate_Subtree -- -- Iterate_Subtree --
--------------------- ---------------------
function Iterate_Subtree
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
procedure Iterate_Subtree procedure Iterate_Subtree
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Position : Cursor)) Process : not null access procedure (Position : Cursor))
...@@ -1841,7 +1844,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1841,7 +1844,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
if Is_Root (Position) then if Is_Root (Position) then
Iterate_Children (T, Position.Node, Process); Iterate_Children (T, Position.Node, Process);
else else
Iterate_Subtree (T, Position.Node, Process); Iterate_Subtree (T, Position.Node, Process);
end if; end if;
...@@ -1938,7 +1940,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1938,7 +1940,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
begin begin
if Is_Leaf (Position) then if Is_Leaf (Position) then
-- If sibling is present, return it. -- If sibling is present, return it
if N.Next /= 0 then if N.Next /= 0 then
return (Object.Container, N.Next); return (Object.Container, N.Next);
...@@ -1955,7 +1957,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1955,7 +1957,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
while Par.Next = 0 loop while Par.Next = 0 loop
Pos := Par.Parent; Pos := Par.Parent;
-- If we are back at the root the iteration is complete. -- If we are back at the root the iteration is complete
if Pos = No_Node then if Pos = No_Node then
return No_Element; return No_Element;
...@@ -1983,10 +1985,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1983,10 +1985,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
end; end;
end if; end if;
else -- If an internal node, return its first child
-- If an internal node, return its first child.
else
return (Object.Container, N.Children.First); return (Object.Container, N.Children.First);
end if; end if;
end Next; end Next;
...@@ -2351,9 +2352,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -2351,9 +2352,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type Position : Cursor) return Constant_Reference_Type
is is
begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
begin
return return
(Element => (Element =>
Position.Container.Elements (Position.Node)'Unchecked_Access); Position.Container.Elements (Position.Node)'Unchecked_Access);
...@@ -2363,9 +2363,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -2363,9 +2363,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) return Reference_Type Position : Cursor) return Reference_Type
is is
begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
begin
return return
(Element => (Element =>
Position.Container.Elements (Position.Node)'Unchecked_Access); Position.Container.Elements (Position.Node)'Unchecked_Access);
......
...@@ -377,13 +377,11 @@ private ...@@ -377,13 +377,11 @@ private
function Constant_Reference function Constant_Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Constant_Reference_Type;
return Constant_Reference_Type;
function Reference function Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Reference_Type;
return Reference_Type;
Empty_Tree : constant Tree := (Capacity => 0, others => <>); Empty_Tree : constant Tree := (Capacity => 0, others => <>);
......
...@@ -1309,15 +1309,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1309,15 +1309,10 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
begin begin
return return
Iterator'(Container'Unrestricted_Access, Iterator'(Container'Unrestricted_Access,
First_Child (Root_Cursor), From_Root => True); First_Child (Root_Cursor),
From_Root => True);
end Iterate; end Iterate;
function Iterate_Subtree (Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
---------------------- ----------------------
-- Iterate_Children -- -- Iterate_Children --
---------------------- ----------------------
...@@ -1378,6 +1373,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1378,6 +1373,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
-- Iterate_Subtree -- -- Iterate_Subtree --
--------------------- ---------------------
function Iterate_Subtree
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
procedure Iterate_Subtree procedure Iterate_Subtree
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Position : Cursor)) Process : not null access procedure (Position : Cursor))
...@@ -1498,7 +1501,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1498,7 +1501,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
begin begin
if Is_Leaf (Position) then if Is_Leaf (Position) then
-- If sibling is present, return it. -- If sibling is present, return it
if N.Next /= null then if N.Next /= null then
return (Object.Container, N.Next); return (Object.Container, N.Next);
...@@ -1513,7 +1516,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1513,7 +1516,7 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
begin begin
while Par.Next = null loop while Par.Next = null loop
-- If we are back at the root the iteration is complete. -- If we are back at the root the iteration is complete
if Par = Root_Node (T) then if Par = Root_Node (T) then
return No_Element; return No_Element;
...@@ -1541,10 +1544,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1541,10 +1544,9 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
end; end;
end if; end if;
else -- If an internal node, return its first child
-- If an internal node, return its first child.
else
return (Object.Container, N.Children.First); return (Object.Container, N.Children.First);
end if; end if;
end Next; end Next;
......
...@@ -397,13 +397,11 @@ private ...@@ -397,13 +397,11 @@ private
function Constant_Reference function Constant_Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Constant_Reference_Type;
return Constant_Reference_Type;
function Reference function Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Reference_Type;
return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>); Empty_Tree : constant Tree := (Controlled with others => <>);
......
...@@ -1352,15 +1352,10 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1352,15 +1352,10 @@ package body Ada.Containers.Multiway_Trees is
begin begin
return return
Iterator'(Container'Unrestricted_Access, Iterator'(Container'Unrestricted_Access,
First_Child (Root_Cursor), From_Root => True); First_Child (Root_Cursor),
From_Root => True);
end Iterate; end Iterate;
function Iterate_Subtree (Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
---------------------- ----------------------
-- Iterate_Children -- -- Iterate_Children --
---------------------- ----------------------
...@@ -1421,6 +1416,14 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1421,6 +1416,14 @@ package body Ada.Containers.Multiway_Trees is
-- Iterate_Subtree -- -- Iterate_Subtree --
--------------------- ---------------------
function Iterate_Subtree
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
begin
return Iterator'(Position.Container, Position, From_Root => False);
end Iterate_Subtree;
procedure Iterate_Subtree procedure Iterate_Subtree
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Position : Cursor)) Process : not null access procedure (Position : Cursor))
...@@ -1438,7 +1441,6 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1438,7 +1441,6 @@ package body Ada.Containers.Multiway_Trees is
if Is_Root (Position) then if Is_Root (Position) then
Iterate_Children (Position.Container, Position.Node, Process); Iterate_Children (Position.Container, Position.Node, Process);
else else
Iterate_Subtree (Position.Container, Position.Node, Process); Iterate_Subtree (Position.Container, Position.Node, Process);
end if; end if;
......
...@@ -442,13 +442,11 @@ private ...@@ -442,13 +442,11 @@ private
function Constant_Reference function Constant_Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Constant_Reference_Type;
return Constant_Reference_Type;
function Reference function Reference
(Container : aliased Tree; (Container : aliased Tree;
Position : Cursor) Position : Cursor) return Reference_Type;
return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>); Empty_Tree : constant Tree := (Controlled with others => <>);
......
...@@ -1690,7 +1690,7 @@ package body Exp_Ch9 is ...@@ -1690,7 +1690,7 @@ package body Exp_Ch9 is
-- The parameter that designates the synchronized object in the call -- The parameter that designates the synchronized object in the call
Actuals : constant List_Id := New_List; Actuals : constant List_Id := New_List;
-- the actuals in the entry call -- The actuals in the entry call
Decls : constant List_Id := New_List; Decls : constant List_Id := New_List;
...@@ -8337,7 +8337,7 @@ package body Exp_Ch9 is ...@@ -8337,7 +8337,7 @@ package body Exp_Ch9 is
Insert_After (Current_Node, Sub); Insert_After (Current_Node, Sub);
Analyze (Sub); Analyze (Sub);
-- build wrapper procedure for pre/postconditions -- Build wrapper procedure for pre/postconditions
Build_PPC_Wrapper (Comp_Id, N); Build_PPC_Wrapper (Comp_Id, N);
...@@ -10618,9 +10618,11 @@ package body Exp_Ch9 is ...@@ -10618,9 +10618,11 @@ package body Exp_Ch9 is
if Present (Taskdef) if Present (Taskdef)
and then Has_Storage_Size_Pragma (Taskdef) and then Has_Storage_Size_Pragma (Taskdef)
and then and then
Is_Static_Expression (Expression (First ( Is_Static_Expression
Pragma_Argument_Associations (Find_Task_Or_Protected_Pragma ( (Expression
Taskdef, Name_Storage_Size))))) (First (Pragma_Argument_Associations
(Find_Task_Or_Protected_Pragma
(Taskdef, Name_Storage_Size)))))
then then
Size_Decl := Size_Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -10628,18 +10630,19 @@ package body Exp_Ch9 is ...@@ -10628,18 +10630,19 @@ package body Exp_Ch9 is
Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc), Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc),
Expression => Expression =>
Convert_To (RTE (RE_Size_Type), Convert_To (RTE (RE_Size_Type),
Relocate_Node ( Relocate_Node
Expression (First ( (Expression (First (Pragma_Argument_Associations
Pragma_Argument_Associations ( (Find_Task_Or_Protected_Pragma
Find_Task_Or_Protected_Pragma
(Taskdef, Name_Storage_Size))))))); (Taskdef, Name_Storage_Size)))))));
else else
Size_Decl := Size_Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => Storage_Size_Variable (Tasktyp), Defining_Identifier => Storage_Size_Variable (Tasktyp),
Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc), Object_Definition =>
Expression => New_Reference_To (RTE (RE_Unspecified_Size), Loc)); New_Reference_To (RTE (RE_Size_Type), Loc),
Expression =>
New_Reference_To (RTE (RE_Unspecified_Size), Loc));
end if; end if;
Insert_After (Elab_Decl, Size_Decl); Insert_After (Elab_Decl, Size_Decl);
...@@ -10673,8 +10676,8 @@ package body Exp_Ch9 is ...@@ -10673,8 +10676,8 @@ package body Exp_Ch9 is
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => True, Aliased_Present => True,
Subtype_Indication => Make_Subtype_Indication (Loc, Subtype_Indication => Make_Subtype_Indication (Loc,
Subtype_Mark => New_Occurrence_Of Subtype_Mark =>
(RTE (RE_Ada_Task_Control_Block), Loc), New_Occurrence_Of (RTE (RE_Ada_Task_Control_Block), Loc),
Constraint => Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc, Make_Index_Or_Discriminant_Constraint (Loc,
......
...@@ -11075,7 +11075,6 @@ package body Exp_Dist is ...@@ -11075,7 +11075,6 @@ package body Exp_Dist is
function RPC_Receiver_Decl (RACW_Type : Entity_Id) return Node_Id is function RPC_Receiver_Decl (RACW_Type : Entity_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (RACW_Type); Loc : constant Source_Ptr := Sloc (RACW_Type);
begin begin
return return
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
......
...@@ -474,10 +474,12 @@ procedure Gnat1drv is ...@@ -474,10 +474,12 @@ procedure Gnat1drv is
Warning_Mode := Suppress; Warning_Mode := Suppress;
-- Suppress the generation of name tables for enumerations -- Suppress the generation of name tables for enumerations
-- why???
Global_Discard_Names := True; Global_Discard_Names := True;
-- Suppress the expansion of tagged types and dispatching calls -- Suppress the expansion of tagged types and dispatching calls
-- why???
Tagged_Type_Expansion := False; Tagged_Type_Expansion := False;
end if; end if;
......
...@@ -80,7 +80,7 @@ package System.Task_Primitives is ...@@ -80,7 +80,7 @@ package System.Task_Primitives is
private private
type Lock is new System.OS_Interface.pthread_mutex_t; type Lock is new System.OS_Interface.pthread_mutex_t;
type RW_Lock is new Lock; type RW_Lock is new System.OS_Interface.pthread_rwlock_t;
type RTS_Lock is new System.OS_Interface.pthread_mutex_t; type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
type Suspension_Object is record type Suspension_Object is record
......
...@@ -2302,8 +2302,9 @@ package body Sem_Ch5 is ...@@ -2302,8 +2302,9 @@ package body Sem_Ch5 is
Typ : Entity_Id; Typ : Entity_Id;
begin begin
-- In semantics and Alfa modes, introduce loop variable so that loop -- In semantics/Alfa modes, we won't be further expanding the loop, so
-- body can be properly analyzed. Otherwise this is one after expansion. -- introduce loop variable so that loop body can be properly analyzed.
-- Otherwise this happens after expansion.
if Operating_Mode = Check_Semantics if Operating_Mode = Check_Semantics
or else Alfa_Mode or else Alfa_Mode
......
...@@ -2274,9 +2274,9 @@ package body Sem_Util is ...@@ -2274,9 +2274,9 @@ package body Sem_Util is
is is
Comp : Node_Id; Comp : Node_Id;
Comps : constant List_Id := New_List; Comps : constant List_Id := New_List;
begin begin
Comp := First_Component (Underlying_Type (R_Typ)); Comp := First_Component (Underlying_Type (R_Typ));
while Present (Comp) loop while Present (Comp) loop
if Comes_From_Source (Comp) then if Comes_From_Source (Comp) then
declare declare
...@@ -2291,6 +2291,7 @@ package body Sem_Util is ...@@ -2291,6 +2291,7 @@ package body Sem_Util is
(Component_Definition (Comp_Decl), New_Sloc => Loc))); (Component_Definition (Comp_Decl), New_Sloc => Loc)));
end; end;
end if; end if;
Next_Component (Comp); Next_Component (Comp);
end loop; end loop;
......
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