From 5132708f8a29709b74d5eedb36c3414cdf44fa96 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Mon, 20 Jul 2009 12:47:50 +0000 Subject: [PATCH] einfo.ads, [...]: Minor reformatting 2009-07-20 Robert Dewar * einfo.ads, switch.adb, gnatls.adb, inline.adb, sem_ch13.adb: Minor reformatting From-SVN: r149809 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/einfo.ads | 11 +++--- gcc/ada/gnatls.adb | 80 +++++++++++++++++++++++--------------------- gcc/ada/inline.adb | 45 +++++++++---------------- gcc/ada/sem_ch13.adb | 17 +++++++--- gcc/ada/switch.adb | 16 ++++----- 6 files changed, 88 insertions(+), 86 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eeb488171a0..fb93faffa1d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2009-07-20 Robert Dewar + + * einfo.ads, switch.adb, gnatls.adb, inline.adb, sem_ch13.adb: Minor + reformatting + 2009-07-17 Richard Guenther PR c/40401 diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6c28ed8a495..a7023078265 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -554,12 +554,11 @@ package Einfo is -- Component_Clause (Node13) -- Present in record components and discriminants. If a record --- representation clause is present for the corresponding record --- type a that specifies a position for the component, then the --- Component_Clause field of the E_Component entity points to the --- N_Component_Clause node. Set to Empty if no record representation --- clause was present, or if there was no specification for this --- component. +-- representation clause is present for the corresponding record type a +-- that specifies a position for the component, then the Component_Clause +-- field of the E_Component entity points to the N_Component_Clause node. +-- Set to Empty if no record representation clause was present, or if +-- there was no specification for this component. -- Component_Size (Uint22) [implementation base type only] -- Present in array types. It contains the component size value for diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 1b7666f2838..ada6e59d1f8 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -191,11 +191,14 @@ procedure Gnatls is package GNATDIST is - -- Any modification to this subunit requires a synchronization with + -- Any modification to this subunit requires synchronization with the -- GNATDIST sources. - procedure Output_ALI (A : ALI_Id); + procedure Output_ALI (A : ALI_Id); + -- Comment required saying what this routine does ??? + procedure Output_No_ALI (Afile : File_Name_Type); + -- Comments required saying what this routine does ??? end GNATDIST; @@ -431,33 +434,33 @@ procedure Gnatls is T_Body); Image : constant array (Token_Type) of String_Access := - (T_No_ALI => new String'("No_ALI"), - T_ALI => new String'("ALI"), - T_Unit => new String'("Unit"), - T_With => new String'("With"), - T_Source => new String'("Source"), - T_Afile => new String'("Afile"), - T_Ofile => new String'("Ofile"), - T_Sfile => new String'("Sfile"), - T_Name => new String'("Name"), - T_Main => new String'("Main"), - T_Kind => new String'("Kind"), - T_Flags => new String'("Flags"), - T_Preelaborated => new String'("Preelaborated"), - T_Pure => new String'("Pure"), - T_Has_RACW => new String'("Has_RACW"), - T_Remote_Types => new String'("Remote_Types"), - T_Shared_Passive => new String'("Shared_Passive"), - T_RCI => new String'("RCI"), - T_Predefined => new String'("Predefined"), - T_Internal => new String'("Internal"), - T_Is_Generic => new String'("Is_Generic"), - T_Procedure => new String'("procedure"), - T_Function => new String'("function"), - T_Package => new String'("package"), - T_Subprogram => new String'("subprogram"), - T_Spec => new String'("spec"), - T_Body => new String'("body")); + (T_No_ALI => new String'("No_ALI"), + T_ALI => new String'("ALI"), + T_Unit => new String'("Unit"), + T_With => new String'("With"), + T_Source => new String'("Source"), + T_Afile => new String'("Afile"), + T_Ofile => new String'("Ofile"), + T_Sfile => new String'("Sfile"), + T_Name => new String'("Name"), + T_Main => new String'("Main"), + T_Kind => new String'("Kind"), + T_Flags => new String'("Flags"), + T_Preelaborated => new String'("Preelaborated"), + T_Pure => new String'("Pure"), + T_Has_RACW => new String'("Has_RACW"), + T_Remote_Types => new String'("Remote_Types"), + T_Shared_Passive => new String'("Shared_Passive"), + T_RCI => new String'("RCI"), + T_Predefined => new String'("Predefined"), + T_Internal => new String'("Internal"), + T_Is_Generic => new String'("Is_Generic"), + T_Procedure => new String'("procedure"), + T_Function => new String'("function"), + T_Package => new String'("package"), + T_Subprogram => new String'("subprogram"), + T_Spec => new String'("spec"), + T_Body => new String'("body")); procedure Output_Name (N : Name_Id); -- Remove any encoding info (%b and %s) and output N @@ -465,12 +468,11 @@ procedure Gnatls is procedure Output_Afile (A : File_Name_Type); procedure Output_Ofile (O : File_Name_Type); procedure Output_Sfile (S : File_Name_Type); - -- Output various names. Check that the name is different from - -- no name. Otherwise, skip the output. + -- Output various names. Check that the name is different from no name. + -- Otherwise, skip the output. procedure Output_Token (T : Token_Type); - -- Output token using a specific format. That is several - -- indentations and: + -- Output token using specific format. That is several indentations and: -- -- T_No_ALI .. T_With : & " =>" & NL -- T_Source .. T_Kind : & " => " @@ -609,12 +611,12 @@ procedure Gnatls is FS := Full_Source_Name (FS); -- There is no full source name. This occurs for instance when a - -- withed unit has a spec file but no body file. This situation - -- is not a problem for GNATDIST since the unit may be located on - -- a partition we do not want to build. However, we need to - -- locate the spec file and to find its full source name. - -- Replace the body file name with the spec file name used to - -- compile the current unit when possible. + -- withed unit has a spec file but no body file. This situation is + -- not a problem for GNATDIST since the unit may be located on a + -- partition we do not want to build. However, we need to locate + -- the spec file and to find its full source name. Replace the + -- body file name with the spec file name used to compile the + -- current unit when possible. if FS = No_File then Get_Name_String (S); diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 6fe50fd37d4..eeeb9da9106 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -206,9 +206,7 @@ package body Inline is -- one needs to be recorded. J := Inlined.Table (P1).First_Succ; - while J /= No_Succ loop - if Successors.Table (J).Subp = P2 then return; end if; @@ -543,6 +541,7 @@ package body Inline is declare S : Entity_Id; + begin S := Scope (Inst); while Present (S) and then S /= Standard_Standard loop @@ -555,9 +554,7 @@ package body Inline is end; Elmt := First_Elmt (To_Clean); - while Present (Elmt) loop - if Node (Elmt) = Scop then return; end if; @@ -601,9 +598,7 @@ package body Inline is else J := Hash_Headers (Index); - while J /= No_Subp loop - if Inlined.Table (J).Name = E then return J; else @@ -642,7 +637,6 @@ package body Inline is and then Serious_Errors_Detected = 0 loop Pack := Inlined_Bodies.Table (J); - while Present (Pack) and then Scope (Pack) /= Standard_Standard and then not Is_Child_Unit (Pack) @@ -722,7 +716,6 @@ package body Inline is Set_Is_Called (Inlined.Table (Index).Name, False); while S /= No_Succ loop - if Is_Called (Inlined.Table (Successors.Table (S).Subp).Name) or else Inlined.Table (Successors.Table (S).Subp).Main_Call @@ -789,8 +782,8 @@ package body Inline is and then not Is_Generic_Instance (P) then Bname := Get_Body_Name (Get_Unit_Name (Unit (N))); - E := First_Entity (P); + E := First_Entity (P); while Present (E) loop if Has_Pragma_Inline_Always (E) or else (Front_End_Inlining and then Has_Pragma_Inline (E)) @@ -800,11 +793,11 @@ package body Inline is if OK then - -- Check that we are not trying to inline a parent - -- whose body depends on a child, when we are compiling - -- the body of the child. Otherwise we have a potential - -- elaboration circularity with inlined subprograms and - -- with Taft-Amendment types. + -- Check we are not trying to inline a parent whose body + -- depends on a child, when we are compiling the body of + -- the child. Otherwise we have a potential elaboration + -- circularity with inlined subprograms and with + -- Taft-Amendment types. declare Comp : Node_Id; -- Body just compiled @@ -817,18 +810,17 @@ package body Inline is and then Present (Body_Entity (P)) then Child_Spec := - Defining_Entity ( - (Unit (Library_Unit (Cunit (Main_Unit))))); + Defining_Entity + ((Unit (Library_Unit (Cunit (Main_Unit))))); Comp := Parent (Unit_Declaration_Node (Body_Entity (P))); - With_Clause := First (Context_Items (Comp)); - -- Check whether the context of the body just -- compiled includes a child of itself, and that -- child is the spec of the main compilation. + With_Clause := First (Context_Items (Comp)); while Present (With_Clause) loop if Nkind (With_Clause) = N_With_Clause and then @@ -848,7 +840,6 @@ package body Inline is -- and keep Taft-amendment types incomplete. Ent := First_Entity (P); - while Present (Ent) loop if Is_Type (Ent) and then Has_Completion_In_Body (Ent) @@ -898,7 +889,6 @@ package body Inline is begin Elmt := First_Elmt (To_Clean); - while Present (Elmt) loop Scop := Node (Elmt); @@ -961,7 +951,6 @@ package body Inline is else Decl := First (Declarations (E_Body)); - while Present (Decl) loop if Nkind (Decl) = N_Full_Type_Declaration @@ -1076,9 +1065,10 @@ package body Inline is --------------- function Is_Nested (E : Entity_Id) return Boolean is - Scop : Entity_Id := Scope (E); + Scop : Entity_Id; begin + Scop := Scope (E); while Scop /= Standard_Standard loop if Ekind (Scop) in Subprogram_Kind then return True; @@ -1116,13 +1106,11 @@ package body Inline is -------------------------- procedure Remove_Dead_Instance (N : Node_Id) is - J : Int; + J : Int; begin J := 0; - while J <= Pending_Instantiations.Last loop - if Pending_Instantiations.Table (J).Inst_Node = N then Pending_Instantiations.Table (J).Inst_Node := Empty; return; @@ -1138,7 +1126,7 @@ package body Inline is function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is Comp : Node_Id; - S : Entity_Id := Scop; + S : Entity_Id; Ent : Entity_Id := Cunit_Entity (Main_Unit); begin @@ -1148,6 +1136,7 @@ package body Inline is -- the second case, this may lead to circularities if a parent body -- depends on a child spec, and we are analyzing the child. + S := Scop; while Scope (S) /= Standard_Standard and then not Is_Child_Unit (S) loop @@ -1155,7 +1144,6 @@ package body Inline is end loop; Comp := Parent (S); - while Present (Comp) and then Nkind (Comp) /= N_Compilation_Unit loop @@ -1163,7 +1151,6 @@ package body Inline is end loop; if Is_Child_Unit (Ent) then - while Present (Ent) and then Is_Child_Unit (Ent) loop diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2ec5334c573..7284e0827ed 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -884,9 +884,8 @@ package body Sem_Ch13 is Off : Boolean; begin - - -- Exported variables cannot have an address clause, - -- because this cancels the effect of the pragma Export + -- Exported variables cannot have an address clause, because + -- this cancels the effect of the pragma Export. if Is_Exported (U_Ent) then Error_Msg_N @@ -2343,7 +2342,7 @@ package body Sem_Ch13 is Set_Normalized_Position_Max (Fent, Uint_0); Init_Esize (Fent, System_Address_Size); - Set_Component_Clause (Fent, + Set_Component_Clause (Fent, Make_Component_Clause (Loc, Component_Name => Make_Identifier (Loc, @@ -2614,17 +2613,27 @@ package body Sem_Ch13 is package Sorting is new GNAT.Heap_Sort_G (OC_Move, OC_Lt); + ----------- + -- OC_Lt -- + ----------- + function OC_Lt (Op1, Op2 : Natural) return Boolean is begin return OC_Fbit (Op1) < OC_Fbit (Op2); end OC_Lt; + ------------- + -- OC_Move -- + ------------- + procedure OC_Move (From : Natural; To : Natural) is begin OC_Fbit (To) := OC_Fbit (From); OC_Lbit (To) := OC_Lbit (From); end OC_Move; + -- Start of processing for Overlap_Check + begin CC := First (Component_Clauses (N)); while Present (CC) loop diff --git a/gcc/ada/switch.adb b/gcc/ada/switch.adb index 0c761b6d34e..cb5c4d11f49 100644 --- a/gcc/ada/switch.adb +++ b/gcc/ada/switch.adb @@ -148,10 +148,10 @@ package body Switch is begin return Is_Switch (Switch_Chars) and then - (Switch_Chars (First .. Last) = "-param" - or else Switch_Chars (First .. Last) = "dumpbase" - or else Switch_Chars (First .. Last) = "auxbase-strip" - or else Switch_Chars (First .. Last) = "auxbase"); + (Switch_Chars (First .. Last) = "-param" or else + Switch_Chars (First .. Last) = "dumpbase" or else + Switch_Chars (First .. Last) = "auxbase-strip" or else + Switch_Chars (First .. Last) = "auxbase"); end Is_Internal_GCC_Switch; --------------- @@ -169,15 +169,15 @@ package body Switch is ----------------- function Switch_Last (Switch_Chars : String) return Natural is - Last : Natural := Switch_Chars'Last; + Last : constant Natural := Switch_Chars'Last; begin if Last >= Switch_Chars'First and then Switch_Chars (Last) = ASCII.NUL then - Last := Last - 1; + return Last - 1; + else + return Last; end if; - - return Last; end Switch_Last; ----------------- -- 2.30.2