From 162ea0d3723af727f60438276be15ab8a47210cc Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Wed, 23 May 2018 10:24:27 +0000 Subject: [PATCH] [Ada] Minor reformattings 2018-05-23 Hristian Kirtchev gcc/ada/ * exp_disp.adb, freeze.adb, gnat1drv.adb, sem_ch5.adb, sem_spark.adb: Minor reformattings. From-SVN: r260600 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/exp_disp.adb | 2 +- gcc/ada/freeze.adb | 1 + gcc/ada/gnat1drv.adb | 5 ++-- gcc/ada/sem_ch5.adb | 18 +++++++-------- gcc/ada/sem_spark.adb | 54 +++++++++++++++++++++++-------------------- 6 files changed, 47 insertions(+), 38 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e44bdc64bc9..ee27de0c2a3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-05-23 Hristian Kirtchev + + * exp_disp.adb, freeze.adb, gnat1drv.adb, sem_ch5.adb, sem_spark.adb: + Minor reformattings. + 2018-05-23 Pascal Obry * adaint.c (win32_wait): Properly free the handle/pid lists when diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index bded4c1dc52..0d674e7bcf9 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6643c5c26b0..1e634e1ca96 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 70330abd5be..06b55366499 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b8a222a0ba3..0da972a9519 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 -- ----------------------------- diff --git a/gcc/ada/sem_spark.adb b/gcc/ada/sem_spark.adb index ac04bc93a6c..3abfd99ae87 100644 --- a/gcc/ada/sem_spark.adb +++ b/gcc/ada/sem_spark.adb @@ -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 - Perm : Perm_Kind := Read_Write; - Comp : Perm_Tree_Access; + Perm : Perm_Kind := Read_Write; 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; -- 2.30.2