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 26with Binderr; use Binderr; 27with Debug; use Debug; 28with Rident; use Rident; 29with Types; use Types; 30 31with Bindo.Validators; 32use Bindo.Validators; 33use Bindo.Validators.Cycle_Validators; 34 35with Bindo.Writers; 36use Bindo.Writers; 37use Bindo.Writers.Cycle_Writers; 38use Bindo.Writers.Phase_Writers; 39 40package 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 1534end Bindo.Diagnostics; 1535