From ef952fd5e9cfb61e2be7be053fc0d26f87c75040 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Fri, 28 Apr 2017 13:26:33 +0000 Subject: [PATCH] exp_util.adb, [...]: Minor reformatting. 2017-04-28 Hristian Kirtchev * exp_util.adb, g-dyntab.adb, par-ch4.adb, sem_util.adb, sem_attr.adb, gnat1drv.adb, exp_disp.adb, namet.adb, alloc.ads: Minor reformatting. From-SVN: r247383 --- gcc/ada/ChangeLog | 5 ++++ gcc/ada/alloc.ads | 76 ++++++++++++++++++++++++++-------------------------- gcc/ada/exp_disp.adb | 45 ++++++++++++++++++------------- gcc/ada/exp_util.adb | 6 ++--- gcc/ada/g-dyntab.adb | 7 +++-- gcc/ada/gnat1drv.adb | 46 ++++++++++++++++--------------- gcc/ada/namet.adb | 11 ++++---- gcc/ada/par-ch4.adb | 2 +- gcc/ada/sem_attr.adb | 29 ++++++++++---------- gcc/ada/sem_util.adb | 1 + 10 files changed, 125 insertions(+), 103 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index edbf44e..6997493 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2017-04-28 Hristian Kirtchev + + * exp_util.adb, g-dyntab.adb, par-ch4.adb, sem_util.adb, sem_attr.adb, + gnat1drv.adb, exp_disp.adb, namet.adb, alloc.ads: Minor reformatting. + 2017-04-28 Gary Dismukes * exp_util.adb: Minor reformatting. diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index 74885fd..380ea2c 100644 --- a/gcc/ada/alloc.ads +++ b/gcc/ada/alloc.ads @@ -43,122 +43,122 @@ package Alloc is -- The comment shows the unit in which the table is defined - All_Interp_Initial : constant := 1_000; -- Sem_Type + All_Interp_Initial : constant := 1_000; -- Sem_Type All_Interp_Increment : constant := 100; - Branches_Initial : constant := 1_000; -- Sem_Warn + Branches_Initial : constant := 1_000; -- Sem_Warn Branches_Increment : constant := 100; - Conditionals_Initial : constant := 1_000; -- Sem_Warn + Conditionals_Initial : constant := 1_000; -- Sem_Warn Conditionals_Increment : constant := 100; - Conditional_Stack_Initial : constant := 50; -- Sem_Warn + Conditional_Stack_Initial : constant := 50; -- Sem_Warn Conditional_Stack_Increment : constant := 100; - Elists_Initial : constant := 200; -- Elists + Elists_Initial : constant := 200; -- Elists Elists_Increment : constant := 100; - Elmts_Initial : constant := 1_200; -- Elists + Elmts_Initial : constant := 1_200; -- Elists Elmts_Increment : constant := 100; - File_Name_Chars_Initial : constant := 10_000; -- Osint + File_Name_Chars_Initial : constant := 10_000; -- Osint File_Name_Chars_Increment : constant := 100; - In_Out_Warnings_Initial : constant := 100; -- Sem_Warn + In_Out_Warnings_Initial : constant := 100; -- Sem_Warn In_Out_Warnings_Increment : constant := 100; - Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util + Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util Ignored_Ghost_Units_Increment : constant := 50; - Inlined_Initial : constant := 100; -- Inline + Inlined_Initial : constant := 100; -- Inline Inlined_Increment : constant := 100; - Inlined_Bodies_Initial : constant := 50; -- Inline + Inlined_Bodies_Initial : constant := 50; -- Inline Inlined_Bodies_Increment : constant := 200; - Interp_Map_Initial : constant := 200; -- Sem_Type + Interp_Map_Initial : constant := 200; -- Sem_Type Interp_Map_Increment : constant := 100; - Lines_Initial : constant := 500; -- Sinput + Lines_Initial : constant := 500; -- Sinput Lines_Increment : constant := 150; - Linker_Option_Lines_Initial : constant := 5; -- Lib + Linker_Option_Lines_Initial : constant := 5; -- Lib Linker_Option_Lines_Increment : constant := 200; - Lists_Initial : constant := 4_000; -- Nlists + Lists_Initial : constant := 4_000; -- Nlists Lists_Increment : constant := 200; - Load_Stack_Initial : constant := 10; -- Lib + Load_Stack_Initial : constant := 10; -- Lib Load_Stack_Increment : constant := 100; - Name_Chars_Initial : constant := 50_000; -- Namet + Name_Chars_Initial : constant := 50_000; -- Namet Name_Chars_Increment : constant := 100; - Name_Qualify_Units_Initial : constant := 200; -- Exp_Dbug + Name_Qualify_Units_Initial : constant := 200; -- Exp_Dbug Name_Qualify_Units_Increment : constant := 300; - Names_Initial : constant := 6_000; -- Namet + Names_Initial : constant := 6_000; -- Namet Names_Increment : constant := 100; Nodes_Initial : constant := 5_000_000; -- Atree Nodes_Increment : constant := 100; Nodes_Release_Threshold : constant := 100_000; - Notes_Initial : constant := 100; -- Lib + Notes_Initial : constant := 100; -- Lib Notes_Increment : constant := 200; - Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag + Obsolescent_Warnings_Initial : constant := 50; -- Sem_Prag Obsolescent_Warnings_Increment : constant := 200; - Pending_Instantiations_Initial : constant := 10; -- Inline + Pending_Instantiations_Initial : constant := 10; -- Inline Pending_Instantiations_Increment : constant := 100; - Rep_Table_Initial : constant := 1000; -- Repinfo + Rep_Table_Initial : constant := 1000; -- Repinfo Rep_Table_Increment : constant := 200; - Scope_Stack_Initial : constant := 10; -- Sem + Scope_Stack_Initial : constant := 10; -- Sem Scope_Stack_Increment : constant := 200; - SFN_Table_Initial : constant := 10; -- Fname + SFN_Table_Initial : constant := 10; -- Fname SFN_Table_Increment : constant := 200; - Source_File_Initial : constant := 10; -- Sinput + Source_File_Initial : constant := 10; -- Sinput Source_File_Increment : constant := 200; - String_Chars_Initial : constant := 2_500; -- Stringt + String_Chars_Initial : constant := 2_500; -- Stringt String_Chars_Increment : constant := 150; - Strings_Initial : constant := 5_00; -- Stringt + Strings_Initial : constant := 5_00; -- Stringt Strings_Increment : constant := 150; - Successors_Initial : constant := 2_00; -- Inline + Successors_Initial : constant := 2_00; -- Inline Successors_Increment : constant := 100; - Udigits_Initial : constant := 10_000; -- Uintp + Udigits_Initial : constant := 10_000; -- Uintp Udigits_Increment : constant := 100; - Uints_Initial : constant := 5_000; -- Uintp + Uints_Initial : constant := 5_000; -- Uintp Uints_Increment : constant := 100; - Units_Initial : constant := 30; -- Lib + Units_Initial : constant := 30; -- Lib Units_Increment : constant := 100; - Ureals_Initial : constant := 200; -- Urealp + Ureals_Initial : constant := 200; -- Urealp Ureals_Increment : constant := 100; - Unreferenced_Entities_Initial : constant := 1_000; -- Sem_Warn + Unreferenced_Entities_Initial : constant := 1_000; -- Sem_Warn Unreferenced_Entities_Increment : constant := 100; - Warnings_Off_Pragmas_Initial : constant := 500; -- Sem_Warn + Warnings_Off_Pragmas_Initial : constant := 500; -- Sem_Warn Warnings_Off_Pragmas_Increment : constant := 100; - With_List_Initial : constant := 10; -- Features + With_List_Initial : constant := 10; -- Features With_List_Increment : constant := 300; - Xrefs_Initial : constant := 5_000; -- Cross-refs + Xrefs_Initial : constant := 5_000; -- Cross-refs Xrefs_Increment : constant := 300; - Drefs_Initial : constant := 5; -- Dereferences + Drefs_Initial : constant := 5; -- Dereferences Drefs_Increment : constant := 1_000; end Alloc; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index d1822c4..b74724e 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -651,8 +651,8 @@ package body Exp_Disp is Controlling_Tag : Node_Id; procedure Build_Class_Wide_Check; - -- If the denoted subprogram has a class-wide precondition, generate - -- a check using that precondition before the dispatching call, because + -- If the denoted subprogram has a class-wide precondition, generate a + -- check using that precondition before the dispatching call, because -- this is the only class-wide precondition that applies to the call. function New_Value (From : Node_Id) return Node_Id; @@ -665,11 +665,6 @@ package body Exp_Disp is ---------------------------- procedure Build_Class_Wide_Check is - Prec : Node_Id; - Cond : Node_Id; - Msg : Node_Id; - Str_Loc : constant String := Build_Location_String (Loc); - function Replace_Formals (N : Node_Id) return Traverse_Result; -- Replace occurrences of the formals of the subprogram by the -- corresponding actuals in the call, given that this check is @@ -697,6 +692,7 @@ package body Exp_Disp is Rewrite (N, New_Copy_Tree (A)); exit; end if; + Next_Formal (F); Next_Actual (A); end loop; @@ -707,6 +703,17 @@ package body Exp_Disp is end Replace_Formals; procedure Update is new Traverse_Proc (Replace_Formals); + + -- Local variables + + Str_Loc : constant String := Build_Location_String (Loc); + + Cond : Node_Id; + Msg : Node_Id; + Prec : Node_Id; + + -- Start of processing for Build_Class_Wide_Check + begin -- Locate class-wide precondition, if any @@ -727,11 +734,12 @@ package body Exp_Disp is end if; -- The expression for the precondition is analyzed within the - -- generated pragma. The message text is the last parameter - -- of the generated pragma, indicating source of precondition. + -- generated pragma. The message text is the last parameter of + -- the generated pragma, indicating source of precondition. - Cond := New_Copy_Tree - (Expression (First (Pragma_Argument_Associations (Prec)))); + Cond := + New_Copy_Tree + (Expression (First (Pragma_Argument_Associations (Prec)))); Update (Cond); -- Build message indicating the failed precondition and the @@ -745,14 +753,13 @@ package body Exp_Disp is Msg := Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len)); Insert_Action (Call_Node, - Make_If_Statement (Loc, - Condition => Make_Op_Not (Loc, Cond), - Then_Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of - (RTE (RE_Raise_Assert_Failure), Loc), - Parameter_Associations => New_List (Msg))))); + Make_If_Statement (Loc, + Condition => Make_Op_Not (Loc, Cond), + Then_Statements => New_List ( + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Raise_Assert_Failure), Loc), + Parameter_Associations => New_List (Msg))))); end if; end Build_Class_Wide_Check; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 0430d64..1713ff6 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1114,8 +1114,8 @@ package body Exp_Util is if Present (New_E) then Rewrite (N, New_Occurrence_Of (New_E, Sloc (N))); - -- If the entity is an overridden primitive and we are not in - -- GNATprove mode, we must build a wrapper for the current + -- If the entity is an overridden primitive and we are not + -- in GNATprove mode, we must build a wrapper for the current -- inherited operation. If the reference is the prefix of an -- attribute such as 'Result (or others ???) there is no need -- for a wrapper: the condition is just rewritten in terms of @@ -1123,7 +1123,7 @@ package body Exp_Util is if Is_Subprogram (New_E) and then Nkind (Parent (N)) /= N_Attribute_Reference - and then not GNATprove_Mode + and then not GNATprove_Mode then Needs_Wrapper := True; end if; diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb index f975e6c..ff27f07 100644 --- a/gcc/ada/g-dyntab.adb +++ b/gcc/ada/g-dyntab.adb @@ -71,9 +71,12 @@ package body GNAT.Dynamic_Tables is procedure Append (T : in out Instance; New_Val : Table_Component_Type) is pragma Assert (not T.Locked); New_Last : constant Table_Last_Type := Last (T) + 1; + begin if New_Last <= Last_Allocated (T) then - -- fast path + + -- Fast path + T.P.Last := New_Last; T.Table (New_Last) := New_Val; @@ -144,7 +147,7 @@ package body GNAT.Dynamic_Tables is subtype Table_Length_Type is Table_Index_Type'Base range 0 .. Table_Index_Type'Base'Last; - Old_Last_Allocated : constant Table_Last_Type := Last_Allocated (T); + Old_Last_Allocated : constant Table_Last_Type := Last_Allocated (T); Old_Allocated_Length : constant Table_Length_Type := Old_Last_Allocated - First + 1; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 8da1c50..9edc958 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -116,6 +116,24 @@ procedure Gnat1drv is ---------------------------- procedure Adjust_Global_Switches is + procedure SPARK_Library_Warning (Kind : String); + -- Issue a warning in GNATprove mode if the run-time library does not + -- fully support IEEE-754 floating-point semantics. + + --------------------------- + -- SPARK_Library_Warning -- + --------------------------- + + procedure SPARK_Library_Warning (Kind : String) is + begin + Write_Line + ("warning: run-time library may be configured incorrectly"); + Write_Line + ("warning: (SPARK analysis requires support for " & Kind & ')'); + end SPARK_Library_Warning; + + -- Start of processing for Adjust_Global_Switches + begin -- -gnatd.M enables Relaxed_RM_Semantics @@ -500,29 +518,15 @@ procedure Gnat1drv is -- Detect that the runtime library support for floating-point numbers -- may not be compatible with SPARK analysis of IEEE-754 floats. - declare - procedure SPARK_Library_Warning (Kind : String); - -- Issue a warning in GNATprove mode if the run-time library does - -- not fully support IEEE-754 floating-point semantics. + if Denorm_On_Target = False then + SPARK_Library_Warning ("float subnormals"); - procedure SPARK_Library_Warning (Kind : String) is - begin - Write_Line - ("warning: run-time library may be configured incorrectly"); - Write_Line - ("warning: (SPARK analysis requires support for " & Kind - & ')'); - end SPARK_Library_Warning; + elsif Machine_Rounds_On_Target = False then + SPARK_Library_Warning ("float rounding"); - begin - if Denorm_On_Target = False then - SPARK_Library_Warning ("float subnormals"); - elsif Machine_Rounds_On_Target = False then - SPARK_Library_Warning ("float rounding"); - elsif Signed_Zeros_On_Target = False then - SPARK_Library_Warning ("signed zeros"); - end if; - end; + elsif Signed_Zeros_On_Target = False then + SPARK_Library_Warning ("signed zeros"); + end if; end if; -- Set Configurable_Run_Time mode if system.ads flag set or if the diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 4e6a69a..fd458a3 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -161,10 +161,11 @@ package body Namet is procedure Append (Buf : in out Bounded_String; Id : Name_Id) is pragma Assert (Id in Name_Entries.First .. Name_Entries.Last); - Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index; - Len : constant Short := Name_Entries.Table (Id).Name_Len; + + Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index; + Len : constant Short := Name_Entries.Table (Id).Name_Len; Chars : Name_Chars.Table_Type renames - Name_Chars.Table (Index + 1 .. Index + Int (Len)); + Name_Chars.Table (Index + 1 .. Index + Int (Len)); begin Append (Buf, String (Chars)); end Append; @@ -174,8 +175,8 @@ package body Namet is -------------------- procedure Append_Decoded (Buf : in out Bounded_String; Id : Name_Id) is - C : Character; - P : Natural; + C : Character; + P : Natural; Temp : Bounded_String; begin diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 0e01594..2844b4e 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -589,7 +589,7 @@ package body Ch4 is -- Special handling for 'Image in Ada 2012, where -- the attribute can be parameterless and its value -- can be the prefix of a slice. Rewrite name as a - -- a slice, Expr is its low bound. + -- slice, Expr is its low bound. if Token = Tok_Dot_Dot and then Attr_Name = Name_Image diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f37b4c3..7e4dba5 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4032,11 +4032,11 @@ package body Sem_Attr is when Attribute_Image => Check_SPARK_05_Restriction_On_Attribute; - -- AI12-00124-1 : The ARG has adopted the GNAT semantics of 'Img - -- for scalar types, so that the prefix can be an object and not - -- a type, and there is no need for an argument. Given this vote - -- of confidence from the ARG, simplest is to transform this new - -- usage of 'Image into a reference to 'Img. + -- AI12-00124-1 : The ARG has adopted the GNAT semantics of 'Img for + -- scalar types, so that the prefix can be an object and not a type, + -- and there is no need for an argument. Given the vote of confidence + -- from the ARG, simplest is to transform this new usage of 'Image + -- into a reference to 'Img. if Ada_Version > Ada_2005 and then Is_Object_Reference (P) @@ -4048,19 +4048,20 @@ package body Sem_Attr is Prefix => Relocate_Node (P), Attribute_Name => Name_Img)); - -- If the attribute reference includes expressions, the - -- only possible interpretation is as an indexing of the - -- parameterless version of 'Image, so rewrite it accordingly. + -- If the attribute reference includes expressions, the only + -- possible interpretation is as an indexing of the parameterless + -- version of 'Image, so rewrite it accordingly. else Rewrite (N, - Make_Indexed_Component (Loc, - Prefix => - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (P), - Attribute_Name => Name_Img), - Expressions => Expressions (N))); + Make_Indexed_Component (Loc, + Prefix => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (P), + Attribute_Name => Name_Img), + Expressions => Expressions (N))); end if; + Analyze (N); return; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index f1a414f..8b1f9c0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11251,6 +11251,7 @@ package body Sem_Util is S := Current_Scope; while Present (S) and then S /= Standard_Standard loop if Is_Generic_Instance (S) then + -- A child instance is always compiled in the context of a parent -- instance. Nevertheless, the actuals are not analyzed in an -- instance context. We detect this case by examining the current -- 2.7.4