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