------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                     B I N D O . D I A G N O S T I C S                    --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 2019, Free Software Foundation, Inc.           --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

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;
use  Bindo.Validators.Cycle_Validators;

with Bindo.Writers;
use  Bindo.Writers;
use  Bindo.Writers.Cycle_Writers;
use  Bindo.Writers.Phase_Writers;

package body Bindo.Diagnostics is

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Diagnose_All_Cycles
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph);
   pragma Inline (Diagnose_All_Cycles);
   --  Emit diagnostics for all cycles of library graph G

   procedure Diagnose_Cycle
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Cycle     : Library_Graph_Cycle_Id);
   pragma Inline (Diagnose_Cycle);
   --  Emit diagnostics for cycle Cycle of library graph G

   procedure Find_And_Output_Invocation_Paths
     (Inv_Graph   : Invocation_Graph;
      Lib_Graph   : Library_Graph;
      Source      : Library_Graph_Vertex_Id;
      Destination : Library_Graph_Vertex_Id);
   pragma Inline (Find_And_Output_Invocation_Paths);
   --  Find all paths in invocation graph Inv_Graph that originate from vertex
   --  Source and reach vertex Destination of library graph Lib_Graph. Output
   --  the transitions of each such path.

   function Find_Elaboration_Root
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id;
   pragma Inline (Find_Elaboration_Root);
   --  Find the elaboration root in invocation graph Inv_Graph that corresponds
   --  to vertex Vertex of library graph Lib_Graph.

   procedure Output_All_Cycles_Suggestions (G : Library_Graph);
   pragma Inline (Output_All_Cycles_Suggestions);
   --  Suggest the diagnostic of all cycles in library graph G if circumstances
   --  allow it.

   procedure Output_Elaborate_All_Suggestions
     (G    : Library_Graph;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id);
   pragma Inline (Output_Elaborate_All_Suggestions);
   --  Suggest ways to break a cycle that involves an Elaborate_All edge that
   --  links predecessor Pred and successor Succ of library graph G.

   procedure Output_Elaborate_All_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id);
   pragma Inline (Output_Elaborate_All_Transition);
   --  Output a transition through an Elaborate_All 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.

   procedure Output_Elaborate_Body_Suggestions
     (G    : Library_Graph;
      Succ : Library_Graph_Vertex_Id);
   pragma Inline (Output_Elaborate_Body_Suggestions);
   --  Suggest ways to break a cycle that involves an edge where successor Succ
   --  is either a spec subject to pragma Elaborate_Body or the body of such a
   --  spec.

   procedure Output_Elaborate_Body_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_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. 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;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id);
   pragma Inline (Output_Elaborate_Suggestions);
   --  Suggest ways to break a cycle that involves an Elaborate edge that links
   --  predecessor Pred and successor Succ of library graph G.

   procedure Output_Elaborate_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id);
   pragma Inline (Output_Elaborate_Transition);
   --  Output a transition through an Elaborate 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.

   procedure Output_Forced_Suggestions
     (G    : Library_Graph;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id);
   pragma Inline (Output_Forced_Suggestions);
   --  Suggest ways to break a cycle that involves a Forced edge that links
   --  predecessor Pred with successor Succ of library graph G.

   procedure Output_Forced_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id;
      Elaborate_All_Active : Boolean);
   pragma Inline (Output_Forced_Transition);
   --  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. 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;
      Cycle      : Library_Graph_Cycle_Id;
      First_Edge : Library_Graph_Edge_Id);
   pragma Inline (Output_Full_Encoding_Suggestions);
   --  Suggest the use of the full path invocation graph encoding to break
   --  cycle Cycle with initial edge First_Edge of library graph G.

   procedure Output_Invocation_Path
     (Inv_Graph         : Invocation_Graph;
      Lib_Graph         : Library_Graph;
      Elaborated_Vertex : Library_Graph_Vertex_Id;
      Path              : IGE_Lists.Doubly_Linked_List;
      Path_Id           : in out Nat);
   pragma Inline (Output_Invocation_Path);
   --  Output path Path, which consists of invocation graph Inv_Graph edges.
   --  Elaborated_Vertex is the vertex of library graph Lib_Graph whose
   --  elaboration initiated the path. Path_Id is the unique id of the path.

   procedure Output_Invocation_Path_Transition
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Edge      : Invocation_Graph_Edge_Id);
   pragma Inline (Output_Invocation_Path_Transition);
   --  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;
      Source      : Library_Graph_Vertex_Id;
      Destination : Library_Graph_Vertex_Id);
   pragma Inline (Output_Invocation_Transition);
   --  Output a transition through an invocation edge of library graph G with
   --  successor Source and predecessor Destination. Inv_Graph is the related
   --  invocation graph.

   procedure Output_Reason_And_Circularity_Header
     (G          : Library_Graph;
      First_Edge : Library_Graph_Edge_Id);
   pragma Inline (Output_Reason_And_Circularity_Header);
   --  Output the reason and circularity header for a circularity of library
   --  graph G with initial edge First_Edge.

   procedure Output_Suggestions
     (G          : Library_Graph;
      Cycle      : Library_Graph_Cycle_Id;
      First_Edge : Library_Graph_Edge_Id);
   pragma Inline (Output_Suggestions);
   --  Suggest various ways to break cycle Cycle with initial edge First_Edge
   --  of library graph G.

   procedure Output_Transition
     (Inv_Graph            : Invocation_Graph;
      Lib_Graph            : Library_Graph;
      Current_Edge         : Library_Graph_Edge_Id;
      Next_Edge            : Library_Graph_Edge_Id;
      Elaborate_All_Active : Boolean);
   pragma Inline (Output_Transition);
   --  Output a transition described by edge Current_Edge, which is followed by
   --  edge Next_Edge of library graph Lib_Graph. Inv_Graph denotes the related
   --  invocation graph. Elaborate_All_Active should be set when the transition
   --  occurs within a cycle that involves an Elaborate_All edge.

   procedure Output_With_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id;
      Elaborate_All_Active : Boolean);
   pragma Inline (Output_With_Transition);
   --  Output a transition through a regular with 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. Elaborate_All_Active should be set when the transition
   --  occurs within a cycle that involves an Elaborate_All edge.

   procedure Visit_Vertex
     (Inv_Graph         : Invocation_Graph;
      Lib_Graph         : Library_Graph;
      Invoker           : Invocation_Graph_Vertex_Id;
      Invoker_Vertex    : Library_Graph_Vertex_Id;
      Last_Vertex       : Library_Graph_Vertex_Id;
      Elaborated_Vertex : Library_Graph_Vertex_Id;
      End_Vertex        : Library_Graph_Vertex_Id;
      Visited_Invokers  : IGV_Sets.Membership_Set;
      Path              : IGE_Lists.Doubly_Linked_List;
      Path_Id           : in out Nat);
   pragma Inline (Visit_Vertex);
   --  Visit invocation graph vertex Invoker that resides in library graph
   --  vertex Invoker_Vertex as part of a DFS traversal. Last_Vertex denotes
   --  the previous vertex in the traversal. Elaborated_Vertex is the vertex
   --  whose elaboration started the traversal. End_Vertex is the vertex that
   --  terminates the traversal. Visited_Invoker is the set of all invokers
   --  visited so far. All edges along the path are recorded in Path. Path_Id
   --  is the id of the path.

   -------------------------
   -- Diagnose_All_Cycles --
   -------------------------

   procedure Diagnose_All_Cycles
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph)
   is
      Cycle : Library_Graph_Cycle_Id;
      Iter  : All_Cycle_Iterator;

   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));

      Iter := Iterate_All_Cycles (Lib_Graph);
      while Has_Next (Iter) loop
         Next (Iter, Cycle);

         Diagnose_Cycle
           (Inv_Graph => Inv_Graph,
            Lib_Graph => Lib_Graph,
            Cycle     => Cycle);
      end loop;
   end Diagnose_All_Cycles;

   ----------------------------
   -- Diagnose_Circularities --
   ----------------------------

   procedure Diagnose_Circularities
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph)
   is
   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));

      --  Find, validate, and output all cycles of the library graph

      Find_Cycles     (Lib_Graph);
      Validate_Cycles (Lib_Graph);
      Write_Cycles    (Lib_Graph);

      --  Diagnose all cycles in the graph regardless of their importance when
      --  switch -d_C (diagnose all cycles) is in effect.

      if Debug_Flag_Underscore_CC then
         Diagnose_All_Cycles (Inv_Graph, Lib_Graph);

      --  Otherwise diagnose the most important cycle in the graph

      else
         Diagnose_Cycle
           (Inv_Graph => Inv_Graph,
            Lib_Graph => Lib_Graph,
            Cycle     => Highest_Precedence_Cycle (Lib_Graph));
      end if;
   end Diagnose_Circularities;

   --------------------
   -- Diagnose_Cycle --
   --------------------

   procedure Diagnose_Cycle
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Cycle     : Library_Graph_Cycle_Id)
   is
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Cycle));

      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
      Start_Phase (Cycle_Diagnostics);

      First_Edge := No_Library_Graph_Edge;

      --  Inspect the edges of the cycle in pairs, emitting diagnostics based
      --  on their successors and predecessors.

      Iter := Iterate_Edges_Of_Cycle (Lib_Graph, Cycle);
      while Has_Next (Iter) loop

         --  Emit the reason for the cycle using the initial edge, which is the
         --  most important edge in the cycle.

         if not Present (First_Edge) then
            Next (Iter, Current_Edge);

            First_Edge := Current_Edge;
            Output_Reason_And_Circularity_Header
              (G          => Lib_Graph,
               First_Edge => First_Edge);
         end if;

         --  Obtain the other edge of the pair

         exit when not Has_Next (Iter);
         Next (Iter, Next_Edge);

         --  Describe the transition from the current edge to the next edge by
         --  taking into account the predecessors and successors involved, as
         --  well as the nature of the edge.

         Output_Transition
           (Inv_Graph            => Inv_Graph,
            Lib_Graph            => Lib_Graph,
            Current_Edge         => Current_Edge,
            Next_Edge            => Next_Edge,
            Elaborate_All_Active => Elaborate_All_Active);

         Current_Edge := Next_Edge;
      end loop;

      --  Describe the transition from the last edge to the first edge

      Output_Transition
        (Inv_Graph            => Inv_Graph,
         Lib_Graph            => Lib_Graph,
         Current_Edge         => Current_Edge,
         Next_Edge            => First_Edge,
         Elaborate_All_Active => Elaborate_All_Active);

      --  Suggest various alternatives for breaking the cycle

      Output_Suggestions
        (G          => Lib_Graph,
         Cycle      => Cycle,
         First_Edge => First_Edge);

      End_Phase (Cycle_Diagnostics);
   end Diagnose_Cycle;

   --------------------------------------
   -- Find_And_Output_Invocation_Paths --
   --------------------------------------

   procedure Find_And_Output_Invocation_Paths
     (Inv_Graph   : Invocation_Graph;
      Lib_Graph   : Library_Graph;
      Source      : Library_Graph_Vertex_Id;
      Destination : Library_Graph_Vertex_Id)
   is
      Path    : IGE_Lists.Doubly_Linked_List;
      Path_Id : Nat;
      Visited : IGV_Sets.Membership_Set;

   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Source));
      pragma Assert (Present (Destination));

      --  Nothing to do when the invocation graph encoding format of the source
      --  vertex does not contain detailed information about invocation paths.

      if Invocation_Graph_Encoding (Lib_Graph, Source) /=
           Full_Path_Encoding
      then
         return;
      end if;

      Path    := IGE_Lists.Create;
      Path_Id := 1;
      Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));

      --  Start a DFS traversal over the invocation graph, in an attempt to
      --  reach Destination from Source. The actual start of the path is the
      --  elaboration root invocation vertex that corresponds to the Source.
      --  Each unique path is emitted as part of the current cycle diagnostic.

      Visit_Vertex
        (Inv_Graph         => Inv_Graph,
         Lib_Graph         => Lib_Graph,
         Invoker           =>
           Find_Elaboration_Root
             (Inv_Graph => Inv_Graph,
              Lib_Graph => Lib_Graph,
              Vertex    => Source),
         Invoker_Vertex    => Source,
         Last_Vertex       => Source,
         Elaborated_Vertex => Source,
         End_Vertex        => Destination,
         Visited_Invokers  => Visited,
         Path              => Path,
         Path_Id           => Path_Id);

      IGE_Lists.Destroy (Path);
      IGV_Sets.Destroy  (Visited);
   end Find_And_Output_Invocation_Paths;

   ---------------------------
   -- Find_Elaboration_Root --
   ---------------------------

   function Find_Elaboration_Root
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Vertex    : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id
   is
      Current_Vertex : Invocation_Graph_Vertex_Id;
      Iter           : Elaboration_Root_Iterator;
      Root_Vertex    : Invocation_Graph_Vertex_Id;

   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Vertex));

      --  Assume that the vertex does not have a corresponding elaboration root

      Root_Vertex := No_Invocation_Graph_Vertex;

      --  Inspect all elaboration roots trying to find the one that resides in
      --  the input vertex.
      --
      --  IMPORTANT:
      --
      --    * The iterator must run to completion in order to unlock the
      --      invocation graph.

      Iter := Iterate_Elaboration_Roots (Inv_Graph);
      while Has_Next (Iter) loop
         Next (Iter, Current_Vertex);

         if not Present (Root_Vertex)
           and then Body_Vertex (Inv_Graph, Current_Vertex) = Vertex
         then
            Root_Vertex := Current_Vertex;
         end if;
      end loop;

      return Root_Vertex;
   end Find_Elaboration_Root;

   -----------------------------------
   -- Output_All_Cycles_Suggestions --
   -----------------------------------

   procedure Output_All_Cycles_Suggestions (G : Library_Graph) is
   begin
      pragma Assert (Present (G));

      --  The library graph contains at least one cycle and only the highest
      --  priority cycle was diagnosed. Diagnosing all cycles may yield extra
      --  information for decision making.

      if Number_Of_Cycles (G) > 1 and then not Debug_Flag_Underscore_CC then
         Error_Msg_Info
           ("    diagnose all circularities (binder switch -d_C)");
      end if;
   end Output_All_Cycles_Suggestions;

   --------------------------------------
   -- Output_Elaborate_All_Suggestions --
   --------------------------------------

   procedure Output_Elaborate_All_Suggestions
     (G    : Library_Graph;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Pred));
      pragma Assert (Present (Succ));

      Error_Msg_Unit_1 := Name (G, Pred);
      Error_Msg_Unit_2 := Name (G, Succ);
      Error_Msg_Info
        ("    change pragma Elaborate_All for unit $ to Elaborate in unit $");
      Error_Msg_Info
        ("    remove pragma Elaborate_All for unit $ in unit $");
   end Output_Elaborate_All_Suggestions;

   -------------------------------------
   -- Output_Elaborate_All_Transition --
   -------------------------------------

   procedure Output_Elaborate_All_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Source));
      pragma Assert (Present (Actual_Destination));
      pragma Assert (Present (Expected_Destination));

      --  The actual and expected destination vertices match, and denote the
      --  initial declaration of a unit.
      --
      --            Elaborate_All   Actual_Destination
      --    Source ---------------> spec -->
      --                            Expected_Destination
      --
      --            Elaborate_All   Actual_Destination
      --    Source ---------------> stand-alone body -->
      --                            Expected_Destination

      if Actual_Destination = Expected_Destination then
         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Actual_Destination);
         Error_Msg_Info
           ("    unit $ has with clause and pragma Elaborate_All for unit $");

      --  Otherwise the actual destination vertex denotes the spec of a unit,
      --  while the expected destination is the corresponding body.
      --
      --            Elaborate_All   Actual_Destination
      --    Source ---------------> spec
      --
      --                            body -->
      --                            Expected_Destination

      else
         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 and pragma Elaborate_All for unit $");

         Error_Msg_Unit_1 := Name (G, Expected_Destination);
         Error_Msg_Info
           ("    unit $ is in the closure of pragma Elaborate_All");
      end if;
   end Output_Elaborate_All_Transition;

   ---------------------------------------
   -- Output_Elaborate_Body_Suggestions --
   ---------------------------------------

   procedure Output_Elaborate_Body_Suggestions
     (G    : Library_Graph;
      Succ : Library_Graph_Vertex_Id)
   is
      Spec : Library_Graph_Vertex_Id;

   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Succ));

      --  Find the initial declaration of the unit because it is the one
      --  subject to pragma Elaborate_Body.

      if Is_Body_With_Spec (G, Succ) then
         Spec := Proper_Spec (G, Succ);
      else
         Spec := Succ;
      end if;

      Error_Msg_Unit_1 := Name (G, Spec);
      Error_Msg_Info
        ("    remove pragma Elaborate_Body in unit $");
   end Output_Elaborate_Body_Suggestions;

   --------------------------------------
   -- Output_Elaborate_Body_Transition --
   --------------------------------------

   procedure Output_Elaborate_Body_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id;
      Elaborate_All_Active : Boolean)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Source));
      pragma Assert (Present (Actual_Destination));
      pragma Assert (Present (Expected_Destination));

      --  The actual and expected destination vertices match
      --
      --                     Actual_Destination
      --    Source --------> spec -->
      --    Elaborate_Body   Expected_Destination
      --
      --                     spec
      --
      --                     Actual_Destination
      --    Source --------> body -->
      --    Elaborate_Body   Expected_Destination

      if Actual_Destination = Expected_Destination then
         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Actual_Destination);
         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.
      --
      --                     Actual_Destination
      --    Source --------> spec Elaborate_Body
      --    Elaborate_Body
      --                     body -->
      --                     Expected_Destination

      else
         pragma Assert
           (Is_Elaborate_Body_Pair
             (G           => G,
              Spec_Vertex => Actual_Destination,
              Body_Vertex => 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, Actual_Destination);
         Error_Msg_Info
           ("    unit $ is subject to pragma Elaborate_Body");

         Error_Msg_Unit_1 := Name (G, Expected_Destination);
         Error_Msg_Info
           ("    unit $ is in the closure of pragma Elaborate_Body");
      end if;
   end Output_Elaborate_Body_Transition;

   ----------------------------------
   -- Output_Elaborate_Suggestions --
   ----------------------------------

   procedure Output_Elaborate_Suggestions
     (G    : Library_Graph;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Pred));
      pragma Assert (Present (Succ));

      Error_Msg_Unit_1 := Name (G, Pred);
      Error_Msg_Unit_2 := Name (G, Succ);
      Error_Msg_Info
        ("    remove pragma Elaborate for unit $ in unit $");
   end Output_Elaborate_Suggestions;

   ---------------------------------
   -- Output_Elaborate_Transition --
   ---------------------------------

   procedure Output_Elaborate_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id)
   is
      Spec : Library_Graph_Vertex_Id;

   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Source));
      pragma Assert (Present (Actual_Destination));
      pragma Assert (Present (Expected_Destination));

      --  The actual and expected destination vertices match, and denote the
      --  initial declaration of a unit.
      --
      --            Elaborate   Actual_Destination
      --    Source -----------> spec -->
      --                        Expected_Destination
      --
      --            Elaborate   Actual_Destination
      --    Source -----------> stand-alone body -->
      --                        Expected_Destination
      --
      --  The processing of pragma Elaborate body generates an edge between a
      --  successor and predecessor body.
      --
      --                        spec
      --
      --            Elaborate   Actual_Destination
      --    Source -----------> body -->
      --                        Expected_Destination

      if Actual_Destination = Expected_Destination then

         --  Find the initial declaration of the unit because it is the one
         --  subject to pragma Elaborate.

         if Is_Body_With_Spec (G, Actual_Destination) then
            Spec := Proper_Spec (G, Actual_Destination);
         else
            Spec := Actual_Destination;
         end if;

         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Spec);
         Error_Msg_Info
           ("    unit $ has with clause and pragma Elaborate for unit $");

         if Actual_Destination /= Spec then
            Error_Msg_Unit_1 := Name (G, Actual_Destination);
            Error_Msg_Info
              ("    unit $ is in the closure of pragma Elaborate");
         end if;

      --  Otherwise the actual destination vertex denotes the spec of a unit
      --  while the expected destination vertex is the corresponding body.
      --
      --            Elaborate   Actual_Destination
      --    Source -----------> spec
      --
      --                        body -->
      --                        Expected_Destination

      else
         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 and pragma Elaborate for unit $");

         Error_Msg_Unit_1 := Name (G, Expected_Destination);
         Error_Msg_Info
           ("    unit $ is in the closure of pragma Elaborate");
      end if;
   end Output_Elaborate_Transition;

   -------------------------------
   -- Output_Forced_Suggestions --
   -------------------------------

   procedure Output_Forced_Suggestions
     (G    : Library_Graph;
      Pred : Library_Graph_Vertex_Id;
      Succ : Library_Graph_Vertex_Id)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Pred));
      pragma Assert (Present (Succ));

      Error_Msg_Unit_1 := Name (G, Succ);
      Error_Msg_Unit_2 := Name (G, Pred);
      Error_Msg_Info
        ("    remove the dependency of unit $ on unit $ from the argument of "
         & "switch -f");
      Error_Msg_Info
        ("    remove switch -f");
   end Output_Forced_Suggestions;

   ------------------------------
   -- Output_Forced_Transition --
   ------------------------------

   procedure Output_Forced_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id;
      Elaborate_All_Active : Boolean)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Source));
      pragma Assert (Present (Actual_Destination));
      pragma Assert (Present (Expected_Destination));

      --  The actual and expected destination vertices match
      --
      --            Forced   Actual_Destination
      --    Source --------> spec -->
      --                     Expected_Destination
      --
      --            Forced   Actual_Destination
      --    Source --------> body -->
      --                     Expected_Destination

      if Actual_Destination = Expected_Destination then
         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Actual_Destination);
         Error_Msg_Info
           ("    unit $ has a dependency on unit $ forced by -f switch");

      --  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.
      --
      --            Forced   Actual_Destination
      --    Source --------> spec
      --
      --                     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 a dependency on unit $ forced by -f switch");

         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 denotes a spec subject to
      --  pragma Elaborate_Body while the expected destination denotes the
      --  corresponding body.
      --
      --            Forced   Actual_Destination
      --    Source --------> spec Elaborate_Body
      --
      --                     body -->
      --                     Expected_Destination

      else
         pragma Assert
           (Is_Elaborate_Body_Pair
             (G           => G,
              Spec_Vertex => Actual_Destination,
              Body_Vertex => Expected_Destination));

         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Actual_Destination);
         Error_Msg_Info
           ("    unit $ has a dependency on unit $ forced by -f switch");

         Error_Msg_Unit_1 := Name (G, Actual_Destination);
         Error_Msg_Info
           ("    unit $ is subject to pragma Elaborate_Body");

         Error_Msg_Unit_1 := Name (G, Expected_Destination);
         Error_Msg_Info
           ("    unit $ is in the closure of pragma Elaborate_Body");
      end if;
   end Output_Forced_Transition;

   --------------------------------------
   -- Output_Full_Encoding_Suggestions --
   --------------------------------------

   procedure Output_Full_Encoding_Suggestions
     (G          : Library_Graph;
      Cycle      : Library_Graph_Cycle_Id;
      First_Edge : Library_Graph_Edge_Id)
   is
      Succ : Library_Graph_Vertex_Id;

   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Cycle));
      pragma Assert (Present (First_Edge));

      if Is_Invocation_Edge (G, First_Edge) then
         Succ := Successor (G, First_Edge);

         if Invocation_Graph_Encoding (G, Succ) /= Full_Path_Encoding then
            Error_Msg_Info
              ("    use detailed invocation information (compiler switch "
               & "-gnatd_F)");
         end if;
      end if;
   end Output_Full_Encoding_Suggestions;

   ----------------------------
   -- Output_Invocation_Path --
   -----------------------------

   procedure Output_Invocation_Path
     (Inv_Graph         : Invocation_Graph;
      Lib_Graph         : Library_Graph;
      Elaborated_Vertex : Library_Graph_Vertex_Id;
      Path              : IGE_Lists.Doubly_Linked_List;
      Path_Id           : in out Nat)
   is
      Edge : Invocation_Graph_Edge_Id;
      Iter : IGE_Lists.Iterator;

   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Elaborated_Vertex));
      pragma Assert (IGE_Lists.Present (Path));

      Error_Msg_Nat_1 := Path_Id;
      Error_Msg_Info ("      path #:");

      Error_Msg_Unit_1 := Name (Lib_Graph, Elaborated_Vertex);
      Error_Msg_Info ("        elaboration of unit $");

      Iter := IGE_Lists.Iterate (Path);
      while IGE_Lists.Has_Next (Iter) loop
         IGE_Lists.Next (Iter, Edge);

         Output_Invocation_Path_Transition
           (Inv_Graph => Inv_Graph,
            Lib_Graph => Lib_Graph,
            Edge      => Edge);
      end loop;

      Path_Id := Path_Id + 1;
   end Output_Invocation_Path;

   ---------------------------------------
   -- Output_Invocation_Path_Transition --
   ---------------------------------------

   procedure Output_Invocation_Path_Transition
     (Inv_Graph : Invocation_Graph;
      Lib_Graph : Library_Graph;
      Edge      : Invocation_Graph_Edge_Id)
   is
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Edge));

      Declared : constant String := "declared at {:#:#";

      Targ        : constant Invocation_Graph_Vertex_Id :=
                      Target (Inv_Graph, Edge);
      Targ_Extra  : constant Name_Id                    :=
                      Extra (Inv_Graph, Edge);
      Targ_Vertex : constant Library_Graph_Vertex_Id    :=
                      Spec_Vertex (Inv_Graph, Targ);

   begin
      Error_Msg_Name_1 := Name   (Inv_Graph, Targ);
      Error_Msg_Nat_1  := Line   (Inv_Graph, Targ);
      Error_Msg_Nat_2  := Column (Inv_Graph, Targ);
      Error_Msg_File_1 := File_Name (Lib_Graph, Targ_Vertex);

      case Kind (Inv_Graph, Edge) is
         when Accept_Alternative =>
            Error_Msg_Info
              ("        selection of entry % "
               & Declared);

         when Access_Taken =>
            Error_Msg_Info
              ("        aliasing of subprogram % "
               & Declared);

         when Call =>
            Error_Msg_Info
              ("        call to subprogram % "
               & Declared);

         when Controlled_Adjustment
            | Internal_Controlled_Adjustment
         =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        adjustment actions for type % "
               & Declared);

         when Controlled_Finalization
            | Internal_Controlled_Finalization
         =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        finalization actions for type % "
               & Declared);

         when Controlled_Initialization
            | Internal_Controlled_Initialization
            | Type_Initialization
         =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        initialization actions for type % "
               & Declared);

         when Default_Initial_Condition_Verification =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        verification of Default_Initial_Condition for type % "
               & Declared);

         when Initial_Condition_Verification =>
            Error_Msg_Info
              ("        verification of Initial_Condition "
               & Declared);

         when Instantiation =>
            Error_Msg_Info
              ("        instantiation % "
               & Declared);

         when Invariant_Verification =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        verification of invariant for type % "
               & Declared);

         when Postcondition_Verification =>
            Error_Msg_Name_1 := Targ_Extra;
            Error_Msg_Info
              ("        verification of postcondition for subprogram % "
               & Declared);

         when Protected_Entry_Call =>
            Error_Msg_Info
              ("        call to protected entry % "
               & Declared);

         when Protected_Subprogram_Call =>
            Error_Msg_Info
              ("        call to protected subprogram % "
               & Declared);

         when Task_Activation =>
            Error_Msg_Info
              ("        activation of local task "
               & Declared);

         when Task_Entry_Call =>
            Error_Msg_Info
              ("        call to task entry % "
               & Declared);

         when others =>
            pragma Assert (False);
            null;
      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 --
   ----------------------------------

   procedure Output_Invocation_Transition
     (Inv_Graph   : Invocation_Graph;
      Lib_Graph   : Library_Graph;
      Source      : Library_Graph_Vertex_Id;
      Destination : Library_Graph_Vertex_Id)
   is
   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Source));
      pragma Assert (Present (Destination));

      Error_Msg_Unit_1 := Name (Lib_Graph, Source);
      Error_Msg_Unit_2 := Name (Lib_Graph, Destination);
      Error_Msg_Info
        ("    unit $ invokes a construct of unit $ at elaboration time");

      Find_And_Output_Invocation_Paths
        (Inv_Graph   => Inv_Graph,
         Lib_Graph   => Lib_Graph,
         Source      => Source,
         Destination => Destination);
   end Output_Invocation_Transition;

   ------------------------------------------
   -- Output_Reason_And_Circularity_Header --
   ------------------------------------------

   procedure Output_Reason_And_Circularity_Header
     (G          : Library_Graph;
      First_Edge : Library_Graph_Edge_Id)
   is
      pragma Assert (Present (G));
      pragma Assert (Present (First_Edge));

      Succ : constant Library_Graph_Vertex_Id := Successor (G, First_Edge);

   begin
      Error_Msg_Unit_1 := Name (G, Succ);
      Error_Msg      ("Elaboration circularity detected");
      Error_Msg_Info ("");
      Error_Msg_Info ("  Reason:");
      Error_Msg_Info ("");
      Error_Msg_Info ("    unit $ depends on its own elaboration");
      Error_Msg_Info ("");
      Error_Msg_Info ("  Circularity:");
      Error_Msg_Info ("");
   end Output_Reason_And_Circularity_Header;

   ------------------------
   -- Output_Suggestions --
   ------------------------

   procedure Output_Suggestions
     (G          : Library_Graph;
      Cycle      : Library_Graph_Cycle_Id;
      First_Edge : Library_Graph_Edge_Id)
   is
      pragma Assert (Present (G));
      pragma Assert (Present (Cycle));
      pragma Assert (Present (First_Edge));

      Pred : constant Library_Graph_Vertex_Id := Predecessor (G, First_Edge);
      Succ : constant Library_Graph_Vertex_Id := Successor   (G, First_Edge);

   begin
      Error_Msg_Info ("");
      Error_Msg_Info ("  Suggestions:");
      Error_Msg_Info ("");

      --  Output edge-specific suggestions

      if Is_Elaborate_All_Edge (G, First_Edge) then
         Output_Elaborate_All_Suggestions
           (G    => G,
            Pred => Pred,
            Succ => Succ);

      elsif Is_Elaborate_Body_Edge (G, First_Edge) then
         Output_Elaborate_Body_Suggestions
           (G    => G,
            Succ => Succ);

      elsif Is_Elaborate_Edge (G, First_Edge) then
         Output_Elaborate_Suggestions
           (G    => G,
            Pred => Pred,
            Succ => Succ);

      elsif Is_Forced_Edge (G, First_Edge) then
         Output_Forced_Suggestions
           (G    => G,
            Pred => Pred,
            Succ => Succ);
      end if;

      --  Output general purpose suggestions

      Output_Invocation_Related_Suggestions
        (G     => G,
         Cycle => Cycle);

      Output_Full_Encoding_Suggestions
        (G          => G,
         Cycle      => Cycle,
         First_Edge => First_Edge);

      Output_All_Cycles_Suggestions (G);

      Error_Msg_Info ("");
   end Output_Suggestions;

   -----------------------
   -- Output_Transition --
   -----------------------

   procedure Output_Transition
     (Inv_Graph            : Invocation_Graph;
      Lib_Graph            : Library_Graph;
      Current_Edge         : Library_Graph_Edge_Id;
      Next_Edge            : Library_Graph_Edge_Id;
      Elaborate_All_Active : Boolean)
   is
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Current_Edge));
      pragma Assert (Present (Next_Edge));

      Actual_Destination   : constant Library_Graph_Vertex_Id :=
                               Predecessor (Lib_Graph, Current_Edge);
      Expected_Destination : constant Library_Graph_Vertex_Id :=
                               Successor   (Lib_Graph, Next_Edge);
      Source               : constant Library_Graph_Vertex_Id :=
                               Successor   (Lib_Graph, Current_Edge);

   begin
      if Is_Elaborate_All_Edge (Lib_Graph, Current_Edge) then
         Output_Elaborate_All_Transition
           (G                    => Lib_Graph,
            Source               => Source,
            Actual_Destination   => Actual_Destination,
            Expected_Destination => Expected_Destination);

      elsif Is_Elaborate_Body_Edge (Lib_Graph, Current_Edge) then
         Output_Elaborate_Body_Transition
           (G                    => Lib_Graph,
            Source               => Source,
            Actual_Destination   => Actual_Destination,
            Expected_Destination => Expected_Destination,
            Elaborate_All_Active => Elaborate_All_Active);

      elsif Is_Elaborate_Edge (Lib_Graph, Current_Edge) then
         Output_Elaborate_Transition
           (G                    => Lib_Graph,
            Source               => Source,
            Actual_Destination   => Actual_Destination,
            Expected_Destination => Expected_Destination);

      elsif Is_Forced_Edge (Lib_Graph, Current_Edge) then
         Output_Forced_Transition
           (G                    => Lib_Graph,
            Source               => Source,
            Actual_Destination   => Actual_Destination,
            Expected_Destination => Expected_Destination,
            Elaborate_All_Active => Elaborate_All_Active);

      elsif Is_Invocation_Edge (Lib_Graph, Current_Edge) then
         Output_Invocation_Transition
           (Inv_Graph   => Inv_Graph,
            Lib_Graph   => Lib_Graph,
            Source      => Source,
            Destination => Expected_Destination);

      else
         pragma Assert (Is_With_Edge (Lib_Graph, Current_Edge));

         Output_With_Transition
           (G                    => Lib_Graph,
            Source               => Source,
            Actual_Destination   => Actual_Destination,
            Expected_Destination => Expected_Destination,
            Elaborate_All_Active => Elaborate_All_Active);
      end if;
   end Output_Transition;

   ----------------------------
   -- Output_With_Transition --
   ----------------------------

   procedure Output_With_Transition
     (G                    : Library_Graph;
      Source               : Library_Graph_Vertex_Id;
      Actual_Destination   : Library_Graph_Vertex_Id;
      Expected_Destination : Library_Graph_Vertex_Id;
      Elaborate_All_Active : Boolean)
   is
   begin
      pragma Assert (Present (G));
      pragma Assert (Present (Source));
      pragma Assert (Present (Actual_Destination));
      pragma Assert (Present (Expected_Destination));

      --  The actual and expected destination vertices match, and denote the
      --  initial declaration of a unit.
      --
      --            with   Actual_Destination
      --    Source ------> spec -->
      --                   Expected_Destination
      --
      --            with   Actual_Destination
      --    Source ------> stand-alone body -->
      --                   Expected_Destination

      if Actual_Destination = Expected_Destination then
         Error_Msg_Unit_1 := Name (G, Source);
         Error_Msg_Unit_2 := Name (G, Actual_Destination);
         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.
      --
      --            with   Actual_Destination
      --    Source ------> spec
      --
      --                   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 denotes a spec subject to
      --  pragma Elaborate_Body while the expected destination denotes the
      --  corresponding body.
      --
      --            with   Actual_Destination
      --    Source ------> spec Elaborate_Body
      --
      --                   body -->
      --                   Expected_Destination

      else
         pragma Assert
           (Is_Elaborate_Body_Pair
             (G           => G,
              Spec_Vertex => Actual_Destination,
              Body_Vertex => 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, Actual_Destination);
         Error_Msg_Info
           ("    unit $ is subject to pragma Elaborate_Body");

         Error_Msg_Unit_1 := Name (G, Expected_Destination);
         Error_Msg_Info
           ("    unit $ is in the closure of pragma Elaborate_Body");
      end if;
   end Output_With_Transition;

   ------------------
   -- Visit_Vertex --
   ------------------

   procedure Visit_Vertex
     (Inv_Graph         : Invocation_Graph;
      Lib_Graph         : Library_Graph;
      Invoker           : Invocation_Graph_Vertex_Id;
      Invoker_Vertex    : Library_Graph_Vertex_Id;
      Last_Vertex       : Library_Graph_Vertex_Id;
      Elaborated_Vertex : Library_Graph_Vertex_Id;
      End_Vertex        : Library_Graph_Vertex_Id;
      Visited_Invokers  : IGV_Sets.Membership_Set;
      Path              : IGE_Lists.Doubly_Linked_List;
      Path_Id           : in out Nat)
   is
      Edge : Invocation_Graph_Edge_Id;
      Iter : Edges_To_Targets_Iterator;
      Targ : Invocation_Graph_Vertex_Id;

   begin
      pragma Assert (Present (Inv_Graph));
      pragma Assert (Present (Lib_Graph));
      pragma Assert (Present (Invoker));
      pragma Assert (Present (Invoker_Vertex));
      pragma Assert (Present (Last_Vertex));
      pragma Assert (Present (Elaborated_Vertex));
      pragma Assert (Present (End_Vertex));
      pragma Assert (IGV_Sets.Present (Visited_Invokers));
      pragma Assert (IGE_Lists.Present (Path));

      --  The current invocation vertex resides within the end library vertex.
      --  Emit the path that started from some elaboration root and ultimately
      --  reached the desired library vertex.

      if Body_Vertex (Inv_Graph, Invoker) = End_Vertex
        and then Invoker_Vertex /= Last_Vertex
      then
         Output_Invocation_Path
           (Inv_Graph         => Inv_Graph,
            Lib_Graph         => Lib_Graph,
            Elaborated_Vertex => Elaborated_Vertex,
            Path              => Path,
            Path_Id           => Path_Id);

      --  Otherwise extend the search for the end library vertex via all edges
      --  to targets.

      elsif not IGV_Sets.Contains (Visited_Invokers, Invoker) then

         --  Prepare for invoker backtracking

         IGV_Sets.Insert (Visited_Invokers, Invoker);

         --  Extend the search via all edges to targets

         Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
         while Has_Next (Iter) loop
            Next (Iter, Edge);

            --  Prepare for edge backtracking

            IGE_Lists.Append (Path, Edge);

            --  The traversal proceeds through the library vertex that houses
            --  the body of the target.

            Targ := Target (Inv_Graph, Edge);

            Visit_Vertex
              (Inv_Graph         => Inv_Graph,
               Lib_Graph         => Lib_Graph,
               Invoker           => Targ,
               Invoker_Vertex    => Body_Vertex (Inv_Graph, Targ),
               Last_Vertex       => Invoker_Vertex,
               Elaborated_Vertex => Elaborated_Vertex,
               End_Vertex        => End_Vertex,
               Visited_Invokers  => Visited_Invokers,
               Path              => Path,
               Path_Id           => Path_Id);

            --  Backtrack the edge

            IGE_Lists.Delete_Last (Path);
         end loop;

         --  Backtrack the invoker

         IGV_Sets.Delete (Visited_Invokers, Invoker);
      end if;
   end Visit_Vertex;

end Bindo.Diagnostics;