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