Commit 1985767d by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Minor reformatting

2018-06-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_ch9.adb, exp_unst.adb, inline.adb, libgnat/a-ciorma.adb,
	libgnat/a-ciormu.adb, libgnat/a-ciorse.adb, libgnat/a-coorma.adb,
	libgnat/a-coormu.adb, libgnat/a-coorse.adb, sem_prag.adb: Minor
	reformatting.

From-SVN: r261429
parent ed6a6b4e
2018-06-11 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb, exp_unst.adb, inline.adb, libgnat/a-ciorma.adb,
libgnat/a-ciormu.adb, libgnat/a-ciorse.adb, libgnat/a-coorma.adb,
libgnat/a-coormu.adb, libgnat/a-coorse.adb, sem_prag.adb: Minor
reformatting.
2018-06-11 Gary Dismukes <dismukes@adacore.com> 2018-06-11 Gary Dismukes <dismukes@adacore.com>
* exp_unst.ads, exp_unst.adb: Typo fixes and minor reformatting. * exp_unst.ads, exp_unst.adb: Typo fixes and minor reformatting.
......
...@@ -8653,8 +8653,9 @@ package body Exp_Ch9 is ...@@ -8653,8 +8653,9 @@ package body Exp_Ch9 is
when N_Implicit_Label_Declaration => when N_Implicit_Label_Declaration =>
null; null;
when N_Call_Marker | when N_Call_Marker
N_Itype_Reference => | N_Itype_Reference
=>
New_Op_Body := New_Copy (Op_Body); New_Op_Body := New_Copy (Op_Body);
Insert_After (Current_Node, New_Op_Body); Insert_After (Current_Node, New_Op_Body);
Current_Node := New_Op_Body; Current_Node := New_Op_Body;
......
...@@ -99,14 +99,9 @@ package body Exp_Unst is ...@@ -99,14 +99,9 @@ package body Exp_Unst is
-- table already contains this entry and if so it has no effect. -- table already contains this entry and if so it has no effect.
---------------------------------- ----------------------------------
-- subprograms for fat pointers -- -- Subprograms For Fat Pointers --
---------------------------------- ----------------------------------
function Needs_Fat_Pointer (E : Entity_Id) return Boolean;
-- A formal parameter of an unconstrained array type that appears in
-- an uplevel reference requires the construction of an access type,
-- to be used in the corresponding component declaration.
function Build_Access_Type_Decl function Build_Access_Type_Decl
(E : Entity_Id; (E : Entity_Id;
Scop : Entity_Id) return Node_Id; Scop : Entity_Id) return Node_Id;
...@@ -115,6 +110,11 @@ package body Exp_Unst is ...@@ -115,6 +110,11 @@ package body Exp_Unst is
-- record component. The relevant attributes of the access type are -- record component. The relevant attributes of the access type are
-- set here to avoid a full analysis that would require a scope stack. -- set here to avoid a full analysis that would require a scope stack.
function Needs_Fat_Pointer (E : Entity_Id) return Boolean;
-- A formal parameter of an unconstrained array type that appears in an
-- uplevel reference requires the construction of an access type, to be
-- used in the corresponding component declaration.
----------- -----------
-- Urefs -- -- Urefs --
----------- -----------
...@@ -169,17 +169,6 @@ package body Exp_Unst is ...@@ -169,17 +169,6 @@ package body Exp_Unst is
Calls.Append (Call); Calls.Append (Call);
end Append_Unique_Call; end Append_Unique_Call;
-----------------------
-- Needs_Fat_Pointer --
-----------------------
function Needs_Fat_Pointer (E : Entity_Id) return Boolean is
begin
return Is_Formal (E)
and then Is_Array_Type (Etype (E))
and then not Is_Constrained (Etype (E));
end Needs_Fat_Pointer;
----------------------------- -----------------------------
-- Build_Access_Type_Decl -- -- Build_Access_Type_Decl --
----------------------------- -----------------------------
...@@ -188,9 +177,8 @@ package body Exp_Unst is ...@@ -188,9 +177,8 @@ package body Exp_Unst is
(E : Entity_Id; (E : Entity_Id;
Scop : Entity_Id) return Node_Id Scop : Entity_Id) return Node_Id
is is
Loc : constant Source_Ptr := Sloc (E); Loc : constant Source_Ptr := Sloc (E);
Decl : Node_Id; Typ : Entity_Id;
Typ : Entity_Id;
begin begin
Typ := Make_Temporary (Loc, 'S'); Typ := Make_Temporary (Loc, 'S');
...@@ -199,12 +187,12 @@ package body Exp_Unst is ...@@ -199,12 +187,12 @@ package body Exp_Unst is
Set_Scope (Typ, Scop); Set_Scope (Typ, Scop);
Set_Directly_Designated_Type (Typ, Etype (E)); Set_Directly_Designated_Type (Typ, Etype (E));
Decl := Make_Full_Type_Declaration (Loc, return
Defining_Identifier => Typ, Make_Full_Type_Declaration (Loc,
Type_Definition => Make_Access_To_Object_Definition (Loc, Defining_Identifier => Typ,
Subtype_Indication => New_Occurrence_Of (Etype (E), Loc))); Type_Definition =>
Make_Access_To_Object_Definition (Loc,
return Decl; Subtype_Indication => New_Occurrence_Of (Etype (E), Loc)));
end Build_Access_Type_Decl; end Build_Access_Type_Decl;
--------------- ---------------
...@@ -247,6 +235,17 @@ package body Exp_Unst is ...@@ -247,6 +235,17 @@ package body Exp_Unst is
return False; return False;
end In_Synchronized_Unit; end In_Synchronized_Unit;
-----------------------
-- Needs_Fat_Pointer --
-----------------------
function Needs_Fat_Pointer (E : Entity_Id) return Boolean is
begin
return Is_Formal (E)
and then Is_Array_Type (Etype (E))
and then not Is_Constrained (Etype (E));
end Needs_Fat_Pointer;
---------------- ----------------
-- Subp_Index -- -- Subp_Index --
---------------- ----------------
...@@ -815,7 +814,7 @@ package body Exp_Unst is ...@@ -815,7 +814,7 @@ package body Exp_Unst is
-- handled as an entity reference. -- handled as an entity reference.
if Nkind (N) = N_Allocator if Nkind (N) = N_Allocator
and then Nkind (Expression (N)) = N_Qualified_Expression and then Nkind (Expression (N)) = N_Qualified_Expression
then then
declare declare
DT : Boolean := False; DT : Boolean := False;
...@@ -1559,22 +1558,23 @@ package body Exp_Unst is ...@@ -1559,22 +1558,23 @@ package body Exp_Unst is
-- Local declarations for one such subprogram -- Local declarations for one such subprogram
declare declare
Loc : constant Source_Ptr := Sloc (STJ.Bod); Loc : constant Source_Ptr := Sloc (STJ.Bod);
Decls : constant List_Id := New_List;
-- List of new declarations we create
Clist : List_Id; Clist : List_Id;
Comp : Entity_Id; Comp : Entity_Id;
Decl_Assign : Node_Id;
-- Assigment to set uplink, Empty if none
Decl_ARECnT : Node_Id; Decl_ARECnT : Node_Id;
Decl_ARECnPT : Node_Id; Decl_ARECnPT : Node_Id;
Decl_ARECn : Node_Id; Decl_ARECn : Node_Id;
Decl_ARECnP : Node_Id; Decl_ARECnP : Node_Id;
-- Declaration nodes for the AREC entities we build -- Declaration nodes for the AREC entities we build
Decl_Assign : Node_Id;
-- Assigment to set uplink, Empty if none
Decls : constant List_Id := New_List;
-- List of new declarations we create
begin begin
-- Build list of component declarations for ARECnT -- Build list of component declarations for ARECnT
...@@ -1647,7 +1647,7 @@ package body Exp_Unst is ...@@ -1647,7 +1647,7 @@ package body Exp_Unst is
Subtype_Indication => Subtype_Indication =>
New_Occurrence_Of New_Occurrence_Of
(Defining_Identifier (Ptr_Decl), (Defining_Identifier (Ptr_Decl),
Loc)))); Loc))));
else else
Append_To (Clist, Append_To (Clist,
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
...@@ -1711,7 +1711,7 @@ package body Exp_Unst is ...@@ -1711,7 +1711,7 @@ package body Exp_Unst is
New_Occurrence_Of (STJ.ARECnPT, Loc), New_Occurrence_Of (STJ.ARECnPT, Loc),
Expression => Expression =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
New_Occurrence_Of (STJ.ARECn, Loc), New_Occurrence_Of (STJ.ARECn, Loc),
Attribute_Name => Name_Access)); Attribute_Name => Name_Access));
Append_To (Decls, Decl_ARECnP); Append_To (Decls, Decl_ARECnP);
...@@ -1786,16 +1786,17 @@ package body Exp_Unst is ...@@ -1786,16 +1786,17 @@ package body Exp_Unst is
Loc : constant Source_Ptr := Sloc (Ent); Loc : constant Source_Ptr := Sloc (Ent);
Dec : constant Node_Id := Dec : constant Node_Id :=
Declaration_Node (Ent); Declaration_Node (Ent);
Ins : Node_Id;
Asn : Node_Id; Asn : Node_Id;
Attr : Name_Id; Attr : Name_Id;
Ins : Node_Id;
begin begin
-- For parameters, we insert the assignment -- For parameters, we insert the assignment
-- right after the declaration of ARECnP. -- right after the declaration of ARECnP.
-- For all other entities, we insert -- For all other entities, we insert
-- the assignment immediately after -- the assignment immediately after the
-- the declaration of the entity. -- declaration of the entity.
-- Note: we don't need to mark the entity -- Note: we don't need to mark the entity
-- as being aliased, because the address -- as being aliased, because the address
...@@ -2224,9 +2225,9 @@ package body Exp_Unst is ...@@ -2224,9 +2225,9 @@ package body Exp_Unst is
end; end;
end if; end if;
-- The proper body of a stub may contain nested subprograms, -- The proper body of a stub may contain nested subprograms, and
-- and therefore must be visited explicitly. Nested stubs are -- therefore must be visited explicitly. Nested stubs are examined
-- examined recursively in Visit_Node. -- recursively in Visit_Node.
if Nkind (N) in N_Body_Stub then if Nkind (N) in N_Body_Stub then
Do_Search (Library_Unit (N)); Do_Search (Library_Unit (N));
......
...@@ -900,8 +900,8 @@ package body Inline is ...@@ -900,8 +900,8 @@ package body Inline is
function Uses_Secondary_Stack (Bod : Node_Id) return Boolean; function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
-- If the body of the subprogram includes a call that returns an -- If the body of the subprogram includes a call that returns an
-- unconstrained type, the secondary stack is involved, and it -- unconstrained type, the secondary stack is involved, and it is
-- is not worth inlining. -- not worth inlining.
------------------------- -------------------------
-- Has_Extended_Return -- -- Has_Extended_Return --
......
...@@ -541,9 +541,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -541,9 +541,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
"Position cursor of function Element is bad"; "Position cursor of function Element is bad";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -545,9 +545,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -545,9 +545,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
raise Program_Error with "Position cursor is bad"; raise Program_Error with "Position cursor is bad";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -534,9 +534,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -534,9 +534,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error with "Position cursor is bad"; raise Program_Error with "Position cursor is bad";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -481,9 +481,10 @@ package body Ada.Containers.Ordered_Maps is ...@@ -481,9 +481,10 @@ package body Ada.Containers.Ordered_Maps is
"Position cursor of function Element equals No_Element"; "Position cursor of function Element equals No_Element";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -502,9 +502,10 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -502,9 +502,10 @@ package body Ada.Containers.Ordered_Multisets is
raise Constraint_Error with "Position cursor equals No_Element"; raise Constraint_Error with "Position cursor equals No_Element";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -480,9 +480,10 @@ package body Ada.Containers.Ordered_Sets is ...@@ -480,9 +480,10 @@ package body Ada.Containers.Ordered_Sets is
raise Constraint_Error with "Position cursor equals No_Element"; raise Constraint_Error with "Position cursor equals No_Element";
end if; end if;
if Checks and then if Checks
(Left (Position.Node) = Position.Node and then (Left (Position.Node) = Position.Node
or else Right (Position.Node) = Position.Node) or else
Right (Position.Node) = Position.Node)
then then
raise Program_Error with "dangling cursor"; raise Program_Error with "dangling cursor";
end if; end if;
......
...@@ -2499,12 +2499,12 @@ package body Sem_Prag is ...@@ -2499,12 +2499,12 @@ package body Sem_Prag is
end if; end if;
if (Is_Subprogram (Context) if (Is_Subprogram (Context)
or else Ekind (Context) = E_Task_Type or else Ekind (Context) = E_Task_Type
or else Is_Single_Task_Object (Context)) or else Is_Single_Task_Object (Context))
and then and then
(Present (Get_Pragma (Context, Pragma_Global)) (Present (Get_Pragma (Context, Pragma_Global))
or else or else
Present (Get_Pragma (Context, Pragma_Refined_Global))) Present (Get_Pragma (Context, Pragma_Refined_Global)))
then then
Collect_Subprogram_Inputs_Outputs Collect_Subprogram_Inputs_Outputs
(Subp_Id => Context, (Subp_Id => Context,
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