[multiple changes]
2014-07-30 Hristian Kirtchev <kirtchev@adacore.com> * checks.adb (Make_Bignum_Block): Use the new secondary stack build routines to manage the mark. * exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions): Use the new secodary stack build routines to manage the mark. (Insert_Actions_In_Scope_Around): Add new formal parameter Manage_SS along with comment on its usage. Code and comment reformatting. Mark and release the secondary stack when the context warrants it. (Make_Transient_Block): Update the call to Insert_Actions_In_Scope_Around to account for parameter Manage_SS. (Wrap_Transient_Declaration): Remove local variable Uses_SS. Ensure that the secondary stack is marked and released when the related object declaration appears in a library level package or package body. Code and comment reformatting. * exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine. (Build_SS_Release_Call): New routine. 2014-07-30 Steve Baird <baird@adacore.com> * exp_attr.adb: Revert previous change, not needed after all. 2014-07-30 Vincent Celier <celier@adacore.com> * makeutl.adb (Queue.Insert_Project_Sources): Insert with Closure => True for interfaces of Stand-Alone Libraries. * makeutl.ads (Source_Info (Format => Gprbuild)): Add new Boolean component Closure, defaulted to False. 2014-07-30 Yannick Moy <moy@adacore.com> * sem_res.adb: Fix typo in error message. From-SVN: r213291
This commit is contained in:
Arnaud Charlet
parent
63a4aa4375
commit
8e88892042
9 changed files with 278 additions and 135 deletions
|
|
@ -1,3 +1,37 @@
|
|||
2014-07-30 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* checks.adb (Make_Bignum_Block): Use the new secondary stack
|
||||
build routines to manage the mark.
|
||||
* exp_ch7.adb (Create_Finalizer, Expand_Cleanup_Actions):
|
||||
Use the new secodary stack build routines to manage the mark.
|
||||
(Insert_Actions_In_Scope_Around): Add new formal parameter
|
||||
Manage_SS along with comment on its usage. Code and comment
|
||||
reformatting. Mark and release the secondary stack when the
|
||||
context warrants it.
|
||||
(Make_Transient_Block): Update the call
|
||||
to Insert_Actions_In_Scope_Around to account for parameter Manage_SS.
|
||||
(Wrap_Transient_Declaration): Remove local variable
|
||||
Uses_SS. Ensure that the secondary stack is marked and released
|
||||
when the related object declaration appears in a library level
|
||||
package or package body. Code and comment reformatting.
|
||||
* exp_util.ads, exp_util.adb (Build_SS_Mark_Call): New routine.
|
||||
(Build_SS_Release_Call): New routine.
|
||||
|
||||
2014-07-30 Steve Baird <baird@adacore.com>
|
||||
|
||||
* exp_attr.adb: Revert previous change, not needed after all.
|
||||
|
||||
2014-07-30 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* makeutl.adb (Queue.Insert_Project_Sources): Insert with
|
||||
Closure => True for interfaces of Stand-Alone Libraries.
|
||||
* makeutl.ads (Source_Info (Format => Gprbuild)): Add new
|
||||
Boolean component Closure, defaulted to False.
|
||||
|
||||
2014-07-30 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_res.adb: Fix typo in error message.
|
||||
|
||||
2014-07-30 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Process_Range_Expr_In_Decl): Use _FIRST/_LAST
|
||||
|
|
|
|||
|
|
@ -7477,22 +7477,12 @@ package body Checks is
|
|||
begin
|
||||
return
|
||||
Make_Block_Statement (Loc,
|
||||
Declarations => New_List (
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => M,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Mark_Id), Loc),
|
||||
Expression =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)))),
|
||||
Declarations =>
|
||||
New_List (Build_SS_Mark_Call (Loc, M)),
|
||||
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_SS_Release), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (M, Loc))))));
|
||||
Statements => New_List (Build_SS_Release_Call (Loc, M))));
|
||||
end Make_Bignum_Block;
|
||||
|
||||
----------------------------------
|
||||
|
|
|
|||
|
|
@ -2884,11 +2884,9 @@ package body Exp_Attr is
|
|||
-- For scalar type, if low bound is a reference to an entity, just
|
||||
-- replace with a direct reference. Note that we can only have a
|
||||
-- reference to a constant entity at this stage, anything else would
|
||||
-- have already been rewritten. We do not do this rewriting if we
|
||||
-- are in CodePeer mode, since CodePeer prefers to see the explicit
|
||||
-- First attribute reference.
|
||||
-- have already been rewritten.
|
||||
|
||||
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
|
||||
elsif Is_Scalar_Type (Ptyp) then
|
||||
declare
|
||||
Lo : constant Node_Id := Type_Low_Bound (Ptyp);
|
||||
begin
|
||||
|
|
@ -3562,11 +3560,9 @@ package body Exp_Attr is
|
|||
-- For scalar type, if low bound is a reference to an entity, just
|
||||
-- replace with a direct reference. Note that we can only have a
|
||||
-- reference to a constant entity at this stage, anything else would
|
||||
-- have already been rewritten. We do not do this rewriting if we
|
||||
-- are in CodePeer mode, since CodePeer prefers to see the explicit
|
||||
-- Last attribute reference.
|
||||
-- have already been rewritten.
|
||||
|
||||
elsif Is_Scalar_Type (Ptyp) and then not CodePeer_Mode then
|
||||
elsif Is_Scalar_Type (Ptyp) then
|
||||
declare
|
||||
Hi : constant Node_Id := Type_High_Bound (Ptyp);
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -130,10 +130,14 @@ package body Exp_Ch7 is
|
|||
-- pointers of N until it find the appropriate node to wrap. If it returns
|
||||
-- Empty, it means that no transient scope is needed in this context.
|
||||
|
||||
procedure Insert_Actions_In_Scope_Around (N : Node_Id; Clean : Boolean);
|
||||
procedure Insert_Actions_In_Scope_Around
|
||||
(N : Node_Id;
|
||||
Clean : Boolean;
|
||||
Manage_SS : Boolean);
|
||||
-- Insert the before-actions kept in the scope stack before N, and the
|
||||
-- after-actions after N, which must be a member of a list. If Clean is
|
||||
-- True, also insert the cleanup actions.
|
||||
-- after-actions after N, which must be a member of a list. If flag Clean
|
||||
-- is set, insert any cleanup actions. If flag Manage_SS is set, insert
|
||||
-- calls to mark and release the secondary stack.
|
||||
|
||||
function Make_Transient_Block
|
||||
(Loc : Source_Ptr;
|
||||
|
|
@ -1477,12 +1481,7 @@ package body Exp_Ch7 is
|
|||
-- Release the secondary stack mark
|
||||
|
||||
if Present (Mark_Id) then
|
||||
Append_To (Finalizer_Stmts,
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_SS_Release), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (Mark_Id, Loc))));
|
||||
Append_To (Finalizer_Stmts, Build_SS_Release_Call (Loc, Mark_Id));
|
||||
end if;
|
||||
|
||||
-- Protect the statements with abort defer/undefer. This is only when
|
||||
|
|
@ -3963,15 +3962,7 @@ package body Exp_Ch7 is
|
|||
if Needs_Sec_Stack_Mark then
|
||||
Mark := Make_Temporary (Loc, 'M');
|
||||
|
||||
Append_To (New_Decls,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Mark,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Mark_Id), Loc),
|
||||
Expression =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc))));
|
||||
|
||||
Append_To (New_Decls, Build_SS_Mark_Call (Loc, Mark));
|
||||
Set_Uses_Sec_Stack (Scop, False);
|
||||
end if;
|
||||
|
||||
|
|
@ -4590,7 +4581,11 @@ package body Exp_Ch7 is
|
|||
-- Insert_Actions_In_Scope_Around --
|
||||
------------------------------------
|
||||
|
||||
procedure Insert_Actions_In_Scope_Around (N : Node_Id; Clean : Boolean) is
|
||||
procedure Insert_Actions_In_Scope_Around
|
||||
(N : Node_Id;
|
||||
Clean : Boolean;
|
||||
Manage_SS : Boolean)
|
||||
is
|
||||
Act_Before : constant List_Id :=
|
||||
Scope_Stack.Table (Scope_Stack.Last).Actions_To_Be_Wrapped (Before);
|
||||
Act_After : constant List_Id :=
|
||||
|
|
@ -4952,6 +4947,15 @@ package body Exp_Ch7 is
|
|||
end if;
|
||||
end Process_Transient_Objects;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped;
|
||||
First_Obj : Node_Id;
|
||||
Last_Obj : Node_Id;
|
||||
Mark_Id : Entity_Id;
|
||||
Target : Node_Id;
|
||||
|
||||
-- Start of processing for Insert_Actions_In_Scope_Around
|
||||
|
||||
begin
|
||||
|
|
@ -4959,79 +4963,85 @@ package body Exp_Ch7 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
declare
|
||||
Node_To_Wrap : constant Node_Id := Node_To_Be_Wrapped;
|
||||
First_Obj : Node_Id;
|
||||
Last_Obj : Node_Id;
|
||||
Target : Node_Id;
|
||||
-- If the node to be wrapped is the trigger of an asynchronous select,
|
||||
-- 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.
|
||||
|
||||
begin
|
||||
-- If the node to be wrapped is the trigger of an asynchronous
|
||||
-- select, 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.
|
||||
if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative
|
||||
and then not Is_List_Member (Node_To_Wrap)
|
||||
then
|
||||
Target := Parent (Parent (Node_To_Wrap));
|
||||
else
|
||||
Target := N;
|
||||
end if;
|
||||
|
||||
if Nkind (Parent (Node_To_Wrap)) = N_Triggering_Alternative
|
||||
and then not Is_List_Member (Node_To_Wrap)
|
||||
then
|
||||
Target := Parent (Parent (Node_To_Wrap));
|
||||
else
|
||||
Target := N;
|
||||
end if;
|
||||
First_Obj := Target;
|
||||
Last_Obj := Target;
|
||||
|
||||
First_Obj := Target;
|
||||
Last_Obj := Target;
|
||||
-- Add all actions associated with a transient scope into the main tree.
|
||||
-- There are several scenarios here:
|
||||
|
||||
-- Add all actions associated with a transient scope into the main
|
||||
-- tree. There are several scenarios here:
|
||||
-- +--- Before ----+ +----- After ---+
|
||||
-- 1) First_Obj ....... Target ........ Last_Obj
|
||||
|
||||
-- +--- Before ----+ +----- After ---+
|
||||
-- 1) First_Obj ....... Target ........ Last_Obj
|
||||
-- 2) First_Obj ....... Target
|
||||
|
||||
-- 2) First_Obj ....... Target
|
||||
-- 3) Target ........ Last_Obj
|
||||
|
||||
-- 3) Target ........ Last_Obj
|
||||
-- Flag declarations are inserted before the first object
|
||||
|
||||
if Present (Act_Before) then
|
||||
if Present (Act_Before) then
|
||||
First_Obj := First (Act_Before);
|
||||
Insert_List_Before (Target, Act_Before);
|
||||
end if;
|
||||
|
||||
-- Flag declarations are inserted before the first object
|
||||
-- Finalization calls are inserted after the last object
|
||||
|
||||
First_Obj := First (Act_Before);
|
||||
if Present (Act_After) then
|
||||
Last_Obj := Last (Act_After);
|
||||
Insert_List_After (Target, Act_After);
|
||||
end if;
|
||||
|
||||
Insert_List_Before (Target, Act_Before);
|
||||
end if;
|
||||
-- Mark and release the secondary stack when the context warrants it
|
||||
|
||||
if Present (Act_After) then
|
||||
if Manage_SS then
|
||||
Mark_Id := Make_Temporary (Loc, 'M');
|
||||
|
||||
-- Finalization calls are inserted after the last object
|
||||
-- Generate:
|
||||
-- Mnn : constant Mark_Id := SS_Mark;
|
||||
|
||||
Last_Obj := Last (Act_After);
|
||||
Insert_Before_And_Analyze
|
||||
(First_Obj, Build_SS_Mark_Call (Loc, Mark_Id));
|
||||
|
||||
Insert_List_After (Target, Act_After);
|
||||
end if;
|
||||
-- Generate:
|
||||
-- SS_Release (Mnn);
|
||||
|
||||
-- Check for transient controlled objects associated with Target and
|
||||
-- generate the appropriate finalization actions for them.
|
||||
Insert_After_And_Analyze
|
||||
(Last_Obj, Build_SS_Release_Call (Loc, Mark_Id));
|
||||
end if;
|
||||
|
||||
Process_Transient_Objects
|
||||
(First_Object => First_Obj,
|
||||
Last_Object => Last_Obj,
|
||||
Related_Node => Target);
|
||||
-- Check for transient controlled objects associated with Target and
|
||||
-- generate the appropriate finalization actions for them.
|
||||
|
||||
-- Reset the action lists
|
||||
Process_Transient_Objects
|
||||
(First_Object => First_Obj,
|
||||
Last_Object => Last_Obj,
|
||||
Related_Node => Target);
|
||||
|
||||
-- Reset the action lists
|
||||
|
||||
Scope_Stack.Table
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (Before) := No_List;
|
||||
Scope_Stack.Table
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (After) := No_List;
|
||||
|
||||
if Clean then
|
||||
Scope_Stack.Table
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (Before) := No_List;
|
||||
Scope_Stack.Table
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (After) := No_List;
|
||||
|
||||
if Clean then
|
||||
Scope_Stack.Table
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (Cleanup) := No_List;
|
||||
end if;
|
||||
end;
|
||||
(Scope_Stack.Last).Actions_To_Be_Wrapped (Cleanup) := No_List;
|
||||
end if;
|
||||
end Insert_Actions_In_Scope_Around;
|
||||
|
||||
------------------------------
|
||||
|
|
@ -8019,7 +8029,8 @@ package body Exp_Ch7 is
|
|||
-- nodes needed by those actions. Do not insert cleanup actions here,
|
||||
-- they will be transferred to the newly created block.
|
||||
|
||||
Insert_Actions_In_Scope_Around (Action, Clean => False);
|
||||
Insert_Actions_In_Scope_Around
|
||||
(Action, Clean => False, Manage_SS => False);
|
||||
|
||||
Insert := Prev (Action);
|
||||
if Present (Insert) then
|
||||
|
|
@ -8145,43 +8156,54 @@ package body Exp_Ch7 is
|
|||
-- [Deep_]Finalize (_v2);
|
||||
|
||||
procedure Wrap_Transient_Declaration (N : Node_Id) is
|
||||
Encl_S : Entity_Id;
|
||||
S : Entity_Id;
|
||||
Uses_SS : Boolean;
|
||||
Curr_S : Entity_Id;
|
||||
Encl_S : Entity_Id;
|
||||
|
||||
begin
|
||||
S := Current_Scope;
|
||||
Encl_S := Scope (S);
|
||||
Curr_S := Current_Scope;
|
||||
Encl_S := Scope (Curr_S);
|
||||
|
||||
-- Insert Actions kept in the Scope stack. Since we are not generating
|
||||
-- a block, we must also insert the cleanup actions in the tree now.
|
||||
-- Insert all actions inluding cleanup generated while analyzing or
|
||||
-- expanding the transient context back into the tree. Manage the
|
||||
-- secondary stack when the object declaration appears in a library
|
||||
-- level package [body]. This is not needed for .NET/JVM as those do
|
||||
-- not support the secondary stack.
|
||||
|
||||
Insert_Actions_In_Scope_Around (N, Clean => True);
|
||||
|
||||
-- If the declaration is consuming some secondary stack, mark the
|
||||
-- enclosing scope appropriately.
|
||||
|
||||
Uses_SS := Uses_Sec_Stack (S);
|
||||
Insert_Actions_In_Scope_Around
|
||||
(N => N,
|
||||
Clean => True,
|
||||
Manage_SS =>
|
||||
VM_Target = No_VM
|
||||
and then Uses_Sec_Stack (Curr_S)
|
||||
and then Nkind (N) = N_Object_Declaration
|
||||
and then Ekind_In (Encl_S, E_Package, E_Package_Body)
|
||||
and then Is_Library_Level_Entity (Encl_S));
|
||||
Pop_Scope;
|
||||
|
||||
-- Put the local entities back in the enclosing scope, and set the
|
||||
-- Is_Public flag appropriately.
|
||||
-- Relocate local entities declared within the transient scope to the
|
||||
-- enclosing scope. This action sets their Is_Public flag accordingly.
|
||||
|
||||
Transfer_Entities (S, Encl_S);
|
||||
Transfer_Entities (Curr_S, Encl_S);
|
||||
|
||||
-- Mark the enclosing dynamic scope so that the sec stack will be
|
||||
-- released upon its exit unless this is a function that returns on
|
||||
-- the sec stack in which case this will be done by the caller.
|
||||
-- Mark the enclosing dynamic scope to ensure that the secondary stack
|
||||
-- is properly released upon exiting the said scope. This is not needed
|
||||
-- for .NET/JVM as those do not support the secondary stack.
|
||||
|
||||
if VM_Target = No_VM and then Uses_SS then
|
||||
S := Enclosing_Dynamic_Scope (S);
|
||||
if VM_Target = No_VM and then Uses_Sec_Stack (Curr_S) then
|
||||
Curr_S := Enclosing_Dynamic_Scope (Curr_S);
|
||||
|
||||
if Ekind (S) = E_Function
|
||||
and then Requires_Transient_Scope (Etype (S))
|
||||
-- Do not mark a function that returns on the secondary stack as the
|
||||
-- reclamation is done by the caller.
|
||||
|
||||
if Ekind (Curr_S) = E_Function
|
||||
and then Requires_Transient_Scope (Etype (Curr_S))
|
||||
then
|
||||
null;
|
||||
|
||||
-- Otherwise mark the enclosing dynamic scope
|
||||
|
||||
else
|
||||
Set_Uses_Sec_Stack (S);
|
||||
Set_Uses_Sec_Stack (Curr_S);
|
||||
Check_Restriction (No_Secondary_Stack, N);
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -1013,6 +1013,49 @@ package body Exp_Util is
|
|||
end if;
|
||||
end Build_Runtime_Call;
|
||||
|
||||
------------------------
|
||||
-- Build_SS_Mark_Call --
|
||||
------------------------
|
||||
|
||||
function Build_SS_Mark_Call
|
||||
(Loc : Source_Ptr;
|
||||
Mark : Entity_Id) return Node_Id
|
||||
is
|
||||
begin
|
||||
-- Generate:
|
||||
-- Mark : constant Mark_Id := SS_Mark;
|
||||
|
||||
return
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Mark,
|
||||
Constant_Present => True,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (RTE (RE_Mark_Id), Loc),
|
||||
Expression =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => New_Occurrence_Of (RTE (RE_SS_Mark), Loc)));
|
||||
end Build_SS_Mark_Call;
|
||||
|
||||
---------------------------
|
||||
-- Build_SS_Release_Call --
|
||||
---------------------------
|
||||
|
||||
function Build_SS_Release_Call
|
||||
(Loc : Source_Ptr;
|
||||
Mark : Entity_Id) return Node_Id
|
||||
is
|
||||
begin
|
||||
-- Generate:
|
||||
-- SS_Release (Mark);
|
||||
|
||||
return
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name =>
|
||||
New_Occurrence_Of (RTE (RE_SS_Release), Loc),
|
||||
Parameter_Associations => New_List (
|
||||
New_Occurrence_Of (Mark, Loc)));
|
||||
end Build_SS_Release_Call;
|
||||
|
||||
----------------------------
|
||||
-- Build_Task_Array_Image --
|
||||
----------------------------
|
||||
|
|
|
|||
|
|
@ -244,6 +244,18 @@ package Exp_Util is
|
|||
-- information for the tree and for error messages. The call node is not
|
||||
-- analyzed on return, the caller is responsible for analyzing it.
|
||||
|
||||
function Build_SS_Mark_Call
|
||||
(Loc : Source_Ptr;
|
||||
Mark : Entity_Id) return Node_Id;
|
||||
-- Build a call to routine System.Secondary_Stack.Mark. Mark denotes the
|
||||
-- entity of the secondary stack mark.
|
||||
|
||||
function Build_SS_Release_Call
|
||||
(Loc : Source_Ptr;
|
||||
Mark : Entity_Id) return Node_Id;
|
||||
-- Build a call to routine System.Secondary_Stack.Release. Mark denotes the
|
||||
-- entity of the secondary stack mark.
|
||||
|
||||
function Build_Task_Image_Decls
|
||||
(Loc : Source_Ptr;
|
||||
Id_Ref : Node_Id;
|
||||
|
|
|
|||
|
|
@ -2754,9 +2754,10 @@ package body Makeutl is
|
|||
Debug_Output
|
||||
(" -> ", Name_Id (Root_Source.Display_File));
|
||||
Dummy := Queue.Insert_No_Roots
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Source.Tree,
|
||||
Id => Root_Source));
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Source.Tree,
|
||||
Id => Root_Source,
|
||||
Closure => False));
|
||||
|
||||
Initialize_Source_Record (Root_Source);
|
||||
|
||||
|
|
@ -2926,8 +2927,10 @@ package body Makeutl is
|
|||
-- False, put the Ada sources only when they are in a library
|
||||
-- project.
|
||||
|
||||
Iter : Source_Iterator;
|
||||
Source : Prj.Source_Id;
|
||||
Iter : Source_Iterator;
|
||||
Source : Prj.Source_Id;
|
||||
OK : Boolean;
|
||||
Closure : Boolean;
|
||||
|
||||
begin
|
||||
-- Nothing to do when "-u" was specified and some files were
|
||||
|
|
@ -2971,10 +2974,46 @@ package body Makeutl is
|
|||
or else Source.Project.Library)
|
||||
and then not Is_Subunit (Source)
|
||||
then
|
||||
Queue.Insert
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Tree,
|
||||
Id => Source));
|
||||
OK := True;
|
||||
Closure := False;
|
||||
|
||||
if Source.Unit /= No_Unit_Index
|
||||
and then Source.Project.Library
|
||||
and then Source.Project.Standalone_Library /= No
|
||||
then
|
||||
-- Check if the unit is in the interface
|
||||
OK := False;
|
||||
|
||||
declare
|
||||
List : String_List_Id :=
|
||||
Source.Project.Lib_Interface_ALIs;
|
||||
Element : String_Element;
|
||||
|
||||
begin
|
||||
while List /= Nil_String loop
|
||||
Element :=
|
||||
Project_Tree.Shared.String_Elements.Table
|
||||
(List);
|
||||
|
||||
if Element.Value = Name_Id (Source.Dep_Name)
|
||||
then
|
||||
OK := True;
|
||||
Closure := True;
|
||||
exit;
|
||||
end if;
|
||||
|
||||
List := Element.Next;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
if OK then
|
||||
Queue.Insert
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Tree,
|
||||
Id => Source,
|
||||
Closure => Closure));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
|
@ -3064,9 +3103,10 @@ package body Makeutl is
|
|||
or else Src_Id.Project.Library_Kind = Static)
|
||||
then
|
||||
Queue.Insert
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Project_Tree,
|
||||
Id => Src_Id));
|
||||
(Source => (Format => Format_Gprbuild,
|
||||
Tree => Project_Tree,
|
||||
Id => Src_Id,
|
||||
Closure => True));
|
||||
end if;
|
||||
end if;
|
||||
end loop;
|
||||
|
|
@ -3151,7 +3191,11 @@ package body Makeutl is
|
|||
Data.Need_Linking := False;
|
||||
|
||||
else
|
||||
Data.Closure_Needed := Has_Mains;
|
||||
Data.Closure_Needed :=
|
||||
Has_Mains
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -489,8 +489,9 @@ package Makeutl is
|
|||
record
|
||||
case Format is
|
||||
when Format_Gprbuild =>
|
||||
Tree : Project_Tree_Ref := No_Project_Tree;
|
||||
Id : Source_Id := No_Source;
|
||||
Tree : Project_Tree_Ref := No_Project_Tree;
|
||||
Id : Source_Id := No_Source;
|
||||
Closure : Boolean := False;
|
||||
|
||||
when Format_Gnatmake =>
|
||||
File : File_Name_Type := No_File;
|
||||
|
|
@ -504,7 +505,8 @@ package Makeutl is
|
|||
-- depends on the builder, and in particular whether it only supports
|
||||
-- project-based files (in which case we have a full Source_Id record).
|
||||
|
||||
No_Source_Info : constant Source_Info := (Format_Gprbuild, null, null);
|
||||
No_Source_Info : constant Source_Info :=
|
||||
(Format_Gprbuild, null, null, False);
|
||||
|
||||
procedure Initialize
|
||||
(Queue_Per_Obj_Dir : Boolean;
|
||||
|
|
|
|||
|
|
@ -6262,7 +6262,7 @@ package body Sem_Res is
|
|||
-- expressions, that are not handled by GNATprove.
|
||||
|
||||
elsif Is_Potentially_Unevaluated (N) then
|
||||
Error_Msg_NE ("?no contextual anlysis of &", N, Nam);
|
||||
Error_Msg_NE ("?no contextual analysis of &", N, Nam);
|
||||
Error_Msg_N
|
||||
("\call appears in potentially unevaluated context", N);
|
||||
Set_Is_Inlined_Always (Nam_UA, False);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue