diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/exp_prag.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 14 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/table.adb | 10 |
13 files changed, 99 insertions, 86 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 06fe6a2..f765a8e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2013-01-04 Robert Dewar <dewar@adacore.com> + + * exp_prag.adb, gnatcmd.adb, exp_util.adb, table.adb, sem_prag.adb, + freeze.adb, sem_ch4.adb, sem_warn.adb, opt.ads, exp_aggr.adb, + prj-conf.adb, sem_ch13.adb: Minor reformatting. + 2013-01-04 Thomas Quinot <quinot@adacore.com> * sinfo.ads: Minor documentation update. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 0b5e13f..3b9d06f 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2962,9 +2962,10 @@ package body Exp_Aggr is Node_After : Node_Id) is Loc : constant Source_Ptr := Sloc (N); + Init_Actions : constant List_Id := New_List; Init_Node : Node_Id; EA : Node_Id; - Init_Actions : constant List_Id := New_List; + begin -- Nothing to do if Obj is already frozen, as in this case we known we -- won't need to move the initialization statements about later on. @@ -2974,15 +2975,15 @@ package body Exp_Aggr is end if; Init_Node := N; - while Next (Init_Node) /= Node_After loop Append_To (Init_Actions, Remove_Next (Init_Node)); end loop; if not Is_Empty_List (Init_Actions) then - EA := Make_Expression_With_Actions (Loc, - Actions => Init_Actions, - Expression => Make_Null_Statement (Loc)); + EA := + Make_Expression_With_Actions (Loc, + Actions => Init_Actions, + Expression => Make_Null_Statement (Loc)); Insert_Action_After (Init_Node, EA); Set_Initialization_Statements (Obj, EA); end if; @@ -5123,6 +5124,7 @@ package body Exp_Aggr is if Comes_From_Source (Tmp) then declare Node_After : constant Node_Id := Next (Parent_Node); + begin Insert_Actions_After (Parent_Node, Aggr_Code); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index f2b1c85..68a340d 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -530,16 +530,16 @@ package body Exp_Prag is -- Expand_Pragma_Import_Or_Interface -- --------------------------------------- - -- When applied to a variable, the default initialization must not be - -- done. As it is already done when the pragma is found, we just get rid - -- of the call the initialization procedure which followed the object - -- declaration. The call is inserted after the declaration, but validity - -- checks may also have been inserted and the initialization call does - -- not necessarily appear immediately after the object declaration. + -- When applied to a variable, the default initialization must not be done. + -- As it is already done when the pragma is found, we just get rid of the + -- call the initialization procedure which followed the object declaration. + -- The call is inserted after the declaration, but validity checks may + -- also have been inserted and the initialization call does not necessarily + -- appear immediately after the object declaration. - -- We can't use the freezing mechanism for this purpose, since we - -- have to elaborate the initialization expression when it is first - -- seen (i.e. this elaboration cannot be deferred to the freeze point). + -- We can't use the freezing mechanism for this purpose, since we have to + -- elaborate the initialization expression when it is first seen (i.e. this + -- elaboration cannot be deferred to the freeze point). procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is Def_Id : Entity_Id; @@ -553,11 +553,11 @@ package body Exp_Prag is Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N); - -- Any default initialization expression should be removed - -- (e.g., null defaults for access objects, zero initialization - -- of packed bit arrays). Imported objects aren't allowed to - -- have explicit initialization, so the expression must have - -- been generated by the compiler. + -- Any default initialization expression should be removed (e.g., + -- null defaults for access objects, zero initialization of packed + -- bit arrays). Imported objects aren't allowed to have explicit + -- initialization, so the expression must have been generated by + -- the compiler. if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then Set_Expression (Parent (Def_Id), Empty); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 50a2ba1..b6afb8f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6227,9 +6227,9 @@ package body Exp_Util is function Find_Init_Call_In_List (From : Node_Id) return Node_Id is Init_Call : Node_Id; + begin Init_Call := From; - while Present (Init_Call) and then Init_Call /= Rep_Clause loop if Nkind (Init_Call) = N_Procedure_Call_Statement and then Is_Entity_Name (Name (Init_Call)) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bf71111..234cdd2 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1114,9 +1114,7 @@ package body Freeze is Attribute_Scalar_Storage_Order); if Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type) then - if Present (Comp) - and then Chars (Comp) = Name_uParent - then + if Present (Comp) and then Chars (Comp) = Name_uParent then if Reverse_Storage_Order (Encl_Type) /= Reverse_Storage_Order (Comp_Type) @@ -3358,9 +3356,8 @@ package body Freeze is Initialization_Statements (E); begin if Present (Init_Stmts) - and then Nkind (Init_Stmts) = N_Expression_With_Actions - and then Nkind (Expression (Init_Stmts)) - = N_Null_Statement + and then Nkind (Init_Stmts) = N_Expression_With_Actions + and then Nkind (Expression (Init_Stmts)) = N_Null_Statement then Insert_List_Before (Init_Stmts, Actions (Init_Stmts)); Remove (Init_Stmts); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index f4508da..2fa479c 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -2001,10 +2001,10 @@ begin Name_Len := 0; -- If the single main has been specified as an absolute - -- path, we use only the simple file name. If the - -- absolute path is incorrect, an error will be reported - -- by the underlying tool and it does not make a - -- difference what switches are used. + -- path, use only the simple file name. If the absolute + -- path is incorrect, an error will be reported by the + -- underlying tool and it does not make a difference + -- what switches are used. if Is_Absolute_Path (Main.all) then Add_Str_To_Name_Buffer (File_Name (Main.all)); diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 2b68d79..2bd5956 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -537,16 +537,16 @@ package Opt is -- Determines the handling of exceptions. See Exp_Ch11 for details -- (Front_End_Setjmp_Longjmp_Exceptions, - -- Exceptions use setjmp/longjmp generated explicitly by the - -- front end (this includes gigi or other equivalent parts of - -- the code generator). AT END handlers are converted into - -- exception handlers by the front end in this mode. + -- Exceptions use setjmp/longjmp generated explicitly by the front end + -- (this includes gigi or other equivalent parts of the code generator). + -- AT END handlers are converted into exception handlers by the front + -- end in this mode. Back_End_Exceptions); -- Exceptions are handled by the back end. The front end simply - -- generates the handlers as they appear in the source, and AT - -- END handlers are left untouched (they are not converted into - -- exception handlers when operating in this mode. + -- generates the handlers as they appear in the source, and AT END + -- handlers are left untouched (they are not converted into exception + -- handlers when operating in this mode. pragma Convention (C, Exception_Mechanism_Type); Exception_Mechanism : Exception_Mechanism_Type := diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index a2c5463..3da9c1b 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1187,8 +1187,9 @@ package body Prj.Conf is declare Variable : Variable_Value; - Proj : Project_Id; + Proj : Project_Id; Tgt_Name : Name_Id := No_Name; + begin Proj := Project; Project_Loop : @@ -1196,9 +1197,9 @@ package body Prj.Conf is Variable := Value_Of (Name_Target, Proj.Decl.Attributes, Shared); - if Variable /= Nil_Variable_Value and then - not Variable.Default and then - Variable.Value /= No_Name + if Variable /= Nil_Variable_Value + and then not Variable.Default + and then Variable.Value /= No_Name then Tgt_Name := Variable.Value; exit Project_Loop; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e02b7a0..124769d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1318,14 +1318,16 @@ package body Sem_Ch13 is P_Name := A_Name; elsif A_Name = Name_Link_Name then - L_Assoc := Make_Pragma_Argument_Association (Loc, - Chars => A_Name, - Expression => Relocate_Node (Expression (A))); + L_Assoc := + Make_Pragma_Argument_Association (Loc, + Chars => A_Name, + Expression => Relocate_Node (Expression (A))); elsif A_Name = Name_External_Name then - E_Assoc := Make_Pragma_Argument_Association (Loc, - Chars => A_Name, - Expression => Relocate_Node (Expression (A))); + E_Assoc := + Make_Pragma_Argument_Association (Loc, + Chars => A_Name, + Expression => Relocate_Node (Expression (A))); end if; Next (A); @@ -2905,6 +2907,7 @@ package body Sem_Ch13 is declare Init_Call : constant Node_Id := Remove_Init_Call (U_Ent, N); + begin if Present (Init_Call) then @@ -2912,8 +2915,8 @@ package body Sem_Ch13 is -- null expression, just extract the actions. if Nkind (Init_Call) = N_Expression_With_Actions - and then Nkind (Expression (Init_Call)) - = N_Null_Statement + and then + Nkind (Expression (Init_Call)) = N_Null_Statement then Append_Freeze_Actions (U_Ent, Actions (Init_Call)); @@ -2930,9 +2933,8 @@ package body Sem_Ch13 is ("& cannot be exported if an address clause is given", Nam); Error_Msg_N - ("\define and export a variable " & - "that holds its address instead", - Nam); + ("\define and export a variable " + & "that holds its address instead", Nam); end if; -- Entity has delayed freeze, so we will generate an @@ -4698,15 +4700,19 @@ package body Sem_Ch13 is function Is_Inherited (Comp : Entity_Id) return Boolean is Comp_Base : Entity_Id; + begin if Ekind (Rectype) = E_Record_Subtype then Comp_Base := Original_Record_Component (Comp); else Comp_Base := Comp; end if; + return Comp_Base /= Original_Record_Component (Comp_Base); end Is_Inherited; + -- Local variables + Is_Record_Extension : Boolean; -- True if Rectype is a record extension @@ -4723,9 +4729,7 @@ package body Sem_Ch13 is Find_Type (Ident); Rectype := Entity (Ident); - if Rectype = Any_Type - or else Rep_Item_Too_Early (Rectype, N) - then + if Rectype = Any_Type or else Rep_Item_Too_Early (Rectype, N) then return; else Rectype := Underlying_Type (Rectype); @@ -5155,8 +5159,9 @@ package body Sem_Ch13 is return Empty; end if; - SId := Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Typ), "Invariant")); + SId := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Typ), "Invariant")); Set_Has_Invariants (SId); Set_Has_Invariants (Typ); Set_Ekind (SId, E_Procedure); @@ -8779,10 +8784,11 @@ package body Sem_Ch13 is Designated_Type (Etype (F)), Loc)))); if Nam = TSS_Stream_Input then - Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => Subp_Id, - Parameter_Specifications => Formals, - Result_Definition => T_Ref); + Spec := + Make_Function_Specification (Loc, + Defining_Unit_Name => Subp_Id, + Parameter_Specifications => Formals, + Result_Definition => T_Ref); else -- V : [out] T diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index cb761f2..541a75c 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1902,6 +1902,8 @@ package body Sem_Ch4 is exit when No (A); end loop; + -- This test needs a comment ??? + if Nkind (Expression (N)) = N_Null_Statement then Set_Etype (N, Standard_Void_Type); else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a6490bf..13d8be5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6775,7 +6775,7 @@ package body Sem_Prag is if Volatile_Seen and then ((Input_Seen and then Output_Seen) -- both - or else + or else (not Input_Seen and then not Output_Seen)) -- none then Error_Msg_N @@ -6785,7 +6785,7 @@ package body Sem_Prag is -- Either Input or Output require Volatile - if (Input_Seen or else Output_Seen) + if (Input_Seen or Output_Seen) and then not Volatile_Seen then Error_Msg_N diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 230ebd6..be4532e 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3281,7 +3281,7 @@ package body Sem_Warn is begin return (Warn_On_Modified_Unread and then Is_Only_Out_Parameter (E)) - or else Warn_On_All_Unread_Out_Parameters; + or else Warn_On_All_Unread_Out_Parameters; end Warn_On_Modified_As_Out_Parameter; --------------------------------- @@ -3293,7 +3293,7 @@ package body Sem_Warn is Form1, Form2 : Entity_Id; function Is_Covered_Formal (Formal : Node_Id) return Boolean; - -- Return True if Formal is covered by the rule. + -- Return True if Formal is covered by the rule function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean; -- Two names are known to refer to the same object if the two names @@ -3321,11 +3321,10 @@ package body Sem_Warn is function Is_Covered_Formal (Formal : Node_Id) return Boolean is begin return - Ekind_In (Formal, E_Out_Parameter, - E_In_Out_Parameter) + Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter) and then (Is_Elementary_Type (Etype (Formal)) - or else Is_Record_Type (Etype (Formal)) - or else Is_Array_Type (Etype (Formal))); + or else Is_Record_Type (Etype (Formal)) + or else Is_Array_Type (Etype (Formal))); end Is_Covered_Formal; begin @@ -3347,13 +3346,12 @@ package body Sem_Warn is -- there is no other name among the other parameters of mode in out or -- out to C that is known to denote the same object (RM 6.4.1(6.15/3)) - -- Compiling under -gnatw.i we also report warnings on overlapping - -- parameters that are record types or array types. + -- If appropriate warning switch is set, we also report warnings on + -- overlapping parameters that are record types or array types. Form1 := First_Formal (Subp); Act1 := First_Actual (N); while Present (Form1) and then Present (Act1) loop - if Is_Covered_Formal (Form1) then Form2 := First_Formal (Subp); Act2 := First_Actual (N); @@ -3376,25 +3374,24 @@ package body Sem_Warn is elsif Nkind (Act2) = N_Function_Call then null; - -- If type is not by-copy we can assume that the aliasing is - -- intended. + -- If type is not by-copy, assume that aliasing is intended elsif Present (Underlying_Type (Etype (Form1))) and then (Is_By_Reference_Type (Underlying_Type (Etype (Form1))) or else - Convention (Underlying_Type (Etype (Form1))) - = Convention_Ada_Pass_By_Reference) + Convention (Underlying_Type (Etype (Form1))) = + Convention_Ada_Pass_By_Reference) then null; -- Under Ada 2012 we only report warnings on overlapping - -- arrays and record types if compiling under -gnatw.i + -- arrays and record types if switch is set. elsif Ada_Version >= Ada_2012 - and then not Is_Elementary_Type (Etype (Form1)) - and then not Warn_On_Overlap + and then not Is_Elementary_Type (Etype (Form1)) + and then not Warn_On_Overlap then null; @@ -3449,7 +3446,7 @@ package body Sem_Warn is & "actual for&?I?", Act1, Form); else - -- For greater clarity, give name of formal. + -- For greater clarity, give name of formal Error_Msg_Node_2 := Form; Error_Msg_FE @@ -3460,8 +3457,8 @@ package body Sem_Warn is else Error_Msg_Node_2 := Form; Error_Msg_FE - ("writable actual for & overlaps with" - & " actual for&?I?", Act1, Form1); + ("writable actual for & overlaps with " + & "actual for&?I?", Act1, Form1); end if; end; end if; diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index 0f73e63..a7fdd55 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -172,7 +172,7 @@ package body Table is procedure Reallocate is New_Size : Memory.size_t; - New_Length : Long_Integer; + New_Length : Long_Long_Integer; begin if Max < Last_Val then @@ -188,12 +188,14 @@ package body Table is -- for the use of 10 here is to ensure that the table does really -- increase in size (which would not be the case for a table of -- length 10 increased by 3% for instance). Do the intermediate - -- calculation in Long_Integer to avoid overflow. + -- calculation in Long_Long_Integer to avoid overflow. Note that + -- Long_Integer has the same range as Integer on Windows, so we + -- need Long_Long_. while Max < Last_Val loop New_Length := - Long_Integer (Length) * - (100 + Long_Integer (Table_Increment)) + Long_Long_Integer (Length) * + (100 + Long_Long_Integer (Table_Increment)) / 100; Length := Int'Max (Int (New_Length), Length + 10); Max := Min + Length - 1; |