Commit 162ea0d3 by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Minor reformattings

2018-05-23  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* exp_disp.adb, freeze.adb, gnat1drv.adb, sem_ch5.adb, sem_spark.adb:
	Minor reformattings.

From-SVN: r260600
parent cd742f4a
2018-05-23 Hristian Kirtchev <kirtchev@adacore.com>
* exp_disp.adb, freeze.adb, gnat1drv.adb, sem_ch5.adb, sem_spark.adb:
Minor reformattings.
2018-05-23 Pascal Obry <obry@adacore.com> 2018-05-23 Pascal Obry <obry@adacore.com>
* adaint.c (win32_wait): Properly free the handle/pid lists when * adaint.c (win32_wait): Properly free the handle/pid lists when
......
...@@ -4493,7 +4493,7 @@ package body Exp_Disp is ...@@ -4493,7 +4493,7 @@ package body Exp_Disp is
Discard_Names : constant Boolean := Discard_Names : constant Boolean :=
Present (No_Tagged_Streams_Pragma (Typ)) Present (No_Tagged_Streams_Pragma (Typ))
and then (Global_Discard_Names and then (Global_Discard_Names
or else Einfo.Discard_Names (Typ)); or else Einfo.Discard_Names (Typ));
-- The following name entries are used by Make_DT to generate a number -- The following name entries are used by Make_DT to generate a number
-- of entities related to a tagged type. These entities may be generated -- of entities related to a tagged type. These entities may be generated
......
...@@ -716,6 +716,7 @@ package body Freeze is ...@@ -716,6 +716,7 @@ package body Freeze is
-- limited objects. -- limited objects.
if Present (Init) and then not Is_Limited_View (Typ) then if Present (Init) and then not Is_Limited_View (Typ) then
-- Capture initialization value at point of declaration, and make -- Capture initialization value at point of declaration, and make
-- explicit assignment legal, because object may be a constant. -- explicit assignment legal, because object may be a constant.
......
...@@ -249,6 +249,7 @@ procedure Gnat1drv is ...@@ -249,6 +249,7 @@ procedure Gnat1drv is
-- Turn off length expansion. CodePeer has its own mechanism to -- Turn off length expansion. CodePeer has its own mechanism to
-- handle length attribute. -- handle length attribute.
Debug_Flag_Dot_PP := True; Debug_Flag_Dot_PP := True;
-- Turn off C tree generation, not compatible with CodePeer mode. We -- Turn off C tree generation, not compatible with CodePeer mode. We
...@@ -257,8 +258,8 @@ procedure Gnat1drv is ...@@ -257,8 +258,8 @@ procedure Gnat1drv is
-- this way when we are doing CodePeer tests on existing test suites -- this way when we are doing CodePeer tests on existing test suites
-- that may have -gnateg set, to avoid the need for special casing. -- that may have -gnateg set, to avoid the need for special casing.
Modify_Tree_For_C := False; Modify_Tree_For_C := False;
Generate_C_Code := False; Generate_C_Code := False;
Unnest_Subprogram_Mode := False; Unnest_Subprogram_Mode := False;
-- Turn off inlining, confuses CodePeer output and gains nothing -- Turn off inlining, confuses CodePeer output and gains nothing
......
...@@ -2058,6 +2058,14 @@ package body Sem_Ch5 is ...@@ -2058,6 +2058,14 @@ package body Sem_Ch5 is
------------------------------------ ------------------------------------
procedure Analyze_Iterator_Specification (N : Node_Id) is procedure Analyze_Iterator_Specification (N : Node_Id) is
Def_Id : constant Node_Id := Defining_Identifier (N);
Iter_Name : constant Node_Id := Name (N);
Loc : constant Source_Ptr := Sloc (N);
Subt : constant Node_Id := Subtype_Indication (N);
Bas : Entity_Id := Empty; -- initialize to prevent warning
Typ : Entity_Id;
procedure Check_Reverse_Iteration (Typ : Entity_Id); procedure Check_Reverse_Iteration (Typ : Entity_Id);
-- For an iteration over a container, if the loop carries the Reverse -- For an iteration over a container, if the loop carries the Reverse
-- indicator, verify that the container type has an Iterate aspect that -- indicator, verify that the container type has an Iterate aspect that
...@@ -2072,16 +2080,6 @@ package body Sem_Ch5 is ...@@ -2072,16 +2080,6 @@ package body Sem_Ch5 is
-- obtained by locating an entity with the proper name in the scope -- obtained by locating an entity with the proper name in the scope
-- of the type. -- of the type.
-- Local variables
Def_Id : constant Node_Id := Defining_Identifier (N);
Iter_Name : constant Node_Id := Name (N);
Loc : constant Source_Ptr := Sloc (N);
Subt : constant Node_Id := Subtype_Indication (N);
Bas : Entity_Id := Empty; -- initialize to prevent warning
Typ : Entity_Id;
----------------------------- -----------------------------
-- Check_Reverse_Iteration -- -- Check_Reverse_Iteration --
----------------------------- -----------------------------
......
...@@ -1042,18 +1042,23 @@ package body Sem_SPARK is ...@@ -1042,18 +1042,23 @@ package body Sem_SPARK is
begin begin
case N_Declaration'(Nkind (Decl)) is case N_Declaration'(Nkind (Decl)) is
when N_Full_Type_Declaration => when N_Full_Type_Declaration =>
-- Nothing to do here ??? NOT TRUE IF CONSTRAINT ON TYPE -- Nothing to do here ??? NOT TRUE IF CONSTRAINT ON TYPE
null; null;
when N_Object_Declaration => when N_Object_Declaration =>
-- First move the right-hand side -- First move the right-hand side
Current_Checking_Mode := Move; Current_Checking_Mode := Move;
Check_Node (Expression (Decl)); Check_Node (Expression (Decl));
declare declare
Elem : Perm_Tree_Access;
Deep : constant Boolean := Deep : constant Boolean :=
Is_Deep (Etype (Defining_Identifier (Decl))); Is_Deep (Etype (Defining_Identifier (Decl)));
Elem : Perm_Tree_Access;
begin begin
Elem := new Perm_Tree_Wrapper' Elem := new Perm_Tree_Wrapper'
(Tree => (Tree =>
...@@ -1064,14 +1069,17 @@ package body Sem_SPARK is ...@@ -1064,14 +1069,17 @@ package body Sem_SPARK is
-- If unitialized declaration, then set to Write_Only. If a -- If unitialized declaration, then set to Write_Only. If a
-- pointer declaration, it has a null default initialization. -- pointer declaration, it has a null default initialization.
if No (Expression (Decl)) if No (Expression (Decl))
and then not Has_Full_Default_Initialization and then not Has_Full_Default_Initialization
(Etype (Defining_Identifier (Decl))) (Etype (Defining_Identifier (Decl)))
and then not Is_Access_Type and then not Is_Access_Type
(Etype (Defining_Identifier (Decl))) (Etype (Defining_Identifier (Decl)))
-- Objects of shallow types are considered as always -- Objects of shallow types are considered as always
-- initialized, leaving the checking of initialization to -- initialized, leaving the checking of initialization to
-- flow analysis. -- flow analysis.
and then Deep and then Deep
then then
Elem.all.Tree.Permission := Write_Only; Elem.all.Tree.Permission := Write_Only;
...@@ -1084,9 +1092,7 @@ package body Sem_SPARK is ...@@ -1084,9 +1092,7 @@ package body Sem_SPARK is
Unique_Entity (Defining_Identifier (Decl)), Unique_Entity (Defining_Identifier (Decl)),
Elem); Elem);
pragma Assert (Get_First (Current_Perm_Env) pragma Assert (Get_First (Current_Perm_Env) /= null);
/= null);
end; end;
when N_Subtype_Declaration => when N_Subtype_Declaration =>
...@@ -2360,7 +2366,7 @@ package body Sem_SPARK is ...@@ -2360,7 +2366,7 @@ package body Sem_SPARK is
| N_Use_Type_Clause | N_Use_Type_Clause
| N_Validate_Unchecked_Conversion | N_Validate_Unchecked_Conversion
| N_Variable_Reference_Marker | N_Variable_Reference_Marker
=> =>
null; null;
-- The following nodes are rewritten by semantic analysis -- The following nodes are rewritten by semantic analysis
...@@ -4240,8 +4246,8 @@ package body Sem_SPARK is ...@@ -4240,8 +4246,8 @@ package body Sem_SPARK is
procedure Process_Path (N : Node_Id) is procedure Process_Path (N : Node_Id) is
Root : constant Entity_Id := Get_Enclosing_Object (N); Root : constant Entity_Id := Get_Enclosing_Object (N);
begin
begin
-- We ignore if yielding to synchronized -- We ignore if yielding to synchronized
if Present (Root) if Present (Root)
...@@ -4609,17 +4615,14 @@ package body Sem_SPARK is ...@@ -4609,17 +4615,14 @@ package body Sem_SPARK is
-- Shallow unaliased parameters and globals cannot introduce pointer -- Shallow unaliased parameters and globals cannot introduce pointer
-- aliasing. -- aliasing.
if not Has_Alias (Id) if not Has_Alias (Id) and then Is_Shallow (Etype (Id)) then
and then Is_Shallow (Etype (Id))
then
null; null;
-- Observed IN parameters and globals need not return a permission to -- Observed IN parameters and globals need not return a permission to
-- the caller. -- the caller.
elsif Mode = E_In_Parameter elsif Mode = E_In_Parameter
and then (not Is_Borrowed_In (Id) and then (not Is_Borrowed_In (Id) or else Global_Var)
or else Global_Var)
then then
null; null;
...@@ -4884,10 +4887,7 @@ package body Sem_SPARK is ...@@ -4884,10 +4887,7 @@ package body Sem_SPARK is
-- Set_Perm_Prefixes_Assign -- -- Set_Perm_Prefixes_Assign --
------------------------------ ------------------------------
function Set_Perm_Prefixes_Assign function Set_Perm_Prefixes_Assign (N : Node_Id) return Perm_Tree_Access is
(N : Node_Id)
return Perm_Tree_Access
is
C : constant Perm_Tree_Access := Get_Perm_Tree (N); C : constant Perm_Tree_Access := Get_Perm_Tree (N);
begin begin
...@@ -4900,7 +4900,9 @@ package body Sem_SPARK is ...@@ -4900,7 +4900,9 @@ package body Sem_SPARK is
case Kind (C) is case Kind (C) is
when Entire_Object => when Entire_Object =>
pragma Assert (Children_Permission (C) = Read_Write); pragma Assert (Children_Permission (C) = Read_Write);
-- Maroua: Children could have read_only perm. Why Read_Write? -- Maroua: Children could have read_only perm. Why Read_Write?
C.all.Tree.Permission := Read_Write; C.all.Tree.Permission := Read_Write;
when Reference => when Reference =>
...@@ -4912,21 +4914,21 @@ package body Sem_SPARK is ...@@ -4912,21 +4914,21 @@ package body Sem_SPARK is
when Array_Component => when Array_Component =>
pragma Assert (C.all.Tree.Get_Elem /= null); pragma Assert (C.all.Tree.Get_Elem /= null);
-- Given that it is not possible to know which element has been -- Given that it is not possible to know which element has been
-- assigned, then the permissions do not get changed in case of -- assigned, then the permissions do not get changed in case of
-- Array_Component. -- Array_Component.
null; null;
when Record_Component => when Record_Component =>
declare declare
Perm : Perm_Kind := Read_Write;
Comp : Perm_Tree_Access; Comp : Perm_Tree_Access;
Perm : Perm_Kind := Read_Write;
begin begin
-- We take the Glb of all the descendants, and then update the -- We take the Glb of all the descendants, and then update the
-- permission of the node with it. -- permission of the node with it.
Comp := Perm_Tree_Maps.Get_First (Component (C)); Comp := Perm_Tree_Maps.Get_First (Component (C));
while Comp /= null loop while Comp /= null loop
Perm := Glb (Perm, Permission (Comp)); Perm := Glb (Perm, Permission (Comp));
...@@ -4940,6 +4942,7 @@ package body Sem_SPARK is ...@@ -4940,6 +4942,7 @@ package body Sem_SPARK is
end case; end case;
case Nkind (N) is case Nkind (N) is
-- Base identifier. End recursion here. -- Base identifier. End recursion here.
when N_Identifier when N_Identifier
...@@ -6212,4 +6215,5 @@ package body Sem_SPARK is ...@@ -6212,4 +6215,5 @@ package body Sem_SPARK is
Next_Formal (Formal); Next_Formal (Formal);
end loop; end loop;
end Setup_Parameters; end Setup_Parameters;
end Sem_SPARK; end Sem_SPARK;
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