+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.
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
Root_Cursor : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
+ (Container'Unrestricted_Access, Root_Node (Container));
begin
return
Iterator'(Container'Unrestricted_Access,
- First_Child (Root_Cursor), From_Root => True);
+ First_Child (Root_Cursor),
+ From_Root => True);
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_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
(Position : Cursor;
Process : not null access procedure (Position : Cursor))
if Is_Root (Position) then
Iterate_Children (T, Position.Node, Process);
-
else
Iterate_Subtree (T, Position.Node, Process);
end if;
begin
if Is_Leaf (Position) then
- -- If sibling is present, return it.
+ -- If sibling is present, return it
if N.Next /= 0 then
return (Object.Container, N.Next);
while Par.Next = 0 loop
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
return No_Element;
end;
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);
end if;
end Next;
(Container : aliased Tree;
Position : Cursor) return Constant_Reference_Type
is
- begin
pragma Unreferenced (Container);
-
+ begin
return
(Element =>
- Position.Container.Elements (Position.Node)'Unchecked_Access);
+ Position.Container.Elements (Position.Node)'Unchecked_Access);
end Constant_Reference;
function Reference
(Container : aliased Tree;
Position : Cursor) return Reference_Type
is
- begin
pragma Unreferenced (Container);
-
+ begin
return
(Element =>
- Position.Container.Elements (Position.Node)'Unchecked_Access);
+ Position.Container.Elements (Position.Node)'Unchecked_Access);
end Reference;
--------------------
function Constant_Reference
(Container : aliased Tree;
- Position : Cursor)
- return Constant_Reference_Type;
+ Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
- Position : Cursor)
- return Reference_Type;
+ Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Capacity => 0, others => <>);
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
Root_Cursor : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
+ (Container'Unrestricted_Access, Root_Node (Container));
begin
return
Iterator'(Container'Unrestricted_Access,
- First_Child (Root_Cursor), From_Root => True);
+ First_Child (Root_Cursor),
+ From_Root => True);
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_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
(Position : Cursor;
Process : not null access procedure (Position : Cursor))
begin
if Is_Leaf (Position) then
- -- If sibling is present, return it.
+ -- If sibling is present, return it
if N.Next /= null then
return (Object.Container, N.Next);
begin
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
return No_Element;
end;
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);
end if;
end Next;
function Constant_Reference
(Container : aliased Tree;
- Position : Cursor)
- return Constant_Reference_Type;
+ Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
- Position : Cursor)
- return Reference_Type;
+ Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>);
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
Root_Cursor : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
+ (Container'Unrestricted_Access, Root_Node (Container));
begin
return
Iterator'(Container'Unrestricted_Access,
- First_Child (Root_Cursor), From_Root => True);
+ First_Child (Root_Cursor),
+ From_Root => True);
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_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
(Position : Cursor;
Process : not null access procedure (Position : Cursor))
if Is_Root (Position) then
Iterate_Children (Position.Container, Position.Node, Process);
-
else
Iterate_Subtree (Position.Container, Position.Node, Process);
end if;
function Constant_Reference
(Container : aliased Tree;
- Position : Cursor)
- return Constant_Reference_Type;
+ Position : Cursor) return Constant_Reference_Type;
function Reference
(Container : aliased Tree;
- Position : Cursor)
- return Reference_Type;
+ Position : Cursor) return Reference_Type;
Empty_Tree : constant Tree := (Controlled with others => <>);
-- The parameter that designates the synchronized object in the call
Actuals : constant List_Id := New_List;
- -- the actuals in the entry call
+ -- The actuals in the entry call
Decls : constant List_Id := New_List;
Insert_After (Current_Node, Sub);
Analyze (Sub);
- -- build wrapper procedure for pre/postconditions
+ -- Build wrapper procedure for pre/postconditions
Build_PPC_Wrapper (Comp_Id, N);
if Present (Taskdef)
and then Has_Storage_Size_Pragma (Taskdef)
and then
- Is_Static_Expression (Expression (First (
- Pragma_Argument_Associations (Find_Task_Or_Protected_Pragma (
- Taskdef, Name_Storage_Size)))))
+ Is_Static_Expression
+ (Expression
+ (First (Pragma_Argument_Associations
+ (Find_Task_Or_Protected_Pragma
+ (Taskdef, Name_Storage_Size)))))
then
Size_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Storage_Size_Variable (Tasktyp),
- Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc),
- Expression =>
+ Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc),
+ Expression =>
Convert_To (RTE (RE_Size_Type),
- Relocate_Node (
- Expression (First (
- Pragma_Argument_Associations (
- Find_Task_Or_Protected_Pragma
- (Taskdef, Name_Storage_Size)))))));
+ Relocate_Node
+ (Expression (First (Pragma_Argument_Associations
+ (Find_Task_Or_Protected_Pragma
+ (Taskdef, Name_Storage_Size)))))));
else
Size_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Storage_Size_Variable (Tasktyp),
- Object_Definition => New_Reference_To (RTE (RE_Size_Type), Loc),
- Expression => New_Reference_To (RTE (RE_Unspecified_Size), Loc));
+ Object_Definition =>
+ New_Reference_To (RTE (RE_Size_Type), Loc),
+ Expression =>
+ New_Reference_To (RTE (RE_Unspecified_Size), Loc));
end if;
Insert_After (Elab_Decl, Size_Decl);
Append_To (Cdecls,
Make_Component_Declaration (Loc,
- Defining_Identifier =>
+ Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Id),
Component_Definition =>
Make_Component_Definition (Loc,
Make_Component_Definition (Loc,
Aliased_Present => True,
Subtype_Indication => Make_Subtype_Indication (Loc,
- Subtype_Mark => New_Occurrence_Of
- (RTE (RE_Ada_Task_Control_Block), Loc),
+ Subtype_Mark =>
+ New_Occurrence_Of (RTE (RE_Ada_Task_Control_Block), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
function RPC_Receiver_Decl (RACW_Type : Entity_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (RACW_Type);
-
begin
return
Make_Object_Declaration (Loc,
Warning_Mode := Suppress;
-- Suppress the generation of name tables for enumerations
+ -- why???
Global_Discard_Names := True;
-- Suppress the expansion of tagged types and dispatching calls
+ -- why???
Tagged_Type_Expansion := False;
end if;
private
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 Suspension_Object is record
Typ : Entity_Id;
begin
- -- In semantics and Alfa modes, introduce loop variable so that loop
- -- body can be properly analyzed. Otherwise this is one after expansion.
+ -- In semantics/Alfa modes, we won't be further expanding the loop, so
+ -- introduce loop variable so that loop body can be properly analyzed.
+ -- Otherwise this happens after expansion.
if Operating_Mode = Check_Semantics
or else Alfa_Mode
is
Comp : Node_Id;
Comps : constant List_Id := New_List;
+
begin
Comp := First_Component (Underlying_Type (R_Typ));
-
while Present (Comp) loop
if Comes_From_Source (Comp) then
declare
(Component_Definition (Comp_Decl), New_Sloc => Loc)));
end;
end if;
+
Next_Component (Comp);
end loop;
projects / gcc.git / commitdiff