This patch adds another suggestion to the elaboration order diagnostics.
An elaboration circularity involving a task activation may be resolved
through pragma Restrictions (No_Entry_Calls_In_Elaboration_Code).
------------
-- Source --
------------
-- no_entry_calls.txt
pragma Restrictions (No_Entry_Calls_In_Elaboration_Code);
-- a.ads
package A is
task type Task_Typ is
entry Start;
end Task_Typ;
procedure Proc;
end A;
-- a.adb
with B;
package body A is
task body Task_Typ is
begin
accept Start;
B.Proc;
end Task_Typ;
Elab : Task_Typ;
procedure Proc is null;
end A;
-- b.ads
package B is
procedure Proc;
end B;
-- b.adb
with A;
package body B is
procedure Proc is
begin
A.Proc;
end Proc;
end B;
-- main.adb
with A;
-- +--> A spec B spec
-- | ^ ^ ^
-- | | with | |
-- | sbb | +----------------+ | sbb
-- | | | |
-- | | | Invocation |
-- | A body ------------> B body
-- | ^ | |
-- | | Invocation | |
-- | +------------------+ |
-- | |
-- | Invocation |
-- +---------------------------+
--
-- The cycle is:
--
-- A body --> A body
procedure Main is begin null; end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -f -q main.adb -gnatd_F
$ gnatmake -f -q main.adb -gnatec=no_entry_calls.txt
error: Elaboration circularity detected
info:
info: Reason:
info:
info: unit "a (body)" depends on its own elaboration
info:
info: Circularity:
info:
info: unit "a (body)" invokes a construct of unit "a (body)" at
elaboration time
info: path 1:
info: elaboration of unit "a (body)"
info: activation of local task declared at "a.ads":2:14
info: call to subprogram "proc" declared at "b.ads":2:14
info: call to subprogram "proc" declared at "a.ads":6:14
info:
info: Suggestions:
info:
info: use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code)
info: use the dynamic elaboration model (compiler switch -gnatE)
info:
gnatmake: *** bind failed.
2019-07-09 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* bindo.ads: Move type Precedence_Kind from the private to the
visible part of the unit.
* bindo-augmentors.adb: Remove the use of global data as it is
bad practice.
(Augment_Library_Graph): Update the parameter profile.
(Is_Visited, Set_Is_Visited): Remove.
(Visit_Elaboration_Root, Visit_Elaboration_Roots): Update the
parameter profile and comment on usage.
(Visit_Vertex): Likewise. Also keep track of which invocation
edge activates a task.
* bindo-augmentors.ads (Augment_Library_Graph): Update the
parameter profile and comment on usage.
* bindo-builders.adb (Create_Forced_Edge,
Create_Spec_And_Body_Edge, Create_With_Edge): Update the call to
Add_Edge.
* bindo-diagnostics.adb: Add with end use clauses for Restrict
and Rident.
(Output_Dynamic_Model_Suggestions): Remove.
(Output_Invocation_Related_Suggestions): New routine.
(Output_Suggestions): Output all invocation-related suggestions
together.
* bindo-elaborators.adb: Remove types Comparator_Ptr and
Predicate_Ptr.
(Find_Best_Vertex): Update the parameter profile.
* bindo-graphs.adb (Activates_Task): New routine.
(Add_Body_Before_Spec_Edge): Update the call to
Add_Edge_With_Return.
(Add_Edge): Update the parameter profile and the call to
Add_Edge_With_Return.
(Add_Edge_With_Return): Update the parameter profile and comment
on usage.
(At_Least_One_Edge_Satisfies): New routine.
(Contains_Elaborate_All_Edge): Reimplement.
(Contains_Static_Successor_Edge, Contains_Task_Activation): New
routine.
(Contains_Weak_Static_Successor): Remove.
(Is_Static_Successor_Edge): New routine.
* bindo-graphs.ads: Add types LGE_Predicate_Ptr,
LGV_Comparator_Ptr, and LGV_Predicate_Ptr. Update type
Library_Graph_Edge_Attributes to capture whether an invocation
edge activates a task. Update the value of
No_Library_Graph_Edge_Attributes.
(Activates_Task): Update the parameter profile and comment on
usage.
(Contains_Static_Successor_Edge, Contains_Task_Activation): New
routines.
(Contains_Weak_Static_Successor): Remove.
* doc/gnat_ugn/elaboration_order_handling_in_gnat.rst:
Update the documentation to reflect the new task-related advice.
* gnat_ugn.texi: Regenerate.
From-SVN: r273286
+2019-07-09 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * bindo.ads: Move type Precedence_Kind from the private to the
+ visible part of the unit.
+ * bindo-augmentors.adb: Remove the use of global data as it is
+ bad practice.
+ (Augment_Library_Graph): Update the parameter profile.
+ (Is_Visited, Set_Is_Visited): Remove.
+ (Visit_Elaboration_Root, Visit_Elaboration_Roots): Update the
+ parameter profile and comment on usage.
+ (Visit_Vertex): Likewise. Also keep track of which invocation
+ edge activates a task.
+ * bindo-augmentors.ads (Augment_Library_Graph): Update the
+ parameter profile and comment on usage.
+ * bindo-builders.adb (Create_Forced_Edge,
+ Create_Spec_And_Body_Edge, Create_With_Edge): Update the call to
+ Add_Edge.
+ * bindo-diagnostics.adb: Add with end use clauses for Restrict
+ and Rident.
+ (Output_Dynamic_Model_Suggestions): Remove.
+ (Output_Invocation_Related_Suggestions): New routine.
+ (Output_Suggestions): Output all invocation-related suggestions
+ together.
+ * bindo-elaborators.adb: Remove types Comparator_Ptr and
+ Predicate_Ptr.
+ (Find_Best_Vertex): Update the parameter profile.
+ * bindo-graphs.adb (Activates_Task): New routine.
+ (Add_Body_Before_Spec_Edge): Update the call to
+ Add_Edge_With_Return.
+ (Add_Edge): Update the parameter profile and the call to
+ Add_Edge_With_Return.
+ (Add_Edge_With_Return): Update the parameter profile and comment
+ on usage.
+ (At_Least_One_Edge_Satisfies): New routine.
+ (Contains_Elaborate_All_Edge): Reimplement.
+ (Contains_Static_Successor_Edge, Contains_Task_Activation): New
+ routine.
+ (Contains_Weak_Static_Successor): Remove.
+ (Is_Static_Successor_Edge): New routine.
+ * bindo-graphs.ads: Add types LGE_Predicate_Ptr,
+ LGV_Comparator_Ptr, and LGV_Predicate_Ptr. Update type
+ Library_Graph_Edge_Attributes to capture whether an invocation
+ edge activates a task. Update the value of
+ No_Library_Graph_Edge_Attributes.
+ (Activates_Task): Update the parameter profile and comment on
+ usage.
+ (Contains_Static_Successor_Edge, Contains_Task_Activation): New
+ routines.
+ (Contains_Weak_Static_Successor): Remove.
+ * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst:
+ Update the documentation to reflect the new task-related advice.
+ * gnat_ugn.texi: Regenerate.
+
2019-07-09 Piotr Trojanek <trojanek@adacore.com>
* exp_util.adb (Containing_Package_With_Ext_Axioms): Replace
package body Library_Graph_Augmentors is
- -----------------
- -- Global data --
- -----------------
-
- Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
- Lib_Graph : Library_Graph := Library_Graphs.Nil;
- Visited : IGV_Sets.Membership_Set := IGV_Sets.Nil;
-
----------------
-- Statistics --
----------------
-- Local subprograms --
-----------------------
- function Is_Visited
- (Vertex : Invocation_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Visited);
- -- Determine whether invocation graph vertex Vertex has been visited
- -- during the traversal.
-
- procedure Set_Is_Visited
- (Vertex : Invocation_Graph_Vertex_Id;
- Val : Boolean := True);
- pragma Inline (Set_Is_Visited);
- -- Mark invocation graph vertex Vertex as visited during the traversal
- -- depending on value Val.
-
- procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id);
+ procedure Visit_Elaboration_Root
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Root : Invocation_Graph_Vertex_Id);
pragma Inline (Visit_Elaboration_Root);
-- Start a DFS traversal from elaboration root Root to:
--
-- * Create invocation edges for each such transition where the
-- successor is Root.
- procedure Visit_Elaboration_Roots;
+ procedure Visit_Elaboration_Roots
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph);
pragma Inline (Visit_Elaboration_Roots);
-- Start a DFS traversal from all elaboration roots to:
--
-- successor is the current root.
procedure Visit_Vertex
- (Invoker : Invocation_Graph_Vertex_Id;
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Invoker : Invocation_Graph_Vertex_Id;
Last_Vertex : Library_Graph_Vertex_Id;
Root_Vertex : Library_Graph_Vertex_Id;
+ Visited_Invokers : IGV_Sets.Membership_Set;
+ Activates_Task : Boolean;
Internal_Controlled_Action : Boolean;
Path : Natural);
pragma Inline (Visit_Vertex);
---------------------------
procedure Augment_Library_Graph
- (Inv_G : Invocation_Graph;
- Lib_G : Library_Graph)
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph)
is
begin
- pragma Assert (Present (Lib_G));
+ pragma Assert (Present (Lib_Graph));
-- Nothing to do when there is no invocation graph
- if not Present (Inv_G) then
+ if not Present (Inv_Graph) then
return;
end if;
- -- Prepare the global data. Note that Visited is initialized for each
- -- elaboration root.
+ -- Prepare the statistics data
- Inv_Graph := Inv_G;
- Lib_Graph := Lib_G;
Longest_Path := 0;
Total_Visited := 0;
- Visit_Elaboration_Roots;
+ Visit_Elaboration_Roots (Inv_Graph, Lib_Graph);
Write_Statistics;
end Augment_Library_Graph;
- ----------------
- -- Is_Visited --
- ----------------
-
- function Is_Visited
- (Vertex : Invocation_Graph_Vertex_Id) return Boolean
- is
- begin
- pragma Assert (IGV_Sets.Present (Visited));
- pragma Assert (Present (Vertex));
-
- return IGV_Sets.Contains (Visited, Vertex);
- end Is_Visited;
-
- --------------------
- -- Set_Is_Visited --
- --------------------
-
- procedure Set_Is_Visited
- (Vertex : Invocation_Graph_Vertex_Id;
- Val : Boolean := True)
- is
- begin
- pragma Assert (IGV_Sets.Present (Visited));
- pragma Assert (Present (Vertex));
-
- if Val then
- IGV_Sets.Insert (Visited, Vertex);
- else
- IGV_Sets.Delete (Visited, Vertex);
- end if;
- end Set_Is_Visited;
-
----------------------------
-- Visit_Elaboration_Root --
----------------------------
- procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id) is
+ procedure Visit_Elaboration_Root
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Root : Invocation_Graph_Vertex_Id)
+ is
pragma Assert (Present (Inv_Graph));
- pragma Assert (Present (Root));
pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Root));
Root_Vertex : constant Library_Graph_Vertex_Id :=
Body_Vertex (Inv_Graph, Root);
- pragma Assert (Present (Root_Vertex));
+ Visited : IGV_Sets.Membership_Set;
begin
- -- Prepare the global data
-
Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
Visit_Vertex
- (Invoker => Root,
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Invoker => Root,
Last_Vertex => Root_Vertex,
Root_Vertex => Root_Vertex,
+ Visited_Invokers => Visited,
+ Activates_Task => False,
Internal_Controlled_Action => False,
Path => 0);
-- Visit_Elaboration_Roots --
-----------------------------
- procedure Visit_Elaboration_Roots is
+ procedure Visit_Elaboration_Roots
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph)
+ is
Iter : Elaboration_Root_Iterator;
Root : Invocation_Graph_Vertex_Id;
begin
pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
Iter := Iterate_Elaboration_Roots (Inv_Graph);
while Has_Next (Iter) loop
Next (Iter, Root);
- Visit_Elaboration_Root (Root);
+ Visit_Elaboration_Root
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Root => Root);
end loop;
end Visit_Elaboration_Roots;
------------------
procedure Visit_Vertex
- (Invoker : Invocation_Graph_Vertex_Id;
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Invoker : Invocation_Graph_Vertex_Id;
Last_Vertex : Library_Graph_Vertex_Id;
Root_Vertex : Library_Graph_Vertex_Id;
+ Visited_Invokers : IGV_Sets.Membership_Set;
+ Activates_Task : Boolean;
Internal_Controlled_Action : Boolean;
Path : Natural)
is
New_Path : constant Natural := Path + 1;
Edge : Invocation_Graph_Edge_Id;
+ Edge_Kind : Invocation_Kind;
Invoker_Vertex : Library_Graph_Vertex_Id;
Iter : Edges_To_Targets_Iterator;
pragma Assert (Present (Invoker));
pragma Assert (Present (Last_Vertex));
pragma Assert (Present (Root_Vertex));
+ pragma Assert (IGV_Sets.Present (Visited_Invokers));
-- Nothing to do when the current invocation graph vertex has already
-- been visited.
- if Is_Visited (Invoker) then
+ if IGV_Sets.Contains (Visited_Invokers, Invoker) then
return;
end if;
- Set_Is_Visited (Invoker);
+ IGV_Sets.Insert (Visited_Invokers, Invoker);
-- Update the statistics
else
Add_Edge
- (G => Lib_Graph,
- Pred => Invoker_Vertex,
- Succ => Root_Vertex,
- Kind => Invocation_Edge);
+ (G => Lib_Graph,
+ Pred => Invoker_Vertex,
+ Succ => Root_Vertex,
+ Kind => Invocation_Edge,
+ Activates_Task => Activates_Task);
end if;
end if;
Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop
Next (Iter, Edge);
+ Edge_Kind := Kind (Inv_Graph, Edge);
Visit_Vertex
- (Invoker => Target (Inv_Graph, Edge),
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Invoker => Target (Inv_Graph, Edge),
Last_Vertex => Invoker_Vertex,
Root_Vertex => Root_Vertex,
+ Visited_Invokers => Visited_Invokers,
+ Activates_Task =>
+ Activates_Task
+ or else Edge_Kind = Task_Activation,
Internal_Controlled_Action =>
Internal_Controlled_Action
- or else Kind (Inv_Graph, Edge) in
- Internal_Controlled_Invocation_Kind,
+ or else Edge_Kind in Internal_Controlled_Invocation_Kind,
Path => New_Path);
end loop;
end Visit_Vertex;
package Library_Graph_Augmentors is
procedure Augment_Library_Graph
- (Inv_G : Invocation_Graph;
- Lib_G : Library_Graph);
- -- Augment library graph Lib_G with information from invocation graph
- -- Inv_G as follows:
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph);
+ -- Augment library graph Lib_Graph with information from invocation
+ -- graph Inv_Graph as follows:
--
-- 1) Traverse the invocation graph starting from each elaboration
-- procedure of unit Root.
Write_Eol;
Add_Edge
- (G => Lib_Graph,
- Pred => Pred_Vertex,
- Succ => Succ_Vertex,
- Kind => Forced_Edge);
+ (G => Lib_Graph,
+ Pred => Pred_Vertex,
+ Succ => Succ_Vertex,
+ Kind => Forced_Edge,
+ Activates_Task => False);
end Create_Forced_Edge;
-------------------------
Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
Add_Edge
- (G => Lib_Graph,
- Pred => Extra_Vertex,
- Succ => Vertex,
- Kind => Spec_Before_Body_Edge);
+ (G => Lib_Graph,
+ Pred => Extra_Vertex,
+ Succ => Vertex,
+ Kind => Spec_Before_Body_Edge,
+ Activates_Task => False);
-- The unit denotes a spec with a completing body. Link the spec and
-- body.
if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then
Add_Edge
- (G => Lib_Graph,
- Pred =>
+ (G => Lib_Graph,
+ Pred =>
Corresponding_Vertex
(Lib_Graph, Corresponding_Body (Withed_U_Id)),
- Succ => Succ,
- Kind => Kind);
+ Succ => Succ,
+ Kind => Kind,
+ Activates_Task => False);
end if;
-- The with comes with pragma Elaborate_All. Treat the edge as a with
-- successor.
Add_Edge
- (G => Lib_Graph,
- Pred => Withed_Vertex,
- Succ => Succ,
- Kind => Kind);
+ (G => Lib_Graph,
+ Pred => Withed_Vertex,
+ Succ => Succ,
+ Kind => Kind,
+ Activates_Task => False);
end Create_With_Edge;
-----------------------
-- --
------------------------------------------------------------------------------
-with Binderr; use Binderr;
-with Debug; use Debug;
-with Types; use Types;
+with Binderr; use Binderr;
+with Debug; use Debug;
+with Restrict; use Restrict;
+with Rident; use Rident;
+with Types; use Types;
with Bindo.Validators;
use Bindo.Validators;
-- Suggest the diagnostic of all cycles in library graph G if circumstances
-- allow it.
- procedure Output_Dynamic_Model_Suggestions
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id);
- pragma Inline (Output_Dynamic_Model_Suggestions);
- -- Suggest the use of the dynamic elaboration model to break cycle Cycle of
- -- library graph G if circumstances allow it.
-
procedure Output_Elaborate_All_Suggestions
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
-- Output a transition through edge Edge of invocation graph G, which is
-- part of an invocation path. Lib_Graph is the related library graph.
+ procedure Output_Invocation_Related_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Output_Invocation_Related_Suggestions);
+ -- Suggest ways to break cycle Cycle of library graph G that involves at
+ -- least one invocation edge.
+
procedure Output_Invocation_Transition
(Inv_Graph : Invocation_Graph;
Lib_Graph : Library_Graph;
end if;
end Output_All_Cycles_Suggestions;
- --------------------------------------
- -- Output_Dynamic_Model_Suggestions --
- --------------------------------------
-
- procedure Output_Dynamic_Model_Suggestions
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id)
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
-
- -- The cycle contains at least one invocation edge where the successor
- -- was statically elaborated. Using the dynamic model may eliminate an
- -- invocation edge, and thus the cycle.
-
- if Invocation_Edge_Count (G, Cycle) > 0
- and then Contains_Weak_Static_Successor (G, Cycle)
- then
- Error_Msg_Info
- (" use the dynamic elaboration model (compiler switch -gnatE)");
- end if;
- end Output_Dynamic_Model_Suggestions;
-
--------------------------------------
-- Output_Elaborate_All_Suggestions --
--------------------------------------
end case;
end Output_Invocation_Path_Transition;
+ -------------------------------------------
+ -- Output_Invocation_Related_Suggestions --
+ -------------------------------------------
+
+ procedure Output_Invocation_Related_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+
+ -- Nothing to do when the cycle does not contain an invocation edge
+
+ if Invocation_Edge_Count (G, Cycle) = 0 then
+ return;
+ end if;
+
+ -- The cycle contains at least one invocation edge, where at least
+ -- one of the paths the edge represents activates a task. The use of
+ -- restriction No_Entry_Calls_In_Elaboration_Code may halt the flow
+ -- within the task body on a select or accept statement, eliminating
+ -- subsequent invocation edges, thus breaking the cycle.
+
+ if not Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
+ and then Contains_Task_Activation (G, Cycle)
+ then
+ Error_Msg_Info
+ (" use pragma Restrictions "
+ & "(No_Entry_Calls_In_Elaboration_Code)");
+ end if;
+
+ -- The cycle contains at least one invocation edge where the successor
+ -- was statically elaborated. The use of the dynamic model may remove
+ -- one of the invocation edges in the cycle, thus breaking the cycle.
+
+ if Contains_Static_Successor_Edge (G, Cycle) then
+ Error_Msg_Info
+ (" use the dynamic elaboration model (compiler switch -gnatE)");
+ end if;
+ end Output_Invocation_Related_Suggestions;
+
----------------------------------
-- Output_Invocation_Transition --
----------------------------------
-- Output general purpose suggestions
- Output_Dynamic_Model_Suggestions
+ Output_Invocation_Related_Suggestions
(G => G,
Cycle => Cycle);
-- can be elaborated. Step is the current step in the elaboration order.
-- Indent is the desired indentation level for tracing.
- type Comparator_Ptr is access function
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
-
- type Predicate_Ptr is access function
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
-
function Find_Best_Vertex
(G : Library_Graph;
Set : LGV_Sets.Membership_Set;
- Is_Suitable_Vertex : Predicate_Ptr;
- Compare_Vertices : Comparator_Ptr;
+ Is_Suitable_Vertex : LGV_Predicate_Ptr;
+ Compare_Vertices : LGV_Comparator_Ptr;
Initial_Best_Msg : String;
Subsequent_Best_Msg : String;
Step : Elaboration_Order_Step;
function Find_Best_Vertex
(G : Library_Graph;
Set : LGV_Sets.Membership_Set;
- Is_Suitable_Vertex : Predicate_Ptr;
- Compare_Vertices : Comparator_Ptr;
+ Is_Suitable_Vertex : LGV_Predicate_Ptr;
+ Compare_Vertices : LGV_Comparator_Ptr;
Initial_Best_Msg : String;
Subsequent_Best_Msg : String;
Step : Elaboration_Order_Step;
-- for tracing.
function Add_Edge_With_Return
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind) return Library_Graph_Edge_Id;
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean) return Library_Graph_Edge_Id;
pragma Inline (Add_Edge_With_Return);
-- Create a new edge in library graph G with source vertex Pred and
-- destination vertex Succ, and return its handle. Kind denotes the
- -- nature of the edge. If Pred and Succ are already related, no edge
- -- is created and No_Library_Graph_Edge is returned.
+ -- nature of the edge. Activates_Task should be set when the edge
+ -- involves a task activation. If Pred and Succ are already related,
+ -- no edge is created and No_Library_Graph_Edge is returned.
procedure Add_Vertex_And_Complement
(G : Library_Graph;
-- part of an Elaborate_Body pair, or flag Do_Complement is set, add
-- the complementary vertex to the set.
+ function At_Least_One_Edge_Satisfies
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Predicate : LGE_Predicate_Ptr) return Boolean;
+ pragma Inline (At_Least_One_Edge_Satisfies);
+ -- Determine whether at least one edge of cycle Cycle of library graph G
+ -- satisfies predicate Predicate.
+
function Copy_Cycle_Path
(Cycle_Path : LGE_Lists.Doubly_Linked_List)
return LGE_Lists.Doubly_Linked_List;
-- Determine whether a predecessor vertex and a successor vertex
-- described by relation Rel are already linked in library graph G.
+ function Is_Static_Successor_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Static_Successor_Edge);
+ -- Determine whether the successor of invocation edge Edge represents a
+ -- unit that was compile with the static model.
+
function Links_Vertices_In_Same_Component
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean;
-- LGE_Is's successor vertex of library graph G must wait on before
-- it can be elaborated.
+ --------------------
+ -- Activates_Task --
+ --------------------
+
+ function Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
+
+ return
+ Kind (G, Edge) = Invocation_Edge
+ and then Get_LGE_Attributes (G, Edge).Activates_Task;
+ end Activates_Task;
+
-------------------------------
-- Add_Body_Before_Spec_Edge --
-------------------------------
if Is_Body_With_Spec (G, Vertex) then
Edge :=
Add_Edge_With_Return
- (G => G,
- Pred => Vertex, -- body
- Succ => Corresponding_Item (G, Vertex), -- spec
- Kind => Body_Before_Spec_Edge);
+ (G => G,
+ Pred => Vertex,
+ Succ => Corresponding_Item (G, Vertex),
+ Kind => Body_Before_Spec_Edge,
+ Activates_Task => False);
-- A spec with a completing body
elsif Is_Spec_With_Body (G, Vertex) then
Edge :=
Add_Edge_With_Return
- (G => G,
- Pred => Corresponding_Item (G, Vertex), -- body
- Succ => Vertex, -- spec
- Kind => Body_Before_Spec_Edge);
+ (G => G,
+ Pred => Corresponding_Item (G, Vertex),
+ Succ => Vertex,
+ Kind => Body_Before_Spec_Edge,
+ Activates_Task => False);
end if;
if Present (Edge) then
--------------
procedure Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind)
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean)
is
Edge : Library_Graph_Edge_Id;
pragma Unreferenced (Edge);
pragma Assert (Present (Pred));
pragma Assert (Present (Succ));
pragma Assert (Kind /= No_Edge);
+ pragma Assert (not Activates_Task or else Kind = Invocation_Edge);
Edge :=
Add_Edge_With_Return
- (G => G,
- Pred => Pred,
- Succ => Succ,
- Kind => Kind);
+ (G => G,
+ Pred => Pred,
+ Succ => Succ,
+ Kind => Kind,
+ Activates_Task => Activates_Task);
end Add_Edge;
--------------------------
--------------------------
function Add_Edge_With_Return
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind) return Library_Graph_Edge_Id
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean) return Library_Graph_Edge_Id
is
pragma Assert (Present (G));
pragma Assert (Present (Pred));
Set_LGE_Attributes
(G => G,
Edge => Edge,
- Val => (Kind => Kind));
+ Val =>
+ (Activates_Task => Activates_Task,
+ Kind => Kind));
-- Mark the predecessor and successor as related by the new edge.
-- This prevents all further attempts to link the same predecessor
end if;
end Add_Vertex_And_Complement;
+ ---------------------------------
+ -- At_Least_One_Edge_Satisfies --
+ ---------------------------------
+
+ function At_Least_One_Edge_Satisfies
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Predicate : LGE_Predicate_Ptr) return Boolean
+ is
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_Of_Cycle_Iterator;
+ Satisfied : Boolean;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+ pragma Assert (Predicate /= null);
+
+ -- Assume that the predicate cannot be satisfied
+
+ Satisfied := False;
+
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- edges of the cycle.
+
+ Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ Satisfied := Satisfied or else Predicate.all (G, Edge);
+ end loop;
+
+ return Satisfied;
+ end At_Least_One_Edge_Satisfies;
+
--------------------------
-- Complementary_Vertex --
--------------------------
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean
is
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_Of_Cycle_Iterator;
- Seen : Boolean;
-
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
- -- Assume that no Elaborate_All edge has been seen
-
- Seen := False;
-
- -- IMPORTANT:
- --
- -- * The iteration must run to completion in order to unlock the
- -- edges of the cycle.
-
- Iter := Iterate_Edges_Of_Cycle (G, Cycle);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
-
- if not Seen
- and then Is_Elaborate_All_Edge (G, Edge)
- then
- Seen := True;
- end if;
- end loop;
-
- return Seen;
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Is_Elaborate_All_Edge'Access);
end Contains_Elaborate_All_Edge;
------------------------------------
- -- Contains_Weak_Static_Successor --
+ -- Contains_Static_Successor_Edge --
------------------------------------
- function Contains_Weak_Static_Successor
+ function Contains_Static_Successor_Edge
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean
is
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_Of_Cycle_Iterator;
- Seen : Boolean;
-
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
- -- Assume that no weak static successor has been seen
-
- Seen := False;
-
- -- IMPORTANT:
- --
- -- * The iteration must run to completion in order to unlock the
- -- edges of the cycle.
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Is_Static_Successor_Edge'Access);
+ end Contains_Static_Successor_Edge;
- Iter := Iterate_Edges_Of_Cycle (G, Cycle);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
+ ------------------------------
+ -- Contains_Task_Activation --
+ ------------------------------
- if not Seen
- and then Is_Invocation_Edge (G, Edge)
- and then not Is_Dynamically_Elaborated (G, Successor (G, Edge))
- then
- Seen := True;
- end if;
- end loop;
+ function Contains_Task_Activation
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
- return Seen;
- end Contains_Weak_Static_Successor;
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Activates_Task'Access);
+ end Contains_Task_Activation;
---------------------
-- Copy_Cycle_Path --
and then Has_Elaborate_Body (G, Vertex);
end Is_Spec_With_Elaborate_Body;
+ ------------------------------
+ -- Is_Static_Successor_Edge --
+ ------------------------------
+
+ function Is_Static_Successor_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
+
+ return
+ Is_Invocation_Edge (G, Edge)
+ and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
+ end Is_Static_Successor_Edge;
+
---------------------------------
-- Is_Weakly_Elaborable_Vertex --
----------------------------------
type Library_Graph is private;
Nil : constant Library_Graph;
+ type LGE_Predicate_Ptr is access function
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+
+ type LGV_Comparator_Ptr is access function
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
+
+ type LGV_Predicate_Ptr is access function
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+
----------------------
-- Graph operations --
----------------------
procedure Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind);
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean);
pragma Inline (Add_Edge);
-- Create a new edge in library graph G with source vertex Pred and
- -- destination vertex Succ. Kind denotes the nature of the edge.
+ -- destination vertex Succ. Kind denotes the nature of the edge. Flag
+ -- Activates_Task should be set when the edge involves task activation.
procedure Add_Vertex
(G : Library_Graph;
-- Edge attributes --
---------------------
+ function Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Activates_Task);
+ -- Determine whether edge Edge of library graph G activates a task
+
function Kind
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
-- Determine whether cycle Cycle of library graph G contains an
-- Elaborate_All edge.
- function Contains_Weak_Static_Successor
+ function Contains_Static_Successor_Edge
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean;
- pragma Inline (Contains_Weak_Static_Successor);
- -- Determine whether cycle Cycle of library graph G contains a weak edge
+ pragma Inline (Contains_Static_Successor_Edge);
+ -- Determine whether cycle Cycle of library graph G contains an edge
-- where the successor was compiled using the static model.
+ function Contains_Task_Activation
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean;
+ pragma Inline (Contains_Task_Activation);
+ -- Determine whether cycle Cycle of library graph G contains an
+ -- invocation edge where the path it represents involves a task
+ -- activation.
+
function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean;
pragma Inline (Has_Elaborate_All_Cycle);
-- Determine whether library graph G contains a cycle involving pragma
-- The following type represents the attributes of a library graph edge
type Library_Graph_Edge_Attributes is record
+ Activates_Task : Boolean := False;
+ -- Set for an invocation edge, where at least one of the paths the
+ -- edge represents activates a task.
+
Kind : Library_Graph_Edge_Kind := No_Edge;
-- The nature of the library graph edge
end record;
No_Library_Graph_Edge_Attributes :
constant Library_Graph_Edge_Attributes :=
- (Kind => No_Edge);
+ (Activates_Task => False,
+ Kind => No_Edge);
procedure Destroy_Library_Graph_Edge_Attributes
(Attrs : in out Library_Graph_Edge_Attributes);
package Bindo is
+ -- The following type represents the various kinds of precedence between
+ -- two items.
+
+ type Precedence_Kind is
+ (Lower_Precedence,
+ Equal_Precedence,
+ Higher_Precedence);
+
procedure Find_Elaboration_Order
(Order : out Unit_Id_Table;
Main_Lib_File : File_Name_Type);
-- exists, it is returned in Order, otherwise Unrecoverable_Error is
-- raised.
-private
-
- -- The following type represents the various kinds of precedence between
- -- two items.
-
- type Precedence_Kind is
- (Lower_Precedence,
- Equal_Precedence,
- Higher_Precedence);
-
end Bindo;
The programmer should remove the pragma as advised, and rebuild the program.
+* Use of pragma Restrictions
+
+ ::
+
+ use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code)
+
+ This tactic is suggested when the binder has determined that a task
+ activation at elaboration time
+
+ - Prevents a set of units from being elaborated.
+
+ Note that the binder cannot determine with certainty whether the task will
+ block at elaboration time.
+
+ The programmer should create a configuration file, place the pragma within,
+ update the general compilation arguments, and rebuild the program.
+
* Use of dynamic elaboration model
::
The programmer should remove the pragma as advised, and rebuild the program.
+@item
+Use of pragma Restrictions
+
+@example
+use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code)
+@end example
+
+This tactic is suggested when the binder has determined that a task
+activation at elaboration time
+
+
+@itemize -
+
+@item
+Prevents a set of units from being elaborated.
+@end itemize
+
+Note that the binder cannot determine with certainty whether the task will
+block at elaboration time.
+
+The programmer should create a configuration file, place the pragma within,
+update the general compilation arguments, and rebuild the program.
+
@item
Use of dynamic elaboration model
projects / gcc.git / commitdiff