KJ16609/gcc-reflection
1
0
Fork 0
mirror of https://forge.sourceware.org/marek/gcc.git synced 2026-02-22 12:00:11 -05:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Task-related circularities in Elaboration order v4.0

Browse Source 
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
This commit is contained in:
Hristian Kirtchev
2019-07-09 07:55:00 +00:00
committed by Pierre-Marie de Rodat
parent 727e4d37be
commit 75cfda8b4a
11 changed files with 441 additions and 249 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
gcc/ada/ChangeLog
View File

@@ -1,3 +1,56 @@
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

146
gcc/ada/bindo-augmentors.adb
View File

@@ -37,14 +37,6 @@ package body Bindo.Augmentors is
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 --
----------------
@@ -61,20 +53,10 @@ package body Bindo.Augmentors is
-- 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:
--
@@ -83,7 +65,9 @@ package body Bindo.Augmentors is
-- * 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:
--
@@ -93,9 +77,13 @@ package body Bindo.Augmentors is
-- 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);
@@ -124,86 +112,56 @@ package body Bindo.Augmentors is
---------------------------
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);
@@ -214,18 +172,25 @@ package body Bindo.Augmentors is
-- 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;
@@ -234,15 +199,20 @@ package body Bindo.Augmentors is
------------------
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;
@@ -252,15 +222,16 @@ package body Bindo.Augmentors is
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
@@ -294,10 +265,11 @@ package body Bindo.Augmentors is
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;
@@ -307,15 +279,21 @@ package body Bindo.Augmentors is
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;

8
gcc/ada/bindo-augmentors.ads
View File

@@ -43,10 +43,10 @@ package Bindo.Augmentors is
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.

36
gcc/ada/bindo-builders.adb
View File

@@ -415,10 +415,11 @@ package body Bindo.Builders is
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;
-------------------------
@@ -497,10 +498,11 @@ package body Bindo.Builders is
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.
@@ -570,12 +572,13 @@ package body Bindo.Builders is
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
@@ -597,10 +600,11 @@ package body Bindo.Builders is
-- 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;
-----------------------

90
gcc/ada/bindo-diagnostics.adb
View File

@@ -23,9 +23,11 @@
-- --
------------------------------------------------------------------------------
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;
@@ -77,13 +79,6 @@ package body Bindo.Diagnostics is
-- 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;
@@ -192,6 +187,13 @@ package body Bindo.Diagnostics is
-- 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;
@@ -522,30 +524,6 @@ package body Bindo.Diagnostics is
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 --
--------------------------------------
@@ -1155,6 +1133,48 @@ package body Bindo.Diagnostics is
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 --
----------------------------------
@@ -1257,7 +1277,7 @@ package body Bindo.Diagnostics is
-- Output general purpose suggestions
Output_Dynamic_Model_Suggestions
Output_Invocation_Related_Suggestions
(G => G,
Cycle => Cycle);

17
gcc/ada/bindo-elaborators.adb
View File

@@ -180,20 +180,11 @@ package body Bindo.Elaborators is
-- 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;
@@ -917,8 +908,8 @@ package body Bindo.Elaborators is
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;

230
gcc/ada/bindo-graphs.adb
View File

@@ -1058,15 +1058,17 @@ package body Bindo.Graphs is
-- 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;
@@ -1078,6 +1080,14 @@ package body Bindo.Graphs is
-- 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;
@@ -1306,6 +1316,13 @@ package body Bindo.Graphs is
-- 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;
@@ -1491,6 +1508,23 @@ package body Bindo.Graphs is
-- 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 --
-------------------------------
@@ -1533,20 +1567,22 @@ package body Bindo.Graphs is
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
@@ -1623,10 +1659,11 @@ package body Bindo.Graphs is
--------------
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);
@@ -1636,13 +1673,15 @@ package body Bindo.Graphs is
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;
--------------------------
@@ -1650,10 +1689,11 @@ package body Bindo.Graphs is
--------------------------
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));
@@ -1691,7 +1731,9 @@ package body Bindo.Graphs is
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
@@ -1785,6 +1827,43 @@ package body Bindo.Graphs is
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 --
--------------------------
@@ -1848,76 +1927,54 @@ package body Bindo.Graphs is
(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
return
At_Least_One_Edge_Satisfies
(G => G,
Cycle => Cycle,
Predicate => Is_Static_Successor_Edge'Access);
end Contains_Static_Successor_Edge;
Seen := False;
------------------------------
-- Contains_Task_Activation --
------------------------------
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- edges of the cycle.
function Contains_Task_Activation
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
Iter := Iterate_Edges_Of_Cycle (G, Cycle);
while Has_Next (Iter) loop
Next (Iter, Edge);
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;
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 --
@@ -3632,6 +3689,23 @@ package body Bindo.Graphs is
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 --
----------------------------------

52
gcc/ada/bindo-graphs.ads
View File

@@ -732,18 +732,33 @@ package Bindo.Graphs is
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;
@@ -895,6 +910,12 @@ package Bindo.Graphs is
-- 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;
@@ -987,13 +1008,21 @@ package Bindo.Graphs is
-- 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
@@ -1439,13 +1468,18 @@ package Bindo.Graphs is
-- 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);

18
gcc/ada/bindo.ads
View File

@@ -31,6 +31,14 @@ with Namet; use Namet;
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);
@@ -41,14 +49,4 @@ package Bindo is
-- 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;

17
gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst
View File

@@ -1014,6 +1014,23 @@ following tactics to eliminate the circularity:
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
::

23
gcc/ada/gnat_ugn.texi
View File

@@ -28457,6 +28457,29 @@ declared in the spec by elaboration code in the body.
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