Commit 41c79d60 by Arnaud Charlet

[multiple changes]

2014-07-30  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.adb, checks.adb, makeutl.adb, makeutl.ads: Minor reformatting.

2014-07-30  Yannick Moy  <moy@adacore.com>

	* checks.ads: Fix typo in comment.

2014-07-30  Pierre-Marie Derodat  <derodat@adacore.com>

	* sem_util.adb (Set_Debug_Info_Needed): For scalar types, recurse on
	entities that materialize range bounds, if any.

2014-07-30  Vincent Celier  <celier@adacore.com>

	* projects.texi: Minor spelling fix.

From-SVN: r213292
parent 8e888920
2014-07-30 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb, checks.adb, makeutl.adb, makeutl.ads: Minor reformatting.
2014-07-30 Yannick Moy <moy@adacore.com>
* checks.ads: Fix typo in comment.
2014-07-30 Pierre-Marie Derodat <derodat@adacore.com>
* sem_util.adb (Set_Debug_Info_Needed): For scalar types, recurse on
entities that materialize range bounds, if any.
2014-07-30 Vincent Celier <celier@adacore.com>
* projects.texi: Minor spelling fix.
2014-07-30 Hristian Kirtchev <kirtchev@adacore.com> 2014-07-30 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Make_Bignum_Block): Use the new secondary stack * checks.adb (Make_Bignum_Block): Use the new secondary stack
......
...@@ -7473,13 +7473,11 @@ package body Checks is ...@@ -7473,13 +7473,11 @@ package body Checks is
function Make_Bignum_Block (Loc : Source_Ptr) return Node_Id is function Make_Bignum_Block (Loc : Source_Ptr) return Node_Id is
M : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uM); M : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uM);
begin begin
return return
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
Declarations => Declarations =>
New_List (Build_SS_Mark_Call (Loc, M)), New_List (Build_SS_Mark_Call (Loc, M)),
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Build_SS_Release_Call (Loc, M)))); Statements => New_List (Build_SS_Release_Call (Loc, M))));
......
...@@ -312,8 +312,10 @@ package Checks is ...@@ -312,8 +312,10 @@ package Checks is
-- Similar to Determine_Range, but for a node N of floating-point type. OK -- 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 -- 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 -- 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. -- 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); procedure Install_Null_Excluding_Check (N : Node_Id);
-- Determines whether an access node requires a runtime access check and -- Determines whether an access node requires a runtime access check and
......
...@@ -875,9 +875,7 @@ package body Exp_Ch7 is ...@@ -875,9 +875,7 @@ package body Exp_Ch7 is
-- types where the designated type is explicitly derived from [Limited_] -- types where the designated type is explicitly derived from [Limited_]
-- Controlled. -- Controlled.
elsif VM_Target /= No_VM elsif VM_Target /= No_VM and then not Is_Controlled (Desig_Typ) then
and then not Is_Controlled (Desig_Typ)
then
return; return;
-- Do not create finalization masters in SPARK mode because they result -- Do not create finalization masters in SPARK mode because they result
...@@ -1609,7 +1607,7 @@ package body Exp_Ch7 is ...@@ -1609,7 +1607,7 @@ package body Exp_Ch7 is
-- When the finalizer acts solely as a clean up routine, the body -- When the finalizer acts solely as a clean up routine, the body
-- is inserted right after the spec. -- 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); Insert_After (Fin_Spec, Fin_Body);
-- In all other cases the body is inserted after either: -- In all other cases the body is inserted after either:
...@@ -1867,8 +1865,7 @@ package body Exp_Ch7 is ...@@ -1867,8 +1865,7 @@ package body Exp_Ch7 is
elsif Ekind (Obj_Id) = E_Variable elsif Ekind (Obj_Id) = E_Variable
and then not In_Library_Level_Package_Body (Obj_Id) and then not In_Library_Level_Package_Body (Obj_Id)
and then and then (Is_Simple_Protected_Type (Obj_Typ)
(Is_Simple_Protected_Type (Obj_Typ)
or else Has_Simple_Protected_Object (Obj_Typ)) or else Has_Simple_Protected_Object (Obj_Typ))
then then
Processing_Actions (Is_Protected => True); Processing_Actions (Is_Protected => True);
...@@ -2205,7 +2202,7 @@ package body Exp_Ch7 is ...@@ -2205,7 +2202,7 @@ package body Exp_Ch7 is
-- For constrained or tagged results escalate the condition to -- For constrained or tagged results escalate the condition to
-- include the allocation format. Generate: -- include the allocation format. Generate:
--
-- if BIPallocform > Secondary_Stack'Pos -- if BIPallocform > Secondary_Stack'Pos
-- and then BIPfinalizationmaster /= null -- and then BIPfinalizationmaster /= null
-- then -- then
...@@ -3456,8 +3453,7 @@ package body Exp_Ch7 is ...@@ -3456,8 +3453,7 @@ package body Exp_Ch7 is
begin begin
if Has_Discriminants (U_Typ) if Has_Discriminants (U_Typ)
and then Nkind (Parent (U_Typ)) = N_Full_Type_Declaration and then Nkind (Parent (U_Typ)) = N_Full_Type_Declaration
and then and then Nkind (Type_Definition (Parent (U_Typ))) = N_Record_Definition
Nkind (Type_Definition (Parent (U_Typ))) = N_Record_Definition
and then and then
Present Present
(Variant_Part (Component_List (Type_Definition (Parent (U_Typ))))) (Variant_Part (Component_List (Type_Definition (Parent (U_Typ)))))
...@@ -4967,8 +4963,8 @@ package body Exp_Ch7 is ...@@ -4967,8 +4963,8 @@ package body Exp_Ch7 is
-- it is not part of a statement list. The actions must be inserted -- 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. -- before the select itself, which is part of some list of statements.
-- Note that the triggering alternative includes the triggering -- Note that the triggering alternative includes the triggering
-- statement and an optional statement list. If the node to be wrapped -- statement and an optional statement list. If the node to be
-- is part of that list, the normal insertion applies. -- wrapped is part of that list, the normal insertion applies.
if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative
and then not Is_List_Member (Node_To_Wrap) and then not Is_List_Member (Node_To_Wrap)
...@@ -7004,9 +7000,7 @@ package body Exp_Ch7 is ...@@ -7004,9 +7000,7 @@ package body Exp_Ch7 is
-- Deep_Finalize (Obj._parent, False); -- Deep_Finalize (Obj._parent, False);
if Is_Tagged_Type (Typ) if Is_Tagged_Type (Typ) and then Is_Derived_Type (Typ) then
and then Is_Derived_Type (Typ)
then
declare declare
Par_Typ : constant Entity_Id := Parent_Field_Type (Typ); Par_Typ : constant Entity_Id := Parent_Field_Type (Typ);
Call : Node_Id; Call : Node_Id;
...@@ -7061,9 +7055,7 @@ package body Exp_Ch7 is ...@@ -7061,9 +7055,7 @@ package body Exp_Ch7 is
-- Finalize the object. This action must be performed first before -- Finalize the object. This action must be performed first before
-- all components have been finalized. -- all components have been finalized.
if Is_Controlled (Typ) if Is_Controlled (Typ) and then not Is_Local then
and then not Is_Local
then
declare declare
Fin_Stmt : Node_Id; Fin_Stmt : Node_Id;
Proc : Entity_Id; Proc : Entity_Id;
...@@ -7761,9 +7753,7 @@ package body Exp_Ch7 is ...@@ -7761,9 +7753,7 @@ package body Exp_Ch7 is
-- Deal with non-tagged derivation of private views -- Deal with non-tagged derivation of private views
if Is_Untagged_Derivation (Typ) if Is_Untagged_Derivation (Typ) and then not Is_Conc then
and then not Is_Conc
then
Utyp := Underlying_Type (Root_Type (Base_Type (Typ))); Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
Ref := Unchecked_Convert_To (Utyp, Ref); Ref := Unchecked_Convert_To (Utyp, Ref);
...@@ -8226,11 +8216,11 @@ package body Exp_Ch7 is ...@@ -8226,11 +8216,11 @@ package body Exp_Ch7 is
-- declare -- declare
-- M : constant Mark_Id := SS_Mark; -- M : constant Mark_Id := SS_Mark;
-- procedure Finalizer is ... (See Build_Finalizer) -- procedure Finalizer is ... (See Build_Finalizer)
--
-- begin -- begin
-- Temp := <Expr>; -- general case -- Temp := <Expr>; -- general case
-- Temp := (if <Expr> then True else False); -- boolean case -- Temp := (if <Expr> then True else False); -- boolean case
--
-- at end -- at end
-- Finalizer; -- Finalizer;
-- end; -- end;
......
...@@ -624,13 +624,11 @@ package body Makeutl is ...@@ -624,13 +624,11 @@ package body Makeutl is
end if; end if;
elsif Sw'Length >= 4 elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL" and then
or else (Sw (2 .. 3) = "aL" or else
Sw (2 .. 3) = "aO" Sw (2 .. 3) = "aO" or else
or else
Sw (2 .. 3) = "aI" Sw (2 .. 3) = "aI"
or else or else (For_Gnatbind and then Sw (2 .. 3) = "A="))
(For_Gnatbind and then Sw (2 .. 3) = "A="))
then then
Start := 4; Start := 4;
...@@ -3193,8 +3191,7 @@ package body Makeutl is ...@@ -3193,8 +3191,7 @@ package body Makeutl is
else else
Data.Closure_Needed := Data.Closure_Needed :=
Has_Mains Has_Mains
or else or else (Root_Project.Library
(Root_Project.Library
and then Root_Project.Standalone_Library /= No); and then Root_Project.Standalone_Library /= No);
Data.Need_Compilation := All_Phases or Option_Compile_Only; Data.Need_Compilation := All_Phases or Option_Compile_Only;
Data.Need_Binding := All_Phases or Option_Bind_Only; Data.Need_Binding := All_Phases or Option_Bind_Only;
......
...@@ -1767,6 +1767,10 @@ Other library-related attributes can be used to change the defaults: ...@@ -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) This attribute may be used to specify additional switches (last switches)
when linking a shared library. 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}: @item @b{Leading_Library_Options}:
@cindex @code{Leading_Library_Options} @cindex @code{Leading_Library_Options}
This attribute, that is taken into account only by @command{gprbuild}, may be 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} ...@@ -2889,7 +2893,7 @@ static library named @file{libagg.a} into the @file{lagg}
directory. An aggregate library project has the same set of directory. An aggregate library project has the same set of
restriction as a standard library project. 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 static library project. In platforms where a compiler option is
required to create relocatable object files, a Builder package in the required to create relocatable object files, a Builder package in the
aggregate library project may be used: aggregate library project may be used:
......
...@@ -15997,6 +15997,30 @@ package body Sem_Util is ...@@ -15997,6 +15997,30 @@ package body Sem_Util is
elsif Is_Protected_Type (T) then elsif Is_Protected_Type (T) then
Set_Debug_Info_Needed_If_Not_Set (Corresponding_Record_Type (T)); 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 if; end if;
end Set_Debug_Info_Needed; end Set_Debug_Info_Needed;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment