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