From 41c79d60e56ed6c48f2b52ff9e9b750420cf9cbf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 30 Jul 2014 17:01:55 +0200 Subject: [PATCH] [multiple changes] 2014-07-30 Robert Dewar * exp_ch7.adb, checks.adb, makeutl.adb, makeutl.ads: Minor reformatting. 2014-07-30 Yannick Moy * checks.ads: Fix typo in comment. 2014-07-30 Pierre-Marie Derodat * sem_util.adb (Set_Debug_Info_Needed): For scalar types, recurse on entities that materialize range bounds, if any. 2014-07-30 Vincent Celier * projects.texi: Minor spelling fix. From-SVN: r213292 --- gcc/ada/ChangeLog | 17 +++++++++++++++ gcc/ada/checks.adb | 2 -- gcc/ada/checks.ads | 4 +++- gcc/ada/exp_ch7.adb | 50 +++++++++++++++++-------------------------- gcc/ada/makeutl.adb | 19 +++++++--------- gcc/ada/makeutl.ads | 2 +- gcc/ada/projects.texi | 6 +++++- gcc/ada/sem_util.adb | 24 +++++++++++++++++++++ 8 files changed, 78 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d00c1b6676..0ec4d21f016 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2014-07-30 Robert Dewar + + * exp_ch7.adb, checks.adb, makeutl.adb, makeutl.ads: Minor reformatting. + +2014-07-30 Yannick Moy + + * checks.ads: Fix typo in comment. + +2014-07-30 Pierre-Marie Derodat + + * sem_util.adb (Set_Debug_Info_Needed): For scalar types, recurse on + entities that materialize range bounds, if any. + +2014-07-30 Vincent Celier + + * projects.texi: Minor spelling fix. + 2014-07-30 Hristian Kirtchev * checks.adb (Make_Bignum_Block): Use the new secondary stack diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index aea726c5f71..7d8935b0555 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -7473,13 +7473,11 @@ package body Checks is function Make_Bignum_Block (Loc : Source_Ptr) return Node_Id is M : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uM); - begin return Make_Block_Statement (Loc, Declarations => New_List (Build_SS_Mark_Call (Loc, M)), - Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List (Build_SS_Release_Call (Loc, M)))); diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 56dcbf50da2..d231e3dfe3e 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -312,8 +312,10 @@ package Checks is -- Similar to Determine_Range, but for a node N of floating-point type. OK -- is True on return only for IEEE floating-point types and only if we do -- not have to worry about extended precision (i.e. on the x86, we must be - -- using -msse2 -mfpmath=sse. At the current time, this is used only in + -- using -msse2 -mfpmath=sse). At the current time, this is used only in -- GNATprove, though we could consider using it more generally in future. + -- For that to happen, the possibility of arguments of infinite or NaN + -- value should be taken into account, which is not the case currently. procedure Install_Null_Excluding_Check (N : Node_Id); -- Determines whether an access node requires a runtime access check and diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 687ac1fa55a..e4ca02aab15 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -875,9 +875,7 @@ package body Exp_Ch7 is -- types where the designated type is explicitly derived from [Limited_] -- Controlled. - elsif VM_Target /= No_VM - and then not Is_Controlled (Desig_Typ) - then + elsif VM_Target /= No_VM and then not Is_Controlled (Desig_Typ) then return; -- Do not create finalization masters in SPARK mode because they result @@ -1609,7 +1607,7 @@ package body Exp_Ch7 is -- When the finalizer acts solely as a clean up routine, the body -- is inserted right after the spec. - if Acts_As_Clean and then not Has_Ctrl_Objs then + if Acts_As_Clean and not Has_Ctrl_Objs then Insert_After (Fin_Spec, Fin_Body); -- In all other cases the body is inserted after either: @@ -1817,7 +1815,7 @@ package body Exp_Ch7 is elsif Is_Access_Type (Obj_Typ) and then Present (Status_Flag_Or_Transient_Decl (Obj_Id)) and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) = - N_Object_Declaration + N_Object_Declaration then Processing_Actions (Has_No_Init => True); @@ -1867,9 +1865,8 @@ package body Exp_Ch7 is elsif Ekind (Obj_Id) = E_Variable and then not In_Library_Level_Package_Body (Obj_Id) - and then - (Is_Simple_Protected_Type (Obj_Typ) - or else Has_Simple_Protected_Object (Obj_Typ)) + and then (Is_Simple_Protected_Type (Obj_Typ) + or else Has_Simple_Protected_Object (Obj_Typ)) then Processing_Actions (Is_Protected => True); end if; @@ -2205,7 +2202,7 @@ package body Exp_Ch7 is -- For constrained or tagged results escalate the condition to -- include the allocation format. Generate: - -- + -- if BIPallocform > Secondary_Stack'Pos -- and then BIPfinalizationmaster /= null -- then @@ -2941,13 +2938,13 @@ package body Exp_Ch7 is and then (not Is_Library_Level_Entity (Spec_Id) - -- Nested packages are considered to be library level entities, - -- but do not need to be processed separately. True library level - -- packages have a scope value of 1. + -- Nested packages are considered to be library level entities, + -- but do not need to be processed separately. True library level + -- packages have a scope value of 1. - or else Scope_Depth_Value (Spec_Id) /= Uint_1 - or else (Is_Generic_Instance (Spec_Id) - and then Package_Instantiation (Spec_Id) /= N)) + or else Scope_Depth_Value (Spec_Id) /= Uint_1 + or else (Is_Generic_Instance (Spec_Id) + and then Package_Instantiation (Spec_Id) /= N)) then return; end if; @@ -3456,8 +3453,7 @@ package body Exp_Ch7 is begin if Has_Discriminants (U_Typ) and then Nkind (Parent (U_Typ)) = N_Full_Type_Declaration - and then - Nkind (Type_Definition (Parent (U_Typ))) = N_Record_Definition + and then Nkind (Type_Definition (Parent (U_Typ))) = N_Record_Definition and then Present (Variant_Part (Component_List (Type_Definition (Parent (U_Typ))))) @@ -4967,8 +4963,8 @@ package body Exp_Ch7 is -- it is not part of a statement list. The actions must be inserted -- before the select itself, which is part of some list of statements. -- Note that the triggering alternative includes the triggering - -- statement and an optional statement list. If the node to be wrapped - -- is part of that list, the normal insertion applies. + -- statement and an optional statement list. If the node to be + -- wrapped is part of that list, the normal insertion applies. if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative and then not Is_List_Member (Node_To_Wrap) @@ -7004,9 +7000,7 @@ package body Exp_Ch7 is -- Deep_Finalize (Obj._parent, False); - if Is_Tagged_Type (Typ) - and then Is_Derived_Type (Typ) - then + if Is_Tagged_Type (Typ) and then Is_Derived_Type (Typ) then declare Par_Typ : constant Entity_Id := Parent_Field_Type (Typ); Call : Node_Id; @@ -7061,9 +7055,7 @@ package body Exp_Ch7 is -- Finalize the object. This action must be performed first before -- all components have been finalized. - if Is_Controlled (Typ) - and then not Is_Local - then + if Is_Controlled (Typ) and then not Is_Local then declare Fin_Stmt : Node_Id; Proc : Entity_Id; @@ -7761,9 +7753,7 @@ package body Exp_Ch7 is -- Deal with non-tagged derivation of private views - if Is_Untagged_Derivation (Typ) - and then not Is_Conc - then + if Is_Untagged_Derivation (Typ) and then not Is_Conc then Utyp := Underlying_Type (Root_Type (Base_Type (Typ))); Ref := Unchecked_Convert_To (Utyp, Ref); @@ -8226,11 +8216,11 @@ package body Exp_Ch7 is -- declare -- M : constant Mark_Id := SS_Mark; -- procedure Finalizer is ... (See Build_Finalizer) - -- + -- begin -- Temp := ; -- general case -- Temp := (if then True else False); -- boolean case - -- + -- at end -- Finalizer; -- end; diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 51f95692f76..88826c73af8 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -624,13 +624,11 @@ package body Makeutl is end if; elsif Sw'Length >= 4 - and then (Sw (2 .. 3) = "aL" - or else - Sw (2 .. 3) = "aO" - or else - Sw (2 .. 3) = "aI" - or else - (For_Gnatbind and then Sw (2 .. 3) = "A=")) + and then + (Sw (2 .. 3) = "aL" or else + Sw (2 .. 3) = "aO" or else + Sw (2 .. 3) = "aI" + or else (For_Gnatbind and then Sw (2 .. 3) = "A=")) then Start := 4; @@ -2562,7 +2560,7 @@ package body Makeutl is if Source.Id.Path.Name = Q.Table (J).Info.Id.Path.Name and then Source.Id.Index = Q.Table (J).Info.Id.Index and then Source.Id.Project.Path.Name = - Q.Table (J).Info.Id.Project.Path.Name + Q.Table (J).Info.Id.Project.Path.Name then -- No need to insert this source in the queue, but still -- return True as we may need to insert its roots. @@ -3193,9 +3191,8 @@ package body Makeutl is else Data.Closure_Needed := Has_Mains - or else - (Root_Project.Library - and then Root_Project.Standalone_Library /= No); + or else (Root_Project.Library + and then Root_Project.Standalone_Library /= No); Data.Need_Compilation := All_Phases or Option_Compile_Only; Data.Need_Binding := All_Phases or Option_Bind_Only; Data.Need_Linking := (All_Phases or Option_Link_Only) diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 77f0f04976d..ab8068bd22c 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -506,7 +506,7 @@ package Makeutl is -- project-based files (in which case we have a full Source_Id record). No_Source_Info : constant Source_Info := - (Format_Gprbuild, null, null, False); + (Format_Gprbuild, null, null, False); procedure Initialize (Queue_Per_Obj_Dir : Boolean; diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index d66ed9affbd..65df6f73204 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -1767,6 +1767,10 @@ Other library-related attributes can be used to change the defaults: This attribute may be used to specify additional switches (last switches) when linking a shared library. + It may also be used to add foreign object files in a static library. + Each string in Library_Options is an absolute or relative path of an object + file. When a relative path, it is relative to the object directory. + @item @b{Leading_Library_Options}: @cindex @code{Leading_Library_Options} This attribute, that is taken into account only by @command{gprbuild}, may be @@ -2889,7 +2893,7 @@ static library named @file{libagg.a} into the @file{lagg} directory. An aggregate library project has the same set of restriction as a standard library project. -Note that a shared aggregate library project cannot aggregates a +Note that a shared aggregate library project cannot aggregate a static library project. In platforms where a compiler option is required to create relocatable object files, a Builder package in the aggregate library project may be used: diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 487ac3a57fa..9759a623684 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15997,6 +15997,30 @@ package body Sem_Util is elsif Is_Protected_Type (T) then Set_Debug_Info_Needed_If_Not_Set (Corresponding_Record_Type (T)); + + elsif Is_Scalar_Type (T) then + + -- If the subrange bounds are materialized by dedicated constant + -- objects, also include them to the debug info to make sure the + -- debugger can properly use them. + + if Present (Scalar_Range (T)) + and then Nkind (Scalar_Range (T)) = N_Range + then + declare + Low_Bnd : constant Node_Id := Type_Low_Bound (T); + High_Bnd : constant Node_Id := Type_High_Bound (T); + + begin + if Is_Entity_Name (Low_Bnd) then + Set_Debug_Info_Needed_If_Not_Set (Entity (Low_Bnd)); + end if; + + if Is_Entity_Name (High_Bnd) then + Set_Debug_Info_Needed_If_Not_Set (Entity (High_Bnd)); + end if; + end; + end if; end if; end if; end Set_Debug_Info_Needed; -- 2.30.2