[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

gcc/ada/ChangeLog

+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

gcc/ada/bindo-diagnostics.adb

@@ -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 -->

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 --
       ------------------------------------

gcc/ada/bindo-graphs.ads

@@ -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;