[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

1 files changed, 39 insertions, 0 deletions

diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb
index 387d969f74e..5443b790e37 100644
--- a/gcc/ada/bindo-graphs.adb
+++ b/gcc/ada/bindo-graphs.adb
@@ -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 --
       ------------------------------------