gcc/ada/bindo-diagnostics.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                     B I N D O . D I A G N O S T I C S                    --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2019-2020, Free Software Foundation, Inc.      --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Binderr;  use Binderr;
  27 with Debug;    use Debug;
  28 with Restrict; use Restrict;
  29 with Rident;   use Rident;
  30 with Types;    use Types;
  31
  32 with Bindo.Validators;
  33 use  Bindo.Validators;
  34 use  Bindo.Validators.Cycle_Validators;
  35
  36 with Bindo.Writers;
  37 use  Bindo.Writers;
  38 use  Bindo.Writers.Cycle_Writers;
  39 use  Bindo.Writers.Phase_Writers;
  40
  41 package body Bindo.Diagnostics is
  42
  43    -----------------------
  44    -- Local subprograms --
  45    -----------------------
  46
  47    procedure Diagnose_All_Cycles
  48      (Inv_Graph : Invocation_Graph;
  49       Lib_Graph : Library_Graph);
  50    pragma Inline (Diagnose_All_Cycles);
  51    --  Emit diagnostics for all cycles of library graph G
  52
  53    procedure Diagnose_Cycle
  54      (Inv_Graph : Invocation_Graph;
  55       Lib_Graph : Library_Graph;
  56       Cycle     : Library_Graph_Cycle_Id);
  57    pragma Inline (Diagnose_Cycle);
  58    --  Emit diagnostics for cycle Cycle of library graph G
  59
  60    procedure Find_And_Output_Invocation_Paths
  61      (Inv_Graph   : Invocation_Graph;
  62       Lib_Graph   : Library_Graph;
  63       Source      : Library_Graph_Vertex_Id;
  64       Destination : Library_Graph_Vertex_Id);
  65    pragma Inline (Find_And_Output_Invocation_Paths);
  66    --  Find all paths in invocation graph Inv_Graph that originate from vertex
  67    --  Source and reach vertex Destination of library graph Lib_Graph. Output
  68    --  the transitions of each such path.
  69
  70    function Find_Elaboration_Root
  71      (Inv_Graph : Invocation_Graph;
  72       Lib_Graph : Library_Graph;
  73       Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id;
  74    pragma Inline (Find_Elaboration_Root);
  75    --  Find the elaboration root in invocation graph Inv_Graph that corresponds
  76    --  to vertex Vertex of library graph Lib_Graph.
  77
  78    procedure Output_All_Cycles_Suggestions (G : Library_Graph);
  79    pragma Inline (Output_All_Cycles_Suggestions);
  80    --  Suggest the diagnostic of all cycles in library graph G if circumstances
  81    --  allow it.
  82
  83    procedure Output_Elaborate_All_Suggestions
  84      (G    : Library_Graph;
  85       Pred : Library_Graph_Vertex_Id;
  86       Succ : Library_Graph_Vertex_Id);
  87    pragma Inline (Output_Elaborate_All_Suggestions);
  88    --  Suggest ways to break a cycle that involves an Elaborate_All edge that
  89    --  links predecessor Pred and successor Succ of library graph G.
  90
  91    procedure Output_Elaborate_All_Transition
  92      (G                    : Library_Graph;
  93       Source               : Library_Graph_Vertex_Id;
  94       Actual_Destination   : Library_Graph_Vertex_Id;
  95       Expected_Destination : Library_Graph_Vertex_Id);
  96    pragma Inline (Output_Elaborate_All_Transition);
  97    --  Output a transition through an Elaborate_All edge of library graph G
  98    --  with successor Source and predecessor Actual_Destination. Parameter
  99    --  Expected_Destination denotes the predecessor as specified by the next
 100    --  edge in a cycle.
 101
 102    procedure Output_Elaborate_Body_Suggestions
 103      (G    : Library_Graph;
 104       Succ : Library_Graph_Vertex_Id);
 105    pragma Inline (Output_Elaborate_Body_Suggestions);
 106    --  Suggest ways to break a cycle that involves an edge where successor Succ
 107    --  is either a spec subject to pragma Elaborate_Body or the body of such a
 108    --  spec.
 109
 110    procedure Output_Elaborate_Body_Transition
 111      (G                    : Library_Graph;
 112       Source               : Library_Graph_Vertex_Id;
 113       Actual_Destination   : Library_Graph_Vertex_Id;
 114       Expected_Destination : Library_Graph_Vertex_Id;
 115       Elaborate_All_Active : Boolean);
 116    pragma Inline (Output_Elaborate_Body_Transition);
 117    --  Output a transition through an edge of library graph G with successor
 118    --  Source and predecessor Actual_Destination. Vertex Source is either
 119    --  a spec subject to pragma Elaborate_Body or denotes the body of such
 120    --  a spec. Expected_Destination denotes the predecessor as specified by
 121    --  the next edge in a cycle. Elaborate_All_Active should be set when the
 122    --  transition occurs within a cycle that involves an Elaborate_All edge.
 123
 124    procedure Output_Elaborate_Suggestions
 125      (G    : Library_Graph;
 126       Pred : Library_Graph_Vertex_Id;
 127       Succ : Library_Graph_Vertex_Id);
 128    pragma Inline (Output_Elaborate_Suggestions);
 129    --  Suggest ways to break a cycle that involves an Elaborate edge that links
 130    --  predecessor Pred and successor Succ of library graph G.
 131
 132    procedure Output_Elaborate_Transition
 133      (G                    : Library_Graph;
 134       Source               : Library_Graph_Vertex_Id;
 135       Actual_Destination   : Library_Graph_Vertex_Id;
 136       Expected_Destination : Library_Graph_Vertex_Id);
 137    pragma Inline (Output_Elaborate_Transition);
 138    --  Output a transition through an Elaborate edge of library graph G
 139    --  with successor Source and predecessor Actual_Destination. Parameter
 140    --  Expected_Destination denotes the predecessor as specified by the next
 141    --  edge in a cycle.
 142
 143    procedure Output_Forced_Suggestions
 144      (G    : Library_Graph;
 145       Pred : Library_Graph_Vertex_Id;
 146       Succ : Library_Graph_Vertex_Id);
 147    pragma Inline (Output_Forced_Suggestions);
 148    --  Suggest ways to break a cycle that involves a Forced edge that links
 149    --  predecessor Pred with successor Succ of library graph G.
 150
 151    procedure Output_Forced_Transition
 152      (G                    : Library_Graph;
 153       Source               : Library_Graph_Vertex_Id;
 154       Actual_Destination   : Library_Graph_Vertex_Id;
 155       Expected_Destination : Library_Graph_Vertex_Id;
 156       Elaborate_All_Active : Boolean);
 157    pragma Inline (Output_Forced_Transition);
 158    --  Output a transition through a Forced edge of library graph G with
 159    --  successor Source and predecessor Actual_Destination. Parameter
 160    --  Expected_Destination denotes the predecessor as specified by the
 161    --  next edge in a cycle. Elaborate_All_Active should be set when the
 162    --  transition occurs within a cycle that involves an Elaborate_All edge.
 163
 164    procedure Output_Full_Encoding_Suggestions
 165      (G          : Library_Graph;
 166       Cycle      : Library_Graph_Cycle_Id;
 167       First_Edge : Library_Graph_Edge_Id);
 168    pragma Inline (Output_Full_Encoding_Suggestions);
 169    --  Suggest the use of the full path invocation graph encoding to break
 170    --  cycle Cycle with initial edge First_Edge of library graph G.
 171
 172    procedure Output_Invocation_Path
 173      (Inv_Graph         : Invocation_Graph;
 174       Lib_Graph         : Library_Graph;
 175       Elaborated_Vertex : Library_Graph_Vertex_Id;
 176       Path              : IGE_Lists.Doubly_Linked_List;
 177       Path_Id           : in out Nat);
 178    pragma Inline (Output_Invocation_Path);
 179    --  Output path Path, which consists of invocation graph Inv_Graph edges.
 180    --  Elaborated_Vertex is the vertex of library graph Lib_Graph whose
 181    --  elaboration initiated the path. Path_Id is the unique id of the path.
 182
 183    procedure Output_Invocation_Path_Transition
 184      (Inv_Graph : Invocation_Graph;
 185       Lib_Graph : Library_Graph;
 186       Edge      : Invocation_Graph_Edge_Id);
 187    pragma Inline (Output_Invocation_Path_Transition);
 188    --  Output a transition through edge Edge of invocation graph G, which is
 189    --  part of an invocation path. Lib_Graph is the related library graph.
 190
 191    procedure Output_Invocation_Related_Suggestions
 192      (G     : Library_Graph;
 193       Cycle : Library_Graph_Cycle_Id);
 194    pragma Inline (Output_Invocation_Related_Suggestions);
 195    --  Suggest ways to break cycle Cycle of library graph G that involves at
 196    --  least one invocation edge.
 197
 198    procedure Output_Invocation_Transition
 199      (Inv_Graph   : Invocation_Graph;
 200       Lib_Graph   : Library_Graph;
 201       Source      : Library_Graph_Vertex_Id;
 202       Destination : Library_Graph_Vertex_Id);
 203    pragma Inline (Output_Invocation_Transition);
 204    --  Output a transition through an invocation edge of library graph G with
 205    --  successor Source and predecessor Destination. Inv_Graph is the related
 206    --  invocation graph.
 207
 208    procedure Output_Reason_And_Circularity_Header
 209      (G          : Library_Graph;
 210       First_Edge : Library_Graph_Edge_Id);
 211    pragma Inline (Output_Reason_And_Circularity_Header);
 212    --  Output the reason and circularity header for a circularity of library
 213    --  graph G with initial edge First_Edge.
 214
 215    procedure Output_Suggestions
 216      (G          : Library_Graph;
 217       Cycle      : Library_Graph_Cycle_Id;
 218       First_Edge : Library_Graph_Edge_Id);
 219    pragma Inline (Output_Suggestions);
 220    --  Suggest various ways to break cycle Cycle with initial edge First_Edge
 221    --  of library graph G.
 222
 223    procedure Output_Transition
 224      (Inv_Graph            : Invocation_Graph;
 225       Lib_Graph            : Library_Graph;
 226       Current_Edge         : Library_Graph_Edge_Id;
 227       Next_Edge            : Library_Graph_Edge_Id;
 228       Elaborate_All_Active : Boolean);
 229    pragma Inline (Output_Transition);
 230    --  Output a transition described by edge Current_Edge, which is followed by
 231    --  edge Next_Edge of library graph Lib_Graph. Inv_Graph denotes the related
 232    --  invocation graph. Elaborate_All_Active should be set when the transition
 233    --  occurs within a cycle that involves an Elaborate_All edge.
 234
 235    procedure Output_With_Transition
 236      (G                    : Library_Graph;
 237       Source               : Library_Graph_Vertex_Id;
 238       Actual_Destination   : Library_Graph_Vertex_Id;
 239       Expected_Destination : Library_Graph_Vertex_Id;
 240       Elaborate_All_Active : Boolean);
 241    pragma Inline (Output_With_Transition);
 242    --  Output a transition through a regular with edge of library graph G
 243    --  with successor Source and predecessor Actual_Destination. Parameter
 244    --  Expected_Destination denotes the predecessor as specified by the next
 245    --  edge in a cycle. Elaborate_All_Active should be set when the transition
 246    --  occurs within a cycle that involves an Elaborate_All edge.
 247
 248    procedure Visit_Vertex
 249      (Inv_Graph         : Invocation_Graph;
 250       Lib_Graph         : Library_Graph;
 251       Invoker           : Invocation_Graph_Vertex_Id;
 252       Invoker_Vertex    : Library_Graph_Vertex_Id;
 253       Last_Vertex       : Library_Graph_Vertex_Id;
 254       Elaborated_Vertex : Library_Graph_Vertex_Id;
 255       End_Vertex        : Library_Graph_Vertex_Id;
 256       Visited_Invokers  : IGV_Sets.Membership_Set;
 257       Path              : IGE_Lists.Doubly_Linked_List;
 258       Path_Id           : in out Nat);
 259    pragma Inline (Visit_Vertex);
 260    --  Visit invocation graph vertex Invoker that resides in library graph
 261    --  vertex Invoker_Vertex as part of a DFS traversal. Last_Vertex denotes
 262    --  the previous vertex in the traversal. Elaborated_Vertex is the vertex
 263    --  whose elaboration started the traversal. End_Vertex is the vertex that
 264    --  terminates the traversal. Visited_Invoker is the set of all invokers
 265    --  visited so far. All edges along the path are recorded in Path. Path_Id
 266    --  is the id of the path.
 267
 268    -------------------------
 269    -- Diagnose_All_Cycles --
 270    -------------------------
 271
 272    procedure Diagnose_All_Cycles
 273      (Inv_Graph : Invocation_Graph;
 274       Lib_Graph : Library_Graph)
 275    is
 276       Cycle : Library_Graph_Cycle_Id;
 277       Iter  : All_Cycle_Iterator;
 278
 279    begin
 280       pragma Assert (Present (Inv_Graph));
 281       pragma Assert (Present (Lib_Graph));
 282
 283       Iter := Iterate_All_Cycles (Lib_Graph);
 284       while Has_Next (Iter) loop
 285          Next (Iter, Cycle);
 286
 287          Diagnose_Cycle
 288            (Inv_Graph => Inv_Graph,
 289             Lib_Graph => Lib_Graph,
 290             Cycle     => Cycle);
 291       end loop;
 292    end Diagnose_All_Cycles;
 293
 294    ----------------------------
 295    -- Diagnose_Circularities --
 296    ----------------------------
 297
 298    procedure Diagnose_Circularities
 299      (Inv_Graph : Invocation_Graph;
 300       Lib_Graph : Library_Graph)
 301    is
 302    begin
 303       pragma Assert (Present (Inv_Graph));
 304       pragma Assert (Present (Lib_Graph));
 305
 306       --  Find, validate, and output all cycles of the library graph
 307
 308       Find_Cycles     (Lib_Graph);
 309       Validate_Cycles (Lib_Graph);
 310       Write_Cycles    (Lib_Graph);
 311
 312       --  Diagnose all cycles in the graph regardless of their importance when
 313       --  switch -d_C (diagnose all cycles) is in effect.
 314
 315       if Debug_Flag_Underscore_CC then
 316          Diagnose_All_Cycles (Inv_Graph, Lib_Graph);
 317
 318       --  Otherwise diagnose the most important cycle in the graph
 319
 320       else
 321          Diagnose_Cycle
 322            (Inv_Graph => Inv_Graph,
 323             Lib_Graph => Lib_Graph,
 324             Cycle     => Highest_Precedence_Cycle (Lib_Graph));
 325       end if;
 326    end Diagnose_Circularities;
 327
 328    --------------------
 329    -- Diagnose_Cycle --
 330    --------------------
 331
 332    procedure Diagnose_Cycle
 333      (Inv_Graph : Invocation_Graph;
 334       Lib_Graph : Library_Graph;
 335       Cycle     : Library_Graph_Cycle_Id)
 336    is
 337       pragma Assert (Present (Inv_Graph));
 338       pragma Assert (Present (Lib_Graph));
 339       pragma Assert (Present (Cycle));
 340
 341       Elaborate_All_Active : constant Boolean :=
 342                                Contains_Elaborate_All_Edge
 343                                  (G     => Lib_Graph,
 344                                   Cycle => Cycle);
 345
 346       Current_Edge : Library_Graph_Edge_Id := No_Library_Graph_Edge;
 347       First_Edge   : Library_Graph_Edge_Id;
 348       Iter         : Edges_Of_Cycle_Iterator;
 349       Next_Edge    : Library_Graph_Edge_Id;
 350
 351    begin
 352       Start_Phase (Cycle_Diagnostics);
 353
 354       First_Edge := No_Library_Graph_Edge;
 355
 356       --  Inspect the edges of the cycle in pairs, emitting diagnostics based
 357       --  on their successors and predecessors.
 358
 359       Iter := Iterate_Edges_Of_Cycle (Lib_Graph, Cycle);
 360       while Has_Next (Iter) loop
 361
 362          --  Emit the reason for the cycle using the initial edge, which is the
 363          --  most important edge in the cycle.
 364
 365          if not Present (First_Edge) then
 366             Next (Iter, Current_Edge);
 367
 368             First_Edge := Current_Edge;
 369             Output_Reason_And_Circularity_Header
 370               (G          => Lib_Graph,
 371                First_Edge => First_Edge);
 372          end if;
 373
 374          --  Obtain the other edge of the pair
 375
 376          exit when not Has_Next (Iter);
 377          Next (Iter, Next_Edge);
 378
 379          --  Describe the transition from the current edge to the next edge by
 380          --  taking into account the predecessors and successors involved, as
 381          --  well as the nature of the edge.
 382
 383          Output_Transition
 384            (Inv_Graph            => Inv_Graph,
 385             Lib_Graph            => Lib_Graph,
 386             Current_Edge         => Current_Edge,
 387             Next_Edge            => Next_Edge,
 388             Elaborate_All_Active => Elaborate_All_Active);
 389
 390          Current_Edge := Next_Edge;
 391       end loop;
 392
 393       --  Describe the transition from the last edge to the first edge
 394
 395       Output_Transition
 396         (Inv_Graph            => Inv_Graph,
 397          Lib_Graph            => Lib_Graph,
 398          Current_Edge         => Current_Edge,
 399          Next_Edge            => First_Edge,
 400          Elaborate_All_Active => Elaborate_All_Active);
 401
 402       --  Suggest various alternatives for breaking the cycle
 403
 404       Output_Suggestions
 405         (G          => Lib_Graph,
 406          Cycle      => Cycle,
 407          First_Edge => First_Edge);
 408
 409       End_Phase (Cycle_Diagnostics);
 410    end Diagnose_Cycle;
 411
 412    --------------------------------------
 413    -- Find_And_Output_Invocation_Paths --
 414    --------------------------------------
 415
 416    procedure Find_And_Output_Invocation_Paths
 417      (Inv_Graph   : Invocation_Graph;
 418       Lib_Graph   : Library_Graph;
 419       Source      : Library_Graph_Vertex_Id;
 420       Destination : Library_Graph_Vertex_Id)
 421    is
 422       Path    : IGE_Lists.Doubly_Linked_List;
 423       Path_Id : Nat;
 424       Visited : IGV_Sets.Membership_Set;
 425
 426    begin
 427       pragma Assert (Present (Inv_Graph));
 428       pragma Assert (Present (Lib_Graph));
 429       pragma Assert (Present (Source));
 430       pragma Assert (Present (Destination));
 431
 432       --  Nothing to do when the invocation graph encoding format of the source
 433       --  vertex does not contain detailed information about invocation paths.
 434
 435       if Invocation_Graph_Encoding (Lib_Graph, Source) /=
 436            Full_Path_Encoding
 437       then
 438          return;
 439       end if;
 440
 441       Path    := IGE_Lists.Create;
 442       Path_Id := 1;
 443       Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
 444
 445       --  Start a DFS traversal over the invocation graph, in an attempt to
 446       --  reach Destination from Source. The actual start of the path is the
 447       --  elaboration root invocation vertex that corresponds to the Source.
 448       --  Each unique path is emitted as part of the current cycle diagnostic.
 449
 450       Visit_Vertex
 451         (Inv_Graph         => Inv_Graph,
 452          Lib_Graph         => Lib_Graph,
 453          Invoker           =>
 454            Find_Elaboration_Root
 455              (Inv_Graph => Inv_Graph,
 456               Lib_Graph => Lib_Graph,
 457               Vertex    => Source),
 458          Invoker_Vertex    => Source,
 459          Last_Vertex       => Source,
 460          Elaborated_Vertex => Source,
 461          End_Vertex        => Destination,
 462          Visited_Invokers  => Visited,
 463          Path              => Path,
 464          Path_Id           => Path_Id);
 465
 466       IGE_Lists.Destroy (Path);
 467       IGV_Sets.Destroy  (Visited);
 468    end Find_And_Output_Invocation_Paths;
 469
 470    ---------------------------
 471    -- Find_Elaboration_Root --
 472    ---------------------------
 473
 474    function Find_Elaboration_Root
 475      (Inv_Graph : Invocation_Graph;
 476       Lib_Graph : Library_Graph;
 477       Vertex    : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id
 478    is
 479       Current_Vertex : Invocation_Graph_Vertex_Id;
 480       Iter           : Elaboration_Root_Iterator;
 481       Root_Vertex    : Invocation_Graph_Vertex_Id;
 482
 483    begin
 484       pragma Assert (Present (Inv_Graph));
 485       pragma Assert (Present (Lib_Graph));
 486       pragma Assert (Present (Vertex));
 487
 488       --  Assume that the vertex does not have a corresponding elaboration root
 489
 490       Root_Vertex := No_Invocation_Graph_Vertex;
 491
 492       --  Inspect all elaboration roots trying to find the one that resides in
 493       --  the input vertex.
 494       --
 495       --  IMPORTANT:
 496       --
 497       --    * The iterator must run to completion in order to unlock the
 498       --      invocation graph.
 499
 500       Iter := Iterate_Elaboration_Roots (Inv_Graph);
 501       while Has_Next (Iter) loop
 502          Next (Iter, Current_Vertex);
 503
 504          if not Present (Root_Vertex)
 505            and then Body_Vertex (Inv_Graph, Current_Vertex) = Vertex
 506          then
 507             Root_Vertex := Current_Vertex;
 508          end if;
 509       end loop;
 510
 511       return Root_Vertex;
 512    end Find_Elaboration_Root;
 513
 514    -----------------------------------
 515    -- Output_All_Cycles_Suggestions --
 516    -----------------------------------
 517
 518    procedure Output_All_Cycles_Suggestions (G : Library_Graph) is
 519    begin
 520       pragma Assert (Present (G));
 521
 522       --  The library graph contains at least one cycle and only the highest
 523       --  priority cycle was diagnosed. Diagnosing all cycles may yield extra
 524       --  information for decision making.
 525
 526       if Number_Of_Cycles (G) > 1 and then not Debug_Flag_Underscore_CC then
 527          Error_Msg_Info
 528            ("    diagnose all circularities (binder switch -d_C)");
 529       end if;
 530    end Output_All_Cycles_Suggestions;
 531
 532    --------------------------------------
 533    -- Output_Elaborate_All_Suggestions --
 534    --------------------------------------
 535
 536    procedure Output_Elaborate_All_Suggestions
 537      (G    : Library_Graph;
 538       Pred : Library_Graph_Vertex_Id;
 539       Succ : Library_Graph_Vertex_Id)
 540    is
 541    begin
 542       pragma Assert (Present (G));
 543       pragma Assert (Present (Pred));
 544       pragma Assert (Present (Succ));
 545
 546       Error_Msg_Unit_1 := Name (G, Pred);
 547       Error_Msg_Unit_2 := Name (G, Succ);
 548       Error_Msg_Info
 549         ("    change pragma Elaborate_All for unit $ to Elaborate in unit $");
 550       Error_Msg_Info
 551         ("    remove pragma Elaborate_All for unit $ in unit $");
 552    end Output_Elaborate_All_Suggestions;
 553
 554    -------------------------------------
 555    -- Output_Elaborate_All_Transition --
 556    -------------------------------------
 557
 558    procedure Output_Elaborate_All_Transition
 559      (G                    : Library_Graph;
 560       Source               : Library_Graph_Vertex_Id;
 561       Actual_Destination   : Library_Graph_Vertex_Id;
 562       Expected_Destination : Library_Graph_Vertex_Id)
 563    is
 564    begin
 565       pragma Assert (Present (G));
 566       pragma Assert (Present (Source));
 567       pragma Assert (Present (Actual_Destination));
 568       pragma Assert (Present (Expected_Destination));
 569
 570       --  The actual and expected destination vertices match, and denote the
 571       --  initial declaration of a unit.
 572       --
 573       --            Elaborate_All   Actual_Destination
 574       --    Source ---------------> spec -->
 575       --                            Expected_Destination
 576       --
 577       --            Elaborate_All   Actual_Destination
 578       --    Source ---------------> stand-alone body -->
 579       --                            Expected_Destination
 580
 581       if Actual_Destination = Expected_Destination then
 582          Error_Msg_Unit_1 := Name (G, Source);
 583          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 584          Error_Msg_Info
 585            ("    unit $ has with clause and pragma Elaborate_All for unit $");
 586
 587       --  Otherwise the actual destination vertex denotes the spec of a unit,
 588       --  while the expected destination is the corresponding body.
 589       --
 590       --            Elaborate_All   Actual_Destination
 591       --    Source ---------------> spec
 592       --
 593       --                            body -->
 594       --                            Expected_Destination
 595
 596       else
 597          pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
 598          pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
 599          pragma Assert
 600            (Proper_Body (G, Actual_Destination) = Expected_Destination);
 601
 602          Error_Msg_Unit_1 := Name (G, Source);
 603          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 604          Error_Msg_Info
 605            ("    unit $ has with clause and pragma Elaborate_All for unit $");
 606
 607          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 608          Error_Msg_Info
 609            ("    unit $ is in the closure of pragma Elaborate_All");
 610       end if;
 611    end Output_Elaborate_All_Transition;
 612
 613    ---------------------------------------
 614    -- Output_Elaborate_Body_Suggestions --
 615    ---------------------------------------
 616
 617    procedure Output_Elaborate_Body_Suggestions
 618      (G    : Library_Graph;
 619       Succ : Library_Graph_Vertex_Id)
 620    is
 621       Spec : Library_Graph_Vertex_Id;
 622
 623    begin
 624       pragma Assert (Present (G));
 625       pragma Assert (Present (Succ));
 626
 627       --  Find the initial declaration of the unit because it is the one
 628       --  subject to pragma Elaborate_Body.
 629
 630       if Is_Body_With_Spec (G, Succ) then
 631          Spec := Proper_Spec (G, Succ);
 632       else
 633          Spec := Succ;
 634       end if;
 635
 636       Error_Msg_Unit_1 := Name (G, Spec);
 637       Error_Msg_Info
 638         ("    remove pragma Elaborate_Body in unit $");
 639    end Output_Elaborate_Body_Suggestions;
 640
 641    --------------------------------------
 642    -- Output_Elaborate_Body_Transition --
 643    --------------------------------------
 644
 645    procedure Output_Elaborate_Body_Transition
 646      (G                    : Library_Graph;
 647       Source               : Library_Graph_Vertex_Id;
 648       Actual_Destination   : Library_Graph_Vertex_Id;
 649       Expected_Destination : Library_Graph_Vertex_Id;
 650       Elaborate_All_Active : Boolean)
 651    is
 652    begin
 653       pragma Assert (Present (G));
 654       pragma Assert (Present (Source));
 655       pragma Assert (Present (Actual_Destination));
 656       pragma Assert (Present (Expected_Destination));
 657
 658       --  The actual and expected destination vertices match
 659       --
 660       --                     Actual_Destination
 661       --    Source --------> spec -->
 662       --    Elaborate_Body   Expected_Destination
 663       --
 664       --                     spec
 665       --
 666       --                     Actual_Destination
 667       --    Source --------> body -->
 668       --    Elaborate_Body   Expected_Destination
 669
 670       if Actual_Destination = Expected_Destination then
 671          Error_Msg_Unit_1 := Name (G, Source);
 672          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 673          Error_Msg_Info
 674            ("    unit $ has with clause for unit $");
 675
 676       --  The actual destination vertex denotes the spec of a unit while the
 677       --  expected destination is the corresponding body, and the unit is in
 678       --  the closure of an earlier Elaborate_All pragma.
 679       --
 680       --                     Actual_Destination
 681       --    Source --------> spec
 682       --    Elaborate_Body
 683       --                     body -->
 684       --                     Expected_Destination
 685
 686       elsif Elaborate_All_Active then
 687          pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
 688          pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
 689          pragma Assert
 690            (Proper_Body (G, Actual_Destination) = Expected_Destination);
 691
 692          Error_Msg_Unit_1 := Name (G, Source);
 693          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 694          Error_Msg_Info
 695            ("    unit $ has with clause for unit $");
 696
 697          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 698          Error_Msg_Info
 699            ("    unit $ is in the closure of pragma Elaborate_All");
 700
 701       --  Otherwise the actual destination vertex is the spec of a unit subject
 702       --  to pragma Elaborate_Body and the expected destination vertex is the
 703       --  completion body.
 704       --
 705       --                     Actual_Destination
 706       --    Source --------> spec Elaborate_Body
 707       --    Elaborate_Body
 708       --                     body -->
 709       --                     Expected_Destination
 710
 711       else
 712          pragma Assert
 713            (Is_Elaborate_Body_Pair
 714              (G           => G,
 715               Spec_Vertex => Actual_Destination,
 716               Body_Vertex => Expected_Destination));
 717
 718          Error_Msg_Unit_1 := Name (G, Source);
 719          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 720          Error_Msg_Info
 721            ("    unit $ has with clause for unit $");
 722
 723          Error_Msg_Unit_1 := Name (G, Actual_Destination);
 724          Error_Msg_Info
 725            ("    unit $ is subject to pragma Elaborate_Body");
 726
 727          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 728          Error_Msg_Info
 729            ("    unit $ is in the closure of pragma Elaborate_Body");
 730       end if;
 731    end Output_Elaborate_Body_Transition;
 732
 733    ----------------------------------
 734    -- Output_Elaborate_Suggestions --
 735    ----------------------------------
 736
 737    procedure Output_Elaborate_Suggestions
 738      (G    : Library_Graph;
 739       Pred : Library_Graph_Vertex_Id;
 740       Succ : Library_Graph_Vertex_Id)
 741    is
 742    begin
 743       pragma Assert (Present (G));
 744       pragma Assert (Present (Pred));
 745       pragma Assert (Present (Succ));
 746
 747       Error_Msg_Unit_1 := Name (G, Pred);
 748       Error_Msg_Unit_2 := Name (G, Succ);
 749       Error_Msg_Info
 750         ("    remove pragma Elaborate for unit $ in unit $");
 751    end Output_Elaborate_Suggestions;
 752
 753    ---------------------------------
 754    -- Output_Elaborate_Transition --
 755    ---------------------------------
 756
 757    procedure Output_Elaborate_Transition
 758      (G                    : Library_Graph;
 759       Source               : Library_Graph_Vertex_Id;
 760       Actual_Destination   : Library_Graph_Vertex_Id;
 761       Expected_Destination : Library_Graph_Vertex_Id)
 762    is
 763       Spec : Library_Graph_Vertex_Id;
 764
 765    begin
 766       pragma Assert (Present (G));
 767       pragma Assert (Present (Source));
 768       pragma Assert (Present (Actual_Destination));
 769       pragma Assert (Present (Expected_Destination));
 770
 771       --  The actual and expected destination vertices match, and denote the
 772       --  initial declaration of a unit.
 773       --
 774       --            Elaborate   Actual_Destination
 775       --    Source -----------> spec -->
 776       --                        Expected_Destination
 777       --
 778       --            Elaborate   Actual_Destination
 779       --    Source -----------> stand-alone body -->
 780       --                        Expected_Destination
 781       --
 782       --  The processing of pragma Elaborate body generates an edge between a
 783       --  successor and predecessor body.
 784       --
 785       --                        spec
 786       --
 787       --            Elaborate   Actual_Destination
 788       --    Source -----------> body -->
 789       --                        Expected_Destination
 790
 791       if Actual_Destination = Expected_Destination then
 792
 793          --  Find the initial declaration of the unit because it is the one
 794          --  subject to pragma Elaborate.
 795
 796          if Is_Body_With_Spec (G, Actual_Destination) then
 797             Spec := Proper_Spec (G, Actual_Destination);
 798          else
 799             Spec := Actual_Destination;
 800          end if;
 801
 802          Error_Msg_Unit_1 := Name (G, Source);
 803          Error_Msg_Unit_2 := Name (G, Spec);
 804          Error_Msg_Info
 805            ("    unit $ has with clause and pragma Elaborate for unit $");
 806
 807          if Actual_Destination /= Spec then
 808             Error_Msg_Unit_1 := Name (G, Actual_Destination);
 809             Error_Msg_Info
 810               ("    unit $ is in the closure of pragma Elaborate");
 811          end if;
 812
 813       --  Otherwise the actual destination vertex denotes the spec of a unit
 814       --  while the expected destination vertex is the corresponding body.
 815       --
 816       --            Elaborate   Actual_Destination
 817       --    Source -----------> spec
 818       --
 819       --                        body -->
 820       --                        Expected_Destination
 821
 822       else
 823          pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
 824          pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
 825          pragma Assert
 826            (Proper_Body (G, Actual_Destination) = Expected_Destination);
 827
 828          Error_Msg_Unit_1 := Name (G, Source);
 829          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 830          Error_Msg_Info
 831            ("    unit $ has with clause and pragma Elaborate for unit $");
 832
 833          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 834          Error_Msg_Info
 835            ("    unit $ is in the closure of pragma Elaborate");
 836       end if;
 837    end Output_Elaborate_Transition;
 838
 839    -------------------------------
 840    -- Output_Forced_Suggestions --
 841    -------------------------------
 842
 843    procedure Output_Forced_Suggestions
 844      (G    : Library_Graph;
 845       Pred : Library_Graph_Vertex_Id;
 846       Succ : Library_Graph_Vertex_Id)
 847    is
 848    begin
 849       pragma Assert (Present (G));
 850       pragma Assert (Present (Pred));
 851       pragma Assert (Present (Succ));
 852
 853       Error_Msg_Unit_1 := Name (G, Succ);
 854       Error_Msg_Unit_2 := Name (G, Pred);
 855       Error_Msg_Info
 856         ("    remove the dependency of unit $ on unit $ from the argument of "
 857          & "switch -f");
 858       Error_Msg_Info
 859         ("    remove switch -f");
 860    end Output_Forced_Suggestions;
 861
 862    ------------------------------
 863    -- Output_Forced_Transition --
 864    ------------------------------
 865
 866    procedure Output_Forced_Transition
 867      (G                    : Library_Graph;
 868       Source               : Library_Graph_Vertex_Id;
 869       Actual_Destination   : Library_Graph_Vertex_Id;
 870       Expected_Destination : Library_Graph_Vertex_Id;
 871       Elaborate_All_Active : Boolean)
 872    is
 873    begin
 874       pragma Assert (Present (G));
 875       pragma Assert (Present (Source));
 876       pragma Assert (Present (Actual_Destination));
 877       pragma Assert (Present (Expected_Destination));
 878
 879       --  The actual and expected destination vertices match
 880       --
 881       --            Forced   Actual_Destination
 882       --    Source --------> spec -->
 883       --                     Expected_Destination
 884       --
 885       --            Forced   Actual_Destination
 886       --    Source --------> body -->
 887       --                     Expected_Destination
 888
 889       if Actual_Destination = Expected_Destination then
 890          Error_Msg_Unit_1 := Name (G, Source);
 891          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 892          Error_Msg_Info
 893            ("    unit $ has a dependency on unit $ forced by -f switch");
 894
 895       --  The actual destination vertex denotes the spec of a unit while the
 896       --  expected destination is the corresponding body, and the unit is in
 897       --  the closure of an earlier Elaborate_All pragma.
 898       --
 899       --            Forced   Actual_Destination
 900       --    Source --------> spec
 901       --
 902       --                     body -->
 903       --                     Expected_Destination
 904
 905       elsif Elaborate_All_Active then
 906          pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
 907          pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
 908          pragma Assert
 909            (Proper_Body (G, Actual_Destination) = Expected_Destination);
 910
 911          Error_Msg_Unit_1 := Name (G, Source);
 912          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 913          Error_Msg_Info
 914            ("    unit $ has a dependency on unit $ forced by -f switch");
 915
 916          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 917          Error_Msg_Info
 918            ("    unit $ is in the closure of pragma Elaborate_All");
 919
 920       --  Otherwise the actual destination vertex denotes a spec subject to
 921       --  pragma Elaborate_Body while the expected destination denotes the
 922       --  corresponding body.
 923       --
 924       --            Forced   Actual_Destination
 925       --    Source --------> spec Elaborate_Body
 926       --
 927       --                     body -->
 928       --                     Expected_Destination
 929
 930       else
 931          pragma Assert
 932            (Is_Elaborate_Body_Pair
 933              (G           => G,
 934               Spec_Vertex => Actual_Destination,
 935               Body_Vertex => Expected_Destination));
 936
 937          Error_Msg_Unit_1 := Name (G, Source);
 938          Error_Msg_Unit_2 := Name (G, Actual_Destination);
 939          Error_Msg_Info
 940            ("    unit $ has a dependency on unit $ forced by -f switch");
 941
 942          Error_Msg_Unit_1 := Name (G, Actual_Destination);
 943          Error_Msg_Info
 944            ("    unit $ is subject to pragma Elaborate_Body");
 945
 946          Error_Msg_Unit_1 := Name (G, Expected_Destination);
 947          Error_Msg_Info
 948            ("    unit $ is in the closure of pragma Elaborate_Body");
 949       end if;
 950    end Output_Forced_Transition;
 951
 952    --------------------------------------
 953    -- Output_Full_Encoding_Suggestions --
 954    --------------------------------------
 955
 956    procedure Output_Full_Encoding_Suggestions
 957      (G          : Library_Graph;
 958       Cycle      : Library_Graph_Cycle_Id;
 959       First_Edge : Library_Graph_Edge_Id)
 960    is
 961       Succ : Library_Graph_Vertex_Id;
 962
 963    begin
 964       pragma Assert (Present (G));
 965       pragma Assert (Present (Cycle));
 966       pragma Assert (Present (First_Edge));
 967
 968       if Is_Invocation_Edge (G, First_Edge) then
 969          Succ := Successor (G, First_Edge);
 970
 971          if Invocation_Graph_Encoding (G, Succ) /= Full_Path_Encoding then
 972             Error_Msg_Info
 973               ("    use detailed invocation information (compiler switch "
 974                & "-gnatd_F)");
 975          end if;
 976       end if;
 977    end Output_Full_Encoding_Suggestions;
 978
 979    ----------------------------
 980    -- Output_Invocation_Path --
 981    -----------------------------
 982
 983    procedure Output_Invocation_Path
 984      (Inv_Graph         : Invocation_Graph;
 985       Lib_Graph         : Library_Graph;
 986       Elaborated_Vertex : Library_Graph_Vertex_Id;
 987       Path              : IGE_Lists.Doubly_Linked_List;
 988       Path_Id           : in out Nat)
 989    is
 990       Edge : Invocation_Graph_Edge_Id;
 991       Iter : IGE_Lists.Iterator;
 992
 993    begin
 994       pragma Assert (Present (Inv_Graph));
 995       pragma Assert (Present (Lib_Graph));
 996       pragma Assert (Present (Elaborated_Vertex));
 997       pragma Assert (IGE_Lists.Present (Path));
 998
 999       Error_Msg_Nat_1 := Path_Id;
1000       Error_Msg_Info ("      path #:");
1001
1002       Error_Msg_Unit_1 := Name (Lib_Graph, Elaborated_Vertex);
1003       Error_Msg_Info ("        elaboration of unit $");
1004
1005       Iter := IGE_Lists.Iterate (Path);
1006       while IGE_Lists.Has_Next (Iter) loop
1007          IGE_Lists.Next (Iter, Edge);
1008
1009          Output_Invocation_Path_Transition
1010            (Inv_Graph => Inv_Graph,
1011             Lib_Graph => Lib_Graph,
1012             Edge      => Edge);
1013       end loop;
1014
1015       Path_Id := Path_Id + 1;
1016    end Output_Invocation_Path;
1017
1018    ---------------------------------------
1019    -- Output_Invocation_Path_Transition --
1020    ---------------------------------------
1021
1022    procedure Output_Invocation_Path_Transition
1023      (Inv_Graph : Invocation_Graph;
1024       Lib_Graph : Library_Graph;
1025       Edge      : Invocation_Graph_Edge_Id)
1026    is
1027       pragma Assert (Present (Inv_Graph));
1028       pragma Assert (Present (Lib_Graph));
1029       pragma Assert (Present (Edge));
1030
1031       Declared : constant String := "declared at {:#:#";
1032
1033       Targ        : constant Invocation_Graph_Vertex_Id :=
1034                       Target (Inv_Graph, Edge);
1035       Targ_Extra  : constant Name_Id                    :=
1036                       Extra (Inv_Graph, Edge);
1037       Targ_Vertex : constant Library_Graph_Vertex_Id    :=
1038                       Spec_Vertex (Inv_Graph, Targ);
1039
1040    begin
1041       Error_Msg_Name_1 := Name   (Inv_Graph, Targ);
1042       Error_Msg_Nat_1  := Line   (Inv_Graph, Targ);
1043       Error_Msg_Nat_2  := Column (Inv_Graph, Targ);
1044       Error_Msg_File_1 := File_Name (Lib_Graph, Targ_Vertex);
1045
1046       case Kind (Inv_Graph, Edge) is
1047          when Accept_Alternative =>
1048             Error_Msg_Info
1049               ("        selection of entry % "
1050                & Declared);
1051
1052          when Access_Taken =>
1053             Error_Msg_Info
1054               ("        aliasing of subprogram % "
1055                & Declared);
1056
1057          when Call =>
1058             Error_Msg_Info
1059               ("        call to subprogram % "
1060                & Declared);
1061
1062          when Controlled_Adjustment
1063             | Internal_Controlled_Adjustment
1064          =>
1065             Error_Msg_Name_1 := Targ_Extra;
1066             Error_Msg_Info
1067               ("        adjustment actions for type % "
1068                & Declared);
1069
1070          when Controlled_Finalization
1071             | Internal_Controlled_Finalization
1072          =>
1073             Error_Msg_Name_1 := Targ_Extra;
1074             Error_Msg_Info
1075               ("        finalization actions for type % "
1076                & Declared);
1077
1078          when Controlled_Initialization
1079             | Internal_Controlled_Initialization
1080             | Type_Initialization
1081          =>
1082             Error_Msg_Name_1 := Targ_Extra;
1083             Error_Msg_Info
1084               ("        initialization actions for type % "
1085                & Declared);
1086
1087          when Default_Initial_Condition_Verification =>
1088             Error_Msg_Name_1 := Targ_Extra;
1089             Error_Msg_Info
1090               ("        verification of Default_Initial_Condition for type % "
1091                & Declared);
1092
1093          when Initial_Condition_Verification =>
1094             Error_Msg_Info
1095               ("        verification of Initial_Condition "
1096                & Declared);
1097
1098          when Instantiation =>
1099             Error_Msg_Info
1100               ("        instantiation % "
1101                & Declared);
1102
1103          when Invariant_Verification =>
1104             Error_Msg_Name_1 := Targ_Extra;
1105             Error_Msg_Info
1106               ("        verification of invariant for type % "
1107                & Declared);
1108
1109          when Postcondition_Verification =>
1110             Error_Msg_Name_1 := Targ_Extra;
1111             Error_Msg_Info
1112               ("        verification of postcondition for subprogram % "
1113                & Declared);
1114
1115          when Protected_Entry_Call =>
1116             Error_Msg_Info
1117               ("        call to protected entry % "
1118                & Declared);
1119
1120          when Protected_Subprogram_Call =>
1121             Error_Msg_Info
1122               ("        call to protected subprogram % "
1123                & Declared);
1124
1125          when Task_Activation =>
1126             Error_Msg_Info
1127               ("        activation of local task "
1128                & Declared);
1129
1130          when Task_Entry_Call =>
1131             Error_Msg_Info
1132               ("        call to task entry % "
1133                & Declared);
1134
1135          when others =>
1136             pragma Assert (False);
1137             null;
1138       end case;
1139    end Output_Invocation_Path_Transition;
1140
1141    -------------------------------------------
1142    -- Output_Invocation_Related_Suggestions --
1143    -------------------------------------------
1144
1145    procedure Output_Invocation_Related_Suggestions
1146      (G     : Library_Graph;
1147       Cycle : Library_Graph_Cycle_Id)
1148    is
1149    begin
1150       pragma Assert (Present (G));
1151       pragma Assert (Present (Cycle));
1152
1153       --  Nothing to do when the cycle does not contain an invocation edge
1154
1155       if Invocation_Edge_Count (G, Cycle) = 0 then
1156          return;
1157       end if;
1158
1159       --  The cycle contains at least one invocation edge, where at least
1160       --  one of the paths the edge represents activates a task. The use of
1161       --  restriction No_Entry_Calls_In_Elaboration_Code may halt the flow
1162       --  within the task body on a select or accept statement, eliminating
1163       --  subsequent invocation edges, thus breaking the cycle.
1164
1165       if not Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
1166         and then Contains_Task_Activation (G, Cycle)
1167       then
1168          Error_Msg_Info
1169            ("    use pragma Restrictions "
1170             & "(No_Entry_Calls_In_Elaboration_Code)");
1171       end if;
1172
1173       --  The cycle contains at least one invocation edge where the successor
1174       --  was statically elaborated. The use of the dynamic model may remove
1175       --  one of the invocation edges in the cycle, thus breaking the cycle.
1176
1177       if Contains_Static_Successor_Edge (G, Cycle) then
1178          Error_Msg_Info
1179            ("    use the dynamic elaboration model (compiler switch -gnatE)");
1180       end if;
1181    end Output_Invocation_Related_Suggestions;
1182
1183    ----------------------------------
1184    -- Output_Invocation_Transition --
1185    ----------------------------------
1186
1187    procedure Output_Invocation_Transition
1188      (Inv_Graph   : Invocation_Graph;
1189       Lib_Graph   : Library_Graph;
1190       Source      : Library_Graph_Vertex_Id;
1191       Destination : Library_Graph_Vertex_Id)
1192    is
1193    begin
1194       pragma Assert (Present (Inv_Graph));
1195       pragma Assert (Present (Lib_Graph));
1196       pragma Assert (Present (Source));
1197       pragma Assert (Present (Destination));
1198
1199       Error_Msg_Unit_1 := Name (Lib_Graph, Source);
1200       Error_Msg_Unit_2 := Name (Lib_Graph, Destination);
1201       Error_Msg_Info
1202         ("    unit $ invokes a construct of unit $ at elaboration time");
1203
1204       Find_And_Output_Invocation_Paths
1205         (Inv_Graph   => Inv_Graph,
1206          Lib_Graph   => Lib_Graph,
1207          Source      => Source,
1208          Destination => Destination);
1209    end Output_Invocation_Transition;
1210
1211    ------------------------------------------
1212    -- Output_Reason_And_Circularity_Header --
1213    ------------------------------------------
1214
1215    procedure Output_Reason_And_Circularity_Header
1216      (G          : Library_Graph;
1217       First_Edge : Library_Graph_Edge_Id)
1218    is
1219       pragma Assert (Present (G));
1220       pragma Assert (Present (First_Edge));
1221
1222       Succ : constant Library_Graph_Vertex_Id := Successor (G, First_Edge);
1223
1224    begin
1225       Error_Msg_Unit_1 := Name (G, Succ);
1226       Error_Msg      ("Elaboration circularity detected");
1227       Error_Msg_Info ("");
1228       Error_Msg_Info ("  Reason:");
1229       Error_Msg_Info ("");
1230       Error_Msg_Info ("    unit $ depends on its own elaboration");
1231       Error_Msg_Info ("");
1232       Error_Msg_Info ("  Circularity:");
1233       Error_Msg_Info ("");
1234    end Output_Reason_And_Circularity_Header;
1235
1236    ------------------------
1237    -- Output_Suggestions --
1238    ------------------------
1239
1240    procedure Output_Suggestions
1241      (G          : Library_Graph;
1242       Cycle      : Library_Graph_Cycle_Id;
1243       First_Edge : Library_Graph_Edge_Id)
1244    is
1245       pragma Assert (Present (G));
1246       pragma Assert (Present (Cycle));
1247       pragma Assert (Present (First_Edge));
1248
1249       Pred : constant Library_Graph_Vertex_Id := Predecessor (G, First_Edge);
1250       Succ : constant Library_Graph_Vertex_Id := Successor   (G, First_Edge);
1251
1252    begin
1253       Error_Msg_Info ("");
1254       Error_Msg_Info ("  Suggestions:");
1255       Error_Msg_Info ("");
1256
1257       --  Output edge-specific suggestions
1258
1259       if Is_Elaborate_All_Edge (G, First_Edge) then
1260          Output_Elaborate_All_Suggestions
1261            (G    => G,
1262             Pred => Pred,
1263             Succ => Succ);
1264
1265       elsif Is_Elaborate_Body_Edge (G, First_Edge) then
1266          Output_Elaborate_Body_Suggestions
1267            (G    => G,
1268             Succ => Succ);
1269
1270       elsif Is_Elaborate_Edge (G, First_Edge) then
1271          Output_Elaborate_Suggestions
1272            (G    => G,
1273             Pred => Pred,
1274             Succ => Succ);
1275
1276       elsif Is_Forced_Edge (G, First_Edge) then
1277          Output_Forced_Suggestions
1278            (G    => G,
1279             Pred => Pred,
1280             Succ => Succ);
1281       end if;
1282
1283       --  Output general purpose suggestions
1284
1285       Output_Invocation_Related_Suggestions
1286         (G     => G,
1287          Cycle => Cycle);
1288
1289       Output_Full_Encoding_Suggestions
1290         (G          => G,
1291          Cycle      => Cycle,
1292          First_Edge => First_Edge);
1293
1294       Output_All_Cycles_Suggestions (G);
1295
1296       Error_Msg_Info ("");
1297    end Output_Suggestions;
1298
1299    -----------------------
1300    -- Output_Transition --
1301    -----------------------
1302
1303    procedure Output_Transition
1304      (Inv_Graph            : Invocation_Graph;
1305       Lib_Graph            : Library_Graph;
1306       Current_Edge         : Library_Graph_Edge_Id;
1307       Next_Edge            : Library_Graph_Edge_Id;
1308       Elaborate_All_Active : Boolean)
1309    is
1310       pragma Assert (Present (Inv_Graph));
1311       pragma Assert (Present (Lib_Graph));
1312       pragma Assert (Present (Current_Edge));
1313       pragma Assert (Present (Next_Edge));
1314
1315       Actual_Destination   : constant Library_Graph_Vertex_Id :=
1316                                Predecessor (Lib_Graph, Current_Edge);
1317       Expected_Destination : constant Library_Graph_Vertex_Id :=
1318                                Successor   (Lib_Graph, Next_Edge);
1319       Source               : constant Library_Graph_Vertex_Id :=
1320                                Successor   (Lib_Graph, Current_Edge);
1321
1322    begin
1323       if Is_Elaborate_All_Edge (Lib_Graph, Current_Edge) then
1324          Output_Elaborate_All_Transition
1325            (G                    => Lib_Graph,
1326             Source               => Source,
1327             Actual_Destination   => Actual_Destination,
1328             Expected_Destination => Expected_Destination);
1329
1330       elsif Is_Elaborate_Body_Edge (Lib_Graph, Current_Edge) then
1331          Output_Elaborate_Body_Transition
1332            (G                    => Lib_Graph,
1333             Source               => Source,
1334             Actual_Destination   => Actual_Destination,
1335             Expected_Destination => Expected_Destination,
1336             Elaborate_All_Active => Elaborate_All_Active);
1337
1338       elsif Is_Elaborate_Edge (Lib_Graph, Current_Edge) then
1339          Output_Elaborate_Transition
1340            (G                    => Lib_Graph,
1341             Source               => Source,
1342             Actual_Destination   => Actual_Destination,
1343             Expected_Destination => Expected_Destination);
1344
1345       elsif Is_Forced_Edge (Lib_Graph, Current_Edge) then
1346          Output_Forced_Transition
1347            (G                    => Lib_Graph,
1348             Source               => Source,
1349             Actual_Destination   => Actual_Destination,
1350             Expected_Destination => Expected_Destination,
1351             Elaborate_All_Active => Elaborate_All_Active);
1352
1353       elsif Is_Invocation_Edge (Lib_Graph, Current_Edge) then
1354          Output_Invocation_Transition
1355            (Inv_Graph   => Inv_Graph,
1356             Lib_Graph   => Lib_Graph,
1357             Source      => Source,
1358             Destination => Expected_Destination);
1359
1360       else
1361          pragma Assert (Is_With_Edge (Lib_Graph, Current_Edge));
1362
1363          Output_With_Transition
1364            (G                    => Lib_Graph,
1365             Source               => Source,
1366             Actual_Destination   => Actual_Destination,
1367             Expected_Destination => Expected_Destination,
1368             Elaborate_All_Active => Elaborate_All_Active);
1369       end if;
1370    end Output_Transition;
1371
1372    ----------------------------
1373    -- Output_With_Transition --
1374    ----------------------------
1375
1376    procedure Output_With_Transition
1377      (G                    : Library_Graph;
1378       Source               : Library_Graph_Vertex_Id;
1379       Actual_Destination   : Library_Graph_Vertex_Id;
1380       Expected_Destination : Library_Graph_Vertex_Id;
1381       Elaborate_All_Active : Boolean)
1382    is
1383    begin
1384       pragma Assert (Present (G));
1385       pragma Assert (Present (Source));
1386       pragma Assert (Present (Actual_Destination));
1387       pragma Assert (Present (Expected_Destination));
1388
1389       --  The actual and expected destination vertices match, and denote the
1390       --  initial declaration of a unit.
1391       --
1392       --            with   Actual_Destination
1393       --    Source ------> spec -->
1394       --                   Expected_Destination
1395       --
1396       --            with   Actual_Destination
1397       --    Source ------> stand-alone body -->
1398       --                   Expected_Destination
1399
1400       if Actual_Destination = Expected_Destination then
1401          Error_Msg_Unit_1 := Name (G, Source);
1402          Error_Msg_Unit_2 := Name (G, Actual_Destination);
1403          Error_Msg_Info
1404            ("    unit $ has with clause for unit $");
1405
1406       --  The actual destination vertex denotes the spec of a unit while the
1407       --  expected destination is the corresponding body, and the unit is in
1408       --  the closure of an earlier Elaborate_All pragma.
1409       --
1410       --            with   Actual_Destination
1411       --    Source ------> spec
1412       --
1413       --                   body -->
1414       --                   Expected_Destination
1415
1416       elsif Elaborate_All_Active then
1417          pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
1418          pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
1419          pragma Assert
1420            (Proper_Body (G, Actual_Destination) = Expected_Destination);
1421
1422          Error_Msg_Unit_1 := Name (G, Source);
1423          Error_Msg_Unit_2 := Name (G, Actual_Destination);
1424          Error_Msg_Info
1425            ("    unit $ has with clause for unit $");
1426
1427          Error_Msg_Unit_1 := Name (G, Expected_Destination);
1428          Error_Msg_Info
1429            ("    unit $ is in the closure of pragma Elaborate_All");
1430
1431       --  Otherwise the actual destination vertex denotes a spec subject to
1432       --  pragma Elaborate_Body while the expected destination denotes the
1433       --  corresponding body.
1434       --
1435       --            with   Actual_Destination
1436       --    Source ------> spec Elaborate_Body
1437       --
1438       --                   body -->
1439       --                   Expected_Destination
1440
1441       else
1442          pragma Assert
1443            (Is_Elaborate_Body_Pair
1444              (G           => G,
1445               Spec_Vertex => Actual_Destination,
1446               Body_Vertex => Expected_Destination));
1447
1448          Error_Msg_Unit_1 := Name (G, Source);
1449          Error_Msg_Unit_2 := Name (G, Actual_Destination);
1450          Error_Msg_Info
1451            ("    unit $ has with clause for unit $");
1452
1453          Error_Msg_Unit_1 := Name (G, Actual_Destination);
1454          Error_Msg_Info
1455            ("    unit $ is subject to pragma Elaborate_Body");
1456
1457          Error_Msg_Unit_1 := Name (G, Expected_Destination);
1458          Error_Msg_Info
1459            ("    unit $ is in the closure of pragma Elaborate_Body");
1460       end if;
1461    end Output_With_Transition;
1462
1463    ------------------
1464    -- Visit_Vertex --
1465    ------------------
1466
1467    procedure Visit_Vertex
1468      (Inv_Graph         : Invocation_Graph;
1469       Lib_Graph         : Library_Graph;
1470       Invoker           : Invocation_Graph_Vertex_Id;
1471       Invoker_Vertex    : Library_Graph_Vertex_Id;
1472       Last_Vertex       : Library_Graph_Vertex_Id;
1473       Elaborated_Vertex : Library_Graph_Vertex_Id;
1474       End_Vertex        : Library_Graph_Vertex_Id;
1475       Visited_Invokers  : IGV_Sets.Membership_Set;
1476       Path              : IGE_Lists.Doubly_Linked_List;
1477       Path_Id           : in out Nat)
1478    is
1479       Edge : Invocation_Graph_Edge_Id;
1480       Iter : Edges_To_Targets_Iterator;
1481       Targ : Invocation_Graph_Vertex_Id;
1482
1483    begin
1484       pragma Assert (Present (Inv_Graph));
1485       pragma Assert (Present (Lib_Graph));
1486       pragma Assert (Present (Invoker));
1487       pragma Assert (Present (Invoker_Vertex));
1488       pragma Assert (Present (Last_Vertex));
1489       pragma Assert (Present (Elaborated_Vertex));
1490       pragma Assert (Present (End_Vertex));
1491       pragma Assert (IGV_Sets.Present (Visited_Invokers));
1492       pragma Assert (IGE_Lists.Present (Path));
1493
1494       --  The current invocation vertex resides within the end library vertex.
1495       --  Emit the path that started from some elaboration root and ultimately
1496       --  reached the desired library vertex.
1497
1498       if Body_Vertex (Inv_Graph, Invoker) = End_Vertex
1499         and then Invoker_Vertex /= Last_Vertex
1500       then
1501          Output_Invocation_Path
1502            (Inv_Graph         => Inv_Graph,
1503             Lib_Graph         => Lib_Graph,
1504             Elaborated_Vertex => Elaborated_Vertex,
1505             Path              => Path,
1506             Path_Id           => Path_Id);
1507
1508       --  Otherwise extend the search for the end library vertex via all edges
1509       --  to targets.
1510
1511       elsif not IGV_Sets.Contains (Visited_Invokers, Invoker) then
1512
1513          --  Prepare for invoker backtracking
1514
1515          IGV_Sets.Insert (Visited_Invokers, Invoker);
1516
1517          --  Extend the search via all edges to targets
1518
1519          Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
1520          while Has_Next (Iter) loop
1521             Next (Iter, Edge);
1522
1523             --  Prepare for edge backtracking
1524
1525             IGE_Lists.Append (Path, Edge);
1526
1527             --  The traversal proceeds through the library vertex that houses
1528             --  the body of the target.
1529
1530             Targ := Target (Inv_Graph, Edge);
1531
1532             Visit_Vertex
1533               (Inv_Graph         => Inv_Graph,
1534                Lib_Graph         => Lib_Graph,
1535                Invoker           => Targ,
1536                Invoker_Vertex    => Body_Vertex (Inv_Graph, Targ),
1537                Last_Vertex       => Invoker_Vertex,
1538                Elaborated_Vertex => Elaborated_Vertex,
1539                End_Vertex        => End_Vertex,
1540                Visited_Invokers  => Visited_Invokers,
1541                Path              => Path,
1542                Path_Id           => Path_Id);
1543
1544             --  Backtrack the edge
1545
1546             IGE_Lists.Delete_Last (Path);
1547          end loop;
1548
1549          --  Backtrack the invoker
1550
1551          IGV_Sets.Delete (Visited_Invokers, Invoker);
1552       end if;
1553    end Visit_Vertex;
1554
1555 end Bindo.Diagnostics;