Commit 47bcd81f by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Diagnostics for Elaboration order v4.0

This patch adds a missing case to the output of cycle diagnostics here a
transition from an Elaborate_Body pair may reach a destination which is
in the context of an active Elaborate_All.

2019-07-08  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* bindo-diagnostics.adb (Diagnose_Cycle): Capture the presence
	of an Elaborate_All edge before iterating over the edges of the
	cycle.
	(Output_Elaborate_Body_Transition): Update the parameter profile
	and the comment on usage. Add a missing case where the edge is
	within the context of an Elaborate_All.
	(Output_Transition): Update the call to
	Output_Elaborate_Body_Transition.
	* bindo-graphs.ads, bindo-graphs.adb
	(Contains_Elaborate_All_Edge): New routine.

From-SVN: r273217
parent 56730418
2019-07-08 Hristian Kirtchev <kirtchev@adacore.com>
* bindo-diagnostics.adb (Diagnose_Cycle): Capture the presence
of an Elaborate_All edge before iterating over the edges of the
cycle.
(Output_Elaborate_Body_Transition): Update the parameter profile
and the comment on usage. Add a missing case where the edge is
within the context of an Elaborate_All.
(Output_Transition): Update the call to
Output_Elaborate_Body_Transition.
* bindo-graphs.ads, bindo-graphs.adb
(Contains_Elaborate_All_Edge): New routine.
2019-07-08 Piotr Trojanek <trojanek@adacore.com>
* lib-xref-spark_specific.adb (Create_Heap): Set dummy Etype for
......
......@@ -115,13 +115,15 @@ package body Bindo.Diagnostics is
(G : Library_Graph;
Source : Library_Graph_Vertex_Id;
Actual_Destination : Library_Graph_Vertex_Id;
Expected_Destination : Library_Graph_Vertex_Id);
Expected_Destination : Library_Graph_Vertex_Id;
Elaborate_All_Active : Boolean);
pragma Inline (Output_Elaborate_Body_Transition);
-- Output a transition through an edge of library graph G with successor
-- Source and predecessor Actual_Destination. Vertex Source is either a
-- spec subject to pragma Elaborate_Body or denotes the body of such a
-- spec. Expected_Destination denotes the predecessor as specified by the
-- next edge in a cycle.
-- Source and predecessor Actual_Destination. Vertex Source is either
-- a spec subject to pragma Elaborate_Body or denotes the body of such
-- a spec. Expected_Destination denotes the predecessor as specified by
-- the next edge in a cycle. Elaborate_All_Active should be set when the
-- transition occurs within a cycle that involves an Elaborate_All edge.
procedure Output_Elaborate_Suggestions
(G : Library_Graph;
......@@ -160,7 +162,8 @@ package body Bindo.Diagnostics is
-- Output a transition through a Forced edge of library graph G with
-- successor Source and predecessor Actual_Destination. Parameter
-- Expected_Destination denotes the predecessor as specified by the
-- next edge in a cycle.
-- next edge in a cycle. Elaborate_All_Active should be set when the
-- transition occurs within a cycle that involves an Elaborate_All edge.
procedure Output_Full_Encoding_Suggestions
(G : Library_Graph;
......@@ -328,18 +331,21 @@ package body Bindo.Diagnostics is
Lib_Graph : Library_Graph;
Cycle : Library_Graph_Cycle_Id)
is
Current_Edge : Library_Graph_Edge_Id;
Elaborate_All_Active : Boolean;
First_Edge : Library_Graph_Edge_Id;
Iter : Edges_Of_Cycle_Iterator;
Next_Edge : Library_Graph_Edge_Id;
begin
pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (Cycle));
Elaborate_All_Active := False;
Elaborate_All_Active : constant Boolean :=
Contains_Elaborate_All_Edge
(G => Lib_Graph,
Cycle => Cycle);
Current_Edge : Library_Graph_Edge_Id;
First_Edge : Library_Graph_Edge_Id;
Iter : Edges_Of_Cycle_Iterator;
Next_Edge : Library_Graph_Edge_Id;
begin
First_Edge := No_Library_Graph_Edge;
-- Inspect the edges of the cycle in pairs, emitting diagnostics based
......@@ -355,11 +361,6 @@ package body Bindo.Diagnostics is
Next (Iter, Current_Edge);
First_Edge := Current_Edge;
Elaborate_All_Active :=
Is_Elaborate_All_Edge
(G => Lib_Graph,
Edge => First_Edge);
Output_Reason_And_Circularity_Header
(G => Lib_Graph,
First_Edge => First_Edge);
......@@ -374,12 +375,6 @@ package body Bindo.Diagnostics is
-- taking into account the predecessors and successors involved, as
-- well as the nature of the edge.
Elaborate_All_Active :=
Elaborate_All_Active
or else Is_Elaborate_All_Edge
(G => Lib_Graph,
Edge => Current_Edge);
Output_Transition
(Inv_Graph => Inv_Graph,
Lib_Graph => Lib_Graph,
......@@ -590,7 +585,7 @@ package body Bindo.Diagnostics is
pragma Assert (Present (Expected_Destination));
-- The actual and expected destination vertices match, and denote the
-- spec of a unit.
-- initial declaration of a unit.
--
-- Elaborate_All Actual_Destination
-- Source ---------------> spec -->
......@@ -668,7 +663,8 @@ package body Bindo.Diagnostics is
(G : Library_Graph;
Source : Library_Graph_Vertex_Id;
Actual_Destination : Library_Graph_Vertex_Id;
Expected_Destination : Library_Graph_Vertex_Id)
Expected_Destination : Library_Graph_Vertex_Id;
Elaborate_All_Active : Boolean)
is
begin
pragma Assert (Present (G));
......@@ -676,20 +672,17 @@ package body Bindo.Diagnostics is
pragma Assert (Present (Actual_Destination));
pragma Assert (Present (Expected_Destination));
-- The actual and expected destination vertices match, and denote the
-- spec or body of a unit subject to pragma Elaborate_Body. There is no
-- need to mention the pragma because it does not affect the path of the
-- cycle. Treat the edge as a regular with edge.
-- The actual and expected destination vertices match
--
-- Actual_Destination
-- Source --> spec Elaborate_Body -->
-- Expected_Destination
-- Actual_Destination
-- Source --------> spec -->
-- Elaborate_Body Expected_Destination
--
-- spec Elaborate_Body
-- spec
--
-- Actual_Destination
-- Source --> body -->
-- Expected_Destination
-- Actual_Destination
-- Source --------> body -->
-- Elaborate_Body Expected_Destination
if Actual_Destination = Expected_Destination then
Error_Msg_Unit_1 := Name (G, Source);
......@@ -697,16 +690,40 @@ package body Bindo.Diagnostics is
Error_Msg_Info
(" unit $ has with clause for unit $");
-- The actual destination vertex denotes the spec of a unit while the
-- expected destination is the corresponding body, and the unit is in
-- the closure of an earlier Elaborate_All pragma.
--
-- Actual_Destination
-- Source --------> spec
-- Elaborate_Body
-- body -->
-- Expected_Destination
elsif Elaborate_All_Active then
pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
pragma Assert
(Proper_Body (G, Actual_Destination) = Expected_Destination);
Error_Msg_Unit_1 := Name (G, Source);
Error_Msg_Unit_2 := Name (G, Actual_Destination);
Error_Msg_Info
(" unit $ has with clause for unit $");
Error_Msg_Unit_1 := Name (G, Expected_Destination);
Error_Msg_Info
(" unit $ is in the closure of pragma Elaborate_All");
-- Otherwise the actual destination vertex is the spec of a unit subject
-- to pragma Elaborate_Body and the expected destination vertex is the
-- completion body. The pragma must be mentioned because it directs the
-- path of the cycle from the spec to the body.
--
-- Actual_Destination
-- Source --> spec Elaborate_Body
-- completion body.
--
-- body -->
-- Expected_Destination
-- Actual_Destination
-- Source --------> spec Elaborate_Body
-- Elaborate_Body
-- body -->
-- Expected_Destination
else
pragma Assert
......@@ -769,7 +786,7 @@ package body Bindo.Diagnostics is
pragma Assert (Present (Expected_Destination));
-- The actual and expected destination vertices match, and denote the
-- spec of a unit.
-- initial declaration of a unit.
--
-- Elaborate Actual_Destination
-- Source -----------> spec -->
......@@ -876,8 +893,7 @@ package body Bindo.Diagnostics is
pragma Assert (Present (Actual_Destination));
pragma Assert (Present (Expected_Destination));
-- The actual and expected destination vertices match, and denote the
-- spec of a unit.
-- The actual and expected destination vertices match
--
-- Forced Actual_Destination
-- Source --------> spec -->
......@@ -1291,7 +1307,8 @@ package body Bindo.Diagnostics is
(G => Lib_Graph,
Source => Source,
Actual_Destination => Actual_Destination,
Expected_Destination => Expected_Destination);
Expected_Destination => Expected_Destination,
Elaborate_All_Active => Elaborate_All_Active);
elsif Is_Elaborate_Edge (Lib_Graph, Current_Edge) then
Output_Elaborate_Transition
......@@ -1345,7 +1362,7 @@ package body Bindo.Diagnostics is
pragma Assert (Present (Expected_Destination));
-- The actual and expected destination vertices match, and denote the
-- spec of a unit.
-- initial declaration of a unit.
--
-- with Actual_Destination
-- Source ------> spec -->
......
......@@ -1840,6 +1840,45 @@ package body Bindo.Graphs is
return DG.Component (G.Graph, Vertex);
end Component;
---------------------------------
-- Contains_Elaborate_All_Edge --
---------------------------------
function Contains_Elaborate_All_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 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;
end Contains_Elaborate_All_Edge;
------------------------------------
-- Contains_Weak_Static_Successor --
------------------------------------
......
......@@ -980,6 +980,13 @@ package Bindo.Graphs is
--
-- This behavior can be forced by setting flag Force_Complement to True.
function Contains_Elaborate_All_Edge
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean;
pragma Inline (Contains_Elaborate_All_Edge);
-- Determine whether cycle Cycle of library graph G contains an
-- Elaborate_All edge.
function Contains_Weak_Static_Successor
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment