1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- X R E F _ L I B -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1998-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 26pragma Ada_2012; 27 28with Osint; 29with Output; use Output; 30with Types; use Types; 31 32with Unchecked_Deallocation; 33 34with Ada.Strings.Fixed; use Ada.Strings.Fixed; 35with Ada.Text_IO; 36 37with GNAT.Command_Line; use GNAT.Command_Line; 38with GNAT.IO_Aux; use GNAT.IO_Aux; 39 40package body Xref_Lib is 41 42 Type_Position : constant := 50; 43 -- Column for label identifying type of entity 44 45 --------------------- 46 -- Local Variables -- 47 --------------------- 48 49 Pipe : constant Character := '|'; 50 -- First character on xref lines in the .ali file 51 52 No_Xref_Information : exception; 53 -- Exception raised when there is no cross-referencing information in 54 -- the .ali files. 55 56 procedure Parse_EOL 57 (Source : not null access String; 58 Ptr : in out Positive; 59 Skip_Continuation_Line : Boolean := False); 60 -- On return Source (Ptr) is the first character of the next line 61 -- or EOF. Source.all must be terminated by EOF. 62 -- 63 -- If Skip_Continuation_Line is True, this subprogram skips as many 64 -- lines as required when the second or more lines starts with '.' 65 -- (continuation lines in ALI files). 66 67 function Current_Xref_File (File : ALI_File) return File_Reference; 68 -- Return the file matching the last 'X' line we found while parsing 69 -- the ALI file. 70 71 function File_Name (File : ALI_File; Num : Positive) return File_Reference; 72 -- Returns the dependency file name number Num 73 74 function Get_Full_Type (Decl : Declaration_Reference) return String; 75 -- Returns the full type corresponding to a type letter as found in 76 -- the .ali files. 77 78 procedure Open 79 (Name : String; 80 File : in out ALI_File; 81 Dependencies : Boolean := False); 82 -- Open a new ALI file. If Dependencies is True, the insert every library 83 -- file 'with'ed in the files database (used for gnatxref) 84 85 procedure Parse_Identifier_Info 86 (Pattern : Search_Pattern; 87 File : in out ALI_File; 88 Local_Symbols : Boolean; 89 Der_Info : Boolean := False; 90 Type_Tree : Boolean := False; 91 Wide_Search : Boolean := True; 92 Labels_As_Ref : Boolean := True); 93 -- Output the file and the line where the identifier was referenced, 94 -- If Local_Symbols is False then only the publicly visible symbols 95 -- will be processed. 96 -- 97 -- If Labels_As_Ref is true, then the references to the entities after 98 -- the end statements ("end Foo") will be counted as actual references. 99 -- The entity will never be reported as unreferenced by gnatxref -u 100 101 procedure Parse_Token 102 (Source : not null access String; 103 Ptr : in out Positive; 104 Token_Ptr : out Positive); 105 -- Skips any separators and stores the start of the token in Token_Ptr. 106 -- Then stores the position of the next separator in Ptr. On return 107 -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space 108 -- and ASCII.HT. Parse_Token will never skip to the next line. 109 110 procedure Parse_Number 111 (Source : not null access String; 112 Ptr : in out Positive; 113 Number : out Natural); 114 -- Skips any separators and parses Source up to the first character that 115 -- is not a decimal digit. Returns value of parsed digits or 0 if none. 116 117 procedure Parse_X_Filename (File : in out ALI_File); 118 -- Reads and processes "X..." lines in the ALI file 119 -- and updates the File.X_File information. 120 121 procedure Skip_To_First_X_Line 122 (File : in out ALI_File; 123 D_Lines : Boolean; 124 W_Lines : Boolean); 125 -- Skip the lines in the ALI file until the first cross-reference line 126 -- (^X...) is found. Search is started from the beginning of the file. 127 -- If not such line is found, No_Xref_Information is raised. 128 -- If W_Lines is false, then the lines "^W" are not parsed. 129 -- If D_Lines is false, then the lines "^D" are not parsed. 130 131 ---------------- 132 -- Add_Entity -- 133 ---------------- 134 135 procedure Add_Entity 136 (Pattern : in out Search_Pattern; 137 Entity : String; 138 Glob : Boolean := False) 139 is 140 File_Start : Natural; 141 Line_Start : Natural; 142 Col_Start : Natural; 143 Line_Num : Natural := 0; 144 Col_Num : Natural := 0; 145 146 File_Ref : File_Reference := Empty_File; 147 pragma Warnings (Off, File_Ref); 148 149 begin 150 -- Find the end of the first item in Entity (pattern or file?) 151 -- If there is no ':', we only have a pattern 152 153 File_Start := Index (Entity, ":"); 154 155 -- If the regular expression is invalid, just consider it as a string 156 157 if File_Start = 0 then 158 begin 159 Pattern.Entity := Compile (Entity, Glob, False); 160 Pattern.Initialized := True; 161 162 exception 163 when Error_In_Regexp => 164 165 -- The basic idea is to insert a \ before every character 166 167 declare 168 Tmp_Regexp : String (1 .. 2 * Entity'Length); 169 Index : Positive := 1; 170 171 begin 172 for J in Entity'Range loop 173 Tmp_Regexp (Index) := '\'; 174 Tmp_Regexp (Index + 1) := Entity (J); 175 Index := Index + 2; 176 end loop; 177 178 Pattern.Entity := Compile (Tmp_Regexp, True, False); 179 Pattern.Initialized := True; 180 end; 181 end; 182 183 Set_Default_Match (True); 184 return; 185 end if; 186 187 -- If there is a dot in the pattern, then it is a file name 188 189 if (Glob and then 190 Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) 191 or else 192 (not Glob 193 and then Index (Entity (Entity'First .. File_Start - 1), 194 "\.") /= 0) 195 then 196 Pattern.Entity := Compile (".*", False); 197 Pattern.Initialized := True; 198 File_Start := Entity'First; 199 200 else 201 -- If the regular expression is invalid, just consider it as a string 202 203 begin 204 Pattern.Entity := 205 Compile (Entity (Entity'First .. File_Start - 1), Glob, False); 206 Pattern.Initialized := True; 207 208 exception 209 when Error_In_Regexp => 210 211 -- The basic idea is to insert a \ before every character 212 213 declare 214 Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First)); 215 Index : Positive := 1; 216 217 begin 218 for J in Entity'First .. File_Start - 1 loop 219 Tmp_Regexp (Index) := '\'; 220 Tmp_Regexp (Index + 1) := Entity (J); 221 Index := Index + 2; 222 end loop; 223 224 Pattern.Entity := Compile (Tmp_Regexp, True, False); 225 Pattern.Initialized := True; 226 end; 227 end; 228 229 File_Start := File_Start + 1; 230 end if; 231 232 -- Parse the file name 233 234 Line_Start := Index (Entity (File_Start .. Entity'Last), ":"); 235 236 -- Check if it was a disk:\directory item (for Windows) 237 238 if File_Start = Line_Start - 1 239 and then Line_Start < Entity'Last 240 and then Entity (Line_Start + 1) = '\' 241 then 242 Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); 243 end if; 244 245 if Line_Start = 0 then 246 Line_Start := Entity'Length + 1; 247 248 elsif Line_Start /= Entity'Last then 249 Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); 250 251 if Col_Start = 0 then 252 Col_Start := Entity'Last + 1; 253 end if; 254 255 if Col_Start > Line_Start + 1 then 256 begin 257 Line_Num := Natural'Value 258 (Entity (Line_Start + 1 .. Col_Start - 1)); 259 260 exception 261 when Constraint_Error => 262 raise Invalid_Argument; 263 end; 264 end if; 265 266 if Col_Start < Entity'Last then 267 begin 268 Col_Num := Natural'Value (Entity 269 (Col_Start + 1 .. Entity'Last)); 270 271 exception 272 when Constraint_Error => raise Invalid_Argument; 273 end; 274 end if; 275 end if; 276 277 declare 278 File_Name : String := Entity (File_Start .. Line_Start - 1); 279 280 begin 281 Osint.Canonical_Case_File_Name (File_Name); 282 File_Ref := Add_To_Xref_File (File_Name, Visited => True); 283 Pattern.File_Ref := File_Ref; 284 285 Add_Line (Pattern.File_Ref, Line_Num, Col_Num); 286 287 File_Ref := 288 Add_To_Xref_File 289 (ALI_File_Name (File_Name), 290 Visited => False, 291 Emit_Warning => True); 292 end; 293 end Add_Entity; 294 295 ------------------- 296 -- Add_Xref_File -- 297 ------------------- 298 299 procedure Add_Xref_File (File : String) is 300 File_Ref : File_Reference := Empty_File; 301 pragma Unreferenced (File_Ref); 302 303 Iterator : Expansion_Iterator; 304 305 procedure Add_Xref_File_Internal (File : String); 306 -- Do the actual addition of the file 307 308 ---------------------------- 309 -- Add_Xref_File_Internal -- 310 ---------------------------- 311 312 procedure Add_Xref_File_Internal (File : String) is 313 begin 314 -- Case where we have an ALI file, accept it even though this is 315 -- not official usage, since the intention is obvious 316 317 if Tail (File, 4) = "." & Osint.ALI_Suffix.all then 318 File_Ref := Add_To_Xref_File 319 (File, Visited => False, Emit_Warning => True); 320 321 -- Normal non-ali file case 322 323 else 324 File_Ref := Add_To_Xref_File (File, Visited => True); 325 326 File_Ref := Add_To_Xref_File 327 (ALI_File_Name (File), 328 Visited => False, Emit_Warning => True); 329 end if; 330 end Add_Xref_File_Internal; 331 332 -- Start of processing for Add_Xref_File 333 334 begin 335 -- Check if we need to do the expansion 336 337 if Ada.Strings.Fixed.Index (File, "*") /= 0 338 or else Ada.Strings.Fixed.Index (File, "?") /= 0 339 then 340 Start_Expansion (Iterator, File); 341 342 loop 343 declare 344 S : constant String := Expansion (Iterator); 345 346 begin 347 exit when S'Length = 0; 348 Add_Xref_File_Internal (S); 349 end; 350 end loop; 351 352 else 353 Add_Xref_File_Internal (File); 354 end if; 355 end Add_Xref_File; 356 357 ----------------------- 358 -- Current_Xref_File -- 359 ----------------------- 360 361 function Current_Xref_File (File : ALI_File) return File_Reference is 362 begin 363 return File.X_File; 364 end Current_Xref_File; 365 366 -------------------------- 367 -- Default_Project_File -- 368 -------------------------- 369 370 function Default_Project_File (Dir_Name : String) return String is 371 My_Dir : Dir_Type; 372 Dir_Ent : File_Name_String; 373 Last : Natural; 374 375 begin 376 Open (My_Dir, Dir_Name); 377 378 loop 379 Read (My_Dir, Dir_Ent, Last); 380 exit when Last = 0; 381 382 if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then 383 384 -- The first project file found is the good one 385 386 Close (My_Dir); 387 return Dir_Ent (1 .. Last); 388 end if; 389 end loop; 390 391 Close (My_Dir); 392 return String'(1 .. 0 => ' '); 393 394 exception 395 when Directory_Error => return String'(1 .. 0 => ' '); 396 end Default_Project_File; 397 398 --------------- 399 -- File_Name -- 400 --------------- 401 402 function File_Name 403 (File : ALI_File; 404 Num : Positive) return File_Reference 405 is 406 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); 407 begin 408 return Table (Num); 409 end File_Name; 410 411 -------------------- 412 -- Find_ALI_Files -- 413 -------------------- 414 415 procedure Find_ALI_Files is 416 My_Dir : Rec_DIR; 417 Dir_Ent : File_Name_String; 418 Last : Natural; 419 420 File_Ref : File_Reference; 421 pragma Unreferenced (File_Ref); 422 423 function Open_Next_Dir return Boolean; 424 -- Tries to open the next object directory, and return False if 425 -- the directory cannot be opened. 426 427 ------------------- 428 -- Open_Next_Dir -- 429 ------------------- 430 431 function Open_Next_Dir return Boolean is 432 begin 433 -- Until we are able to open a new directory 434 435 loop 436 declare 437 Obj_Dir : constant String := Next_Obj_Dir; 438 439 begin 440 -- Case of no more Obj_Dir lines 441 442 if Obj_Dir'Length = 0 then 443 return False; 444 end if; 445 446 Open (My_Dir.Dir, Obj_Dir); 447 exit; 448 449 exception 450 451 -- Could not open the directory 452 453 when Directory_Error => null; 454 end; 455 end loop; 456 457 return True; 458 end Open_Next_Dir; 459 460 -- Start of processing for Find_ALI_Files 461 462 begin 463 Reset_Obj_Dir; 464 465 if Open_Next_Dir then 466 loop 467 Read (My_Dir.Dir, Dir_Ent, Last); 468 469 if Last = 0 then 470 Close (My_Dir.Dir); 471 472 if not Open_Next_Dir then 473 return; 474 end if; 475 476 elsif Last > 4 477 and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all 478 then 479 File_Ref := 480 Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False); 481 end if; 482 end loop; 483 end if; 484 end Find_ALI_Files; 485 486 ------------------- 487 -- Get_Full_Type -- 488 ------------------- 489 490 function Get_Full_Type (Decl : Declaration_Reference) return String is 491 492 function Param_String return String; 493 -- Return the string to display depending on whether Decl is a parameter 494 495 ------------------ 496 -- Param_String -- 497 ------------------ 498 499 function Param_String return String is 500 begin 501 if Is_Parameter (Decl) then 502 return "parameter "; 503 else 504 return ""; 505 end if; 506 end Param_String; 507 508 -- Start of processing for Get_Full_Type 509 510 begin 511 case Get_Type (Decl) is 512 when 'A' => return "array type"; 513 when 'B' => return "boolean type"; 514 when 'C' => return "class-wide type"; 515 when 'D' => return "decimal type"; 516 when 'E' => return "enumeration type"; 517 when 'F' => return "float type"; 518 when 'H' => return "abstract type"; 519 when 'I' => return "integer type"; 520 when 'M' => return "modular type"; 521 when 'O' => return "fixed type"; 522 when 'P' => return "access type"; 523 when 'R' => return "record type"; 524 when 'S' => return "string type"; 525 when 'T' => return "task type"; 526 when 'W' => return "protected type"; 527 528 when 'a' => return Param_String & "array object"; 529 when 'b' => return Param_String & "boolean object"; 530 when 'c' => return Param_String & "class-wide object"; 531 when 'd' => return Param_String & "decimal object"; 532 when 'e' => return Param_String & "enumeration object"; 533 when 'f' => return Param_String & "float object"; 534 when 'i' => return Param_String & "integer object"; 535 when 'j' => return Param_String & "class object"; 536 when 'm' => return Param_String & "modular object"; 537 when 'o' => return Param_String & "fixed object"; 538 when 'p' => return Param_String & "access object"; 539 when 'r' => return Param_String & "record object"; 540 when 's' => return Param_String & "string object"; 541 when 't' => return Param_String & "task object"; 542 when 'w' => return Param_String & "protected object"; 543 when 'x' => return Param_String & "abstract procedure"; 544 when 'y' => return Param_String & "abstract function"; 545 546 when 'h' => return "interface"; 547 when 'g' => return "macro"; 548 when 'G' => return "function macro"; 549 when 'J' => return "class"; 550 when 'K' => return "package"; 551 when 'k' => return "generic package"; 552 when 'L' => return "statement label"; 553 when 'l' => return "loop label"; 554 when 'N' => return "named number"; 555 when 'n' => return "enumeration literal"; 556 when 'q' => return "block label"; 557 when 'Q' => return "include file"; 558 when 'U' => return "procedure"; 559 when 'u' => return "generic procedure"; 560 when 'V' => return "function"; 561 when 'v' => return "generic function"; 562 when 'X' => return "exception"; 563 when 'Y' => return "entry"; 564 565 when '+' => return "private type"; 566 when '*' => return "private variable"; 567 568 -- The above should be the only possibilities, but for this kind 569 -- of informational output, we don't want to bomb if we find 570 -- something else, so just return three question marks when we 571 -- have an unknown Abbrev value 572 573 when others => 574 if Is_Parameter (Decl) then 575 return "parameter"; 576 else 577 return "??? (" & Get_Type (Decl) & ")"; 578 end if; 579 end case; 580 end Get_Full_Type; 581 582 -------------------------- 583 -- Skip_To_First_X_Line -- 584 -------------------------- 585 586 procedure Skip_To_First_X_Line 587 (File : in out ALI_File; 588 D_Lines : Boolean; 589 W_Lines : Boolean) 590 is 591 Ali : String_Access renames File.Buffer; 592 Token : Positive; 593 Ptr : Positive := Ali'First; 594 Num_Dependencies : Natural := 0; 595 File_Start : Positive; 596 File_End : Positive; 597 Gnatchop_Offset : Integer; 598 Gnatchop_Name : Positive; 599 600 File_Ref : File_Reference; 601 pragma Unreferenced (File_Ref); 602 603 begin 604 -- Read all the lines possibly processing with-clauses and dependency 605 -- information and exit on finding the first Xref line. 606 -- A fall-through of the loop means that there is no xref information 607 -- which is an error condition. 608 609 while Ali (Ptr) /= EOF loop 610 if D_Lines and then Ali (Ptr) = 'D' then 611 612 -- Found dependency information. Format looks like: 613 -- D src-nam time-stmp checksum [subunit-name] [line:file-name] 614 615 -- Skip the D and parse the filenam 616 617 Ptr := Ptr + 1; 618 Parse_Token (Ali, Ptr, Token); 619 File_Start := Token; 620 File_End := Ptr - 1; 621 622 Num_Dependencies := Num_Dependencies + 1; 623 Set_Last (File.Dep, Num_Dependencies); 624 625 Parse_Token (Ali, Ptr, Token); -- Skip time-stamp 626 Parse_Token (Ali, Ptr, Token); -- Skip checksum 627 Parse_Token (Ali, Ptr, Token); -- Read next entity on the line 628 629 if not (Ali (Token) in '0' .. '9') then 630 Parse_Token (Ali, Ptr, Token); -- Was a subunit name 631 end if; 632 633 -- Did we have a gnatchop-ed file with a pragma Source_Reference ? 634 635 Gnatchop_Offset := 0; 636 637 if Ali (Token) in '0' .. '9' then 638 Gnatchop_Name := Token; 639 while Ali (Gnatchop_Name) /= ':' loop 640 Gnatchop_Name := Gnatchop_Name + 1; 641 end loop; 642 643 Gnatchop_Offset := 644 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); 645 Token := Gnatchop_Name + 1; 646 end if; 647 648 declare 649 Table : Table_Type renames 650 File.Dep.Table (1 .. Last (File.Dep)); 651 begin 652 Table (Num_Dependencies) := Add_To_Xref_File 653 (Ali (File_Start .. File_End), 654 Gnatchop_File => Ali (Token .. Ptr - 1), 655 Gnatchop_Offset => Gnatchop_Offset); 656 end; 657 658 elsif W_Lines and then Ali (Ptr) = 'W' then 659 660 -- Found with-clause information. Format looks like: 661 -- "W debug%s debug.adb debug.ali" 662 663 -- Skip the W and parse the .ali filename (3rd token) 664 665 Parse_Token (Ali, Ptr, Token); 666 Parse_Token (Ali, Ptr, Token); 667 Parse_Token (Ali, Ptr, Token); 668 669 File_Ref := 670 Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False); 671 672 elsif Ali (Ptr) = 'X' then 673 674 -- Found a cross-referencing line - stop processing 675 676 File.Current_Line := Ptr; 677 File.Xref_Line := Ptr; 678 return; 679 end if; 680 681 Parse_EOL (Ali, Ptr); 682 end loop; 683 684 raise No_Xref_Information; 685 end Skip_To_First_X_Line; 686 687 ---------- 688 -- Open -- 689 ---------- 690 691 procedure Open 692 (Name : String; 693 File : in out ALI_File; 694 Dependencies : Boolean := False) 695 is 696 Ali : String_Access renames File.Buffer; 697 pragma Warnings (Off, Ali); 698 699 begin 700 if File.Buffer /= null then 701 Free (File.Buffer); 702 end if; 703 704 Init (File.Dep); 705 706 begin 707 Read_File (Name, Ali); 708 709 exception 710 when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => 711 raise No_Xref_Information; 712 end; 713 714 Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies); 715 end Open; 716 717 --------------- 718 -- Parse_EOL -- 719 --------------- 720 721 procedure Parse_EOL 722 (Source : not null access String; 723 Ptr : in out Positive; 724 Skip_Continuation_Line : Boolean := False) 725 is 726 begin 727 loop 728 pragma Assert (Source (Ptr) /= EOF); 729 730 -- Skip to end of line 731 732 while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF 733 and then Source (Ptr) /= EOF 734 loop 735 Ptr := Ptr + 1; 736 end loop; 737 738 -- Skip CR or LF if not at end of file 739 740 if Source (Ptr) /= EOF then 741 Ptr := Ptr + 1; 742 end if; 743 744 -- Skip past CR/LF 745 746 if Source (Ptr - 1) = ASCII.CR and then Source (Ptr) = ASCII.LF then 747 Ptr := Ptr + 1; 748 end if; 749 750 exit when not Skip_Continuation_Line or else Source (Ptr) /= '.'; 751 end loop; 752 end Parse_EOL; 753 754 --------------------------- 755 -- Parse_Identifier_Info -- 756 --------------------------- 757 758 procedure Parse_Identifier_Info 759 (Pattern : Search_Pattern; 760 File : in out ALI_File; 761 Local_Symbols : Boolean; 762 Der_Info : Boolean := False; 763 Type_Tree : Boolean := False; 764 Wide_Search : Boolean := True; 765 Labels_As_Ref : Boolean := True) 766 is 767 Ptr : Positive renames File.Current_Line; 768 Ali : String_Access renames File.Buffer; 769 770 E_Line : Natural; -- Line number of current entity 771 E_Col : Natural; -- Column number of current entity 772 E_Name : Positive; -- Pointer to begin of entity name 773 E_Global : Boolean; -- True iff entity is global 774 E_Type : Character; -- Type of current entity 775 776 R_Line : Natural; -- Line number of current reference 777 R_Col : Natural; -- Column number of current reference 778 779 R_Type : Character := ASCII.NUL; -- Type of current reference 780 781 Decl_Ref : Declaration_Reference; 782 File_Ref : File_Reference := Current_Xref_File (File); 783 784 function Get_Symbol_Name (Eun, Line, Col : Natural) return String; 785 -- Returns the symbol name for the entity defined at the specified 786 -- line and column in the dependent unit number Eun. For this we need 787 -- to parse the ali file again because the parent entity is not in 788 -- the declaration table if it did not match the search pattern. 789 -- If the symbol is not found, we return "???". 790 791 procedure Skip_To_Matching_Closing_Bracket; 792 -- When Ptr points to an opening square bracket, moves it to the 793 -- character following the matching closing bracket 794 795 --------------------- 796 -- Get_Symbol_Name -- 797 --------------------- 798 799 function Get_Symbol_Name (Eun, Line, Col : Natural) return String is 800 Ptr : Positive := 1; 801 E_Eun : Positive; -- Unit number of current entity 802 E_Line : Natural; -- Line number of current entity 803 E_Col : Natural; -- Column number of current entity 804 E_Name : Positive; -- Pointer to begin of entity name 805 806 begin 807 -- Look for the X lines corresponding to unit Eun 808 809 loop 810 if Ali (Ptr) = EOF then 811 return "???"; 812 end if; 813 814 if Ali (Ptr) = 'X' then 815 Ptr := Ptr + 1; 816 Parse_Number (Ali, Ptr, E_Eun); 817 exit when E_Eun = Eun; 818 end if; 819 820 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 821 end loop; 822 823 -- Here we are in the right Ali section, we now look for the entity 824 -- declared at position (Line, Col). 825 826 loop 827 Parse_Number (Ali, Ptr, E_Line); 828 exit when Ali (Ptr) = EOF; 829 Ptr := Ptr + 1; 830 Parse_Number (Ali, Ptr, E_Col); 831 exit when Ali (Ptr) = EOF; 832 Ptr := Ptr + 1; 833 834 if Line = E_Line and then Col = E_Col then 835 Parse_Token (Ali, Ptr, E_Name); 836 return Ali (E_Name .. Ptr - 1); 837 end if; 838 839 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 840 exit when Ali (Ptr) = EOF; 841 end loop; 842 843 return "???"; 844 end Get_Symbol_Name; 845 846 -------------------------------------- 847 -- Skip_To_Matching_Closing_Bracket -- 848 -------------------------------------- 849 850 procedure Skip_To_Matching_Closing_Bracket is 851 Num_Brackets : Natural; 852 853 begin 854 Num_Brackets := 1; 855 while Num_Brackets /= 0 loop 856 Ptr := Ptr + 1; 857 if Ali (Ptr) = '[' then 858 Num_Brackets := Num_Brackets + 1; 859 elsif Ali (Ptr) = ']' then 860 Num_Brackets := Num_Brackets - 1; 861 end if; 862 end loop; 863 864 Ptr := Ptr + 1; 865 end Skip_To_Matching_Closing_Bracket; 866 867 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); 868 869 -- Start of processing for Parse_Identifier_Info 870 871 begin 872 -- The identifier info looks like: 873 -- "38U9*Debug 12|36r6 36r19" 874 875 -- Extract the line, column and entity name information 876 877 Parse_Number (Ali, Ptr, E_Line); 878 879 if Ali (Ptr) > ' ' then 880 E_Type := Ali (Ptr); 881 Ptr := Ptr + 1; 882 883 -- Ignore some of the entities (labels,...) 884 885 if E_Type in 'l' | 'L' | 'q' then 886 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 887 return; 888 end if; 889 else 890 -- Unexpected contents, skip line and return 891 892 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 893 return; 894 end if; 895 896 Parse_Number (Ali, Ptr, E_Col); 897 898 E_Global := False; 899 if Ali (Ptr) >= ' ' then 900 E_Global := (Ali (Ptr) = '*'); 901 Ptr := Ptr + 1; 902 end if; 903 904 Parse_Token (Ali, Ptr, E_Name); 905 906 -- Exit if the symbol does not match or if we have a local symbol and we 907 -- do not want it or if the file is unknown. 908 909 if File.X_File = Empty_File then 910 return; 911 end if; 912 913 if (not Local_Symbols and not E_Global) 914 or else (Pattern.Initialized 915 and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) 916 or else (E_Name >= Ptr) 917 then 918 Decl_Ref := Add_Declaration 919 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, 920 Remove_Only => True); 921 Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); 922 return; 923 end if; 924 925 -- Insert the declaration in the table 926 927 Decl_Ref := Add_Declaration 928 (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); 929 930 if Ali (Ptr) = '[' then 931 Skip_To_Matching_Closing_Bracket; 932 end if; 933 934 -- Skip any renaming indication 935 936 if Ali (Ptr) = '=' then 937 declare 938 P_Line, P_Column : Natural; 939 pragma Warnings (Off, P_Line); 940 pragma Warnings (Off, P_Column); 941 begin 942 Ptr := Ptr + 1; 943 Parse_Number (Ali, Ptr, P_Line); 944 Ptr := Ptr + 1; 945 Parse_Number (Ali, Ptr, P_Column); 946 end; 947 end if; 948 949 while Ptr <= Ali'Last 950 and then (Ali (Ptr) = '<' 951 or else Ali (Ptr) = '(' 952 or else Ali (Ptr) = '{') 953 loop 954 -- Here we have a type derivation information. The format is 955 -- <3|12I45> which means that the current entity is derived from the 956 -- type defined in unit number 3, line 12 column 45. The pipe and 957 -- unit number is optional. It is specified only if the parent type 958 -- is not defined in the current unit. 959 960 -- We also have the format for generic instantiations, as in 961 -- 7a5*Uid(3|5I8[4|2]) 2|4r74 962 963 -- We could also have something like 964 -- 16I9*I<integer> 965 -- that indicates that I derives from the predefined type integer. 966 967 Ptr := Ptr + 1; 968 969 if Ali (Ptr) in '0' .. '9' then 970 Parse_Derived_Info : declare 971 P_Line : Natural; -- parent entity line 972 P_Column : Natural; -- parent entity column 973 P_Eun : Natural := 0; -- parent entity file number 974 975 begin 976 Parse_Number (Ali, Ptr, P_Line); 977 978 -- If we have a pipe then the first number was the unit number 979 980 if Ali (Ptr) = '|' then 981 P_Eun := P_Line; 982 Ptr := Ptr + 1; 983 984 -- Now we have the line number 985 986 Parse_Number (Ali, Ptr, P_Line); 987 988 else 989 -- We don't have a unit number specified, so we set P_Eun to 990 -- the current unit. 991 992 for K in Table'Range loop 993 P_Eun := K; 994 exit when Table (K) = File_Ref; 995 end loop; 996 end if; 997 998 -- Then parse the type and column number 999 1000 Ptr := Ptr + 1; 1001 Parse_Number (Ali, Ptr, P_Column); 1002 1003 -- Skip the information for generics instantiations 1004 1005 if Ali (Ptr) = '[' then 1006 Skip_To_Matching_Closing_Bracket; 1007 end if; 1008 1009 -- Skip '>', or ')' or '>' 1010 1011 Ptr := Ptr + 1; 1012 1013 -- The derived info is needed only is the derived info mode is 1014 -- on or if we want to output the type hierarchy 1015 1016 if Der_Info or else Type_Tree then 1017 pragma Assert (P_Eun /= 0); 1018 1019 declare 1020 Symbol : constant String := 1021 Get_Symbol_Name (P_Eun, P_Line, P_Column); 1022 begin 1023 if Symbol /= "???" then 1024 Add_Parent 1025 (Decl_Ref, 1026 Symbol, 1027 P_Line, 1028 P_Column, 1029 Table (P_Eun)); 1030 end if; 1031 end; 1032 end if; 1033 1034 if Type_Tree 1035 and then (Pattern.File_Ref = Empty_File 1036 or else 1037 Pattern.File_Ref = Current_Xref_File (File)) 1038 then 1039 Search_Parent_Tree : declare 1040 Pattern : Search_Pattern; -- Parent type pattern 1041 File_Pos_Backup : Positive; 1042 1043 begin 1044 Add_Entity 1045 (Pattern, 1046 Get_Symbol_Name (P_Eun, P_Line, P_Column) 1047 & ':' & Get_Gnatchop_File (Table (P_Eun)) 1048 & ':' & Get_Line (Get_Parent (Decl_Ref)) 1049 & ':' & Get_Column (Get_Parent (Decl_Ref)), 1050 False); 1051 1052 -- No default match is needed to look for the parent type 1053 -- since we are using the fully qualified symbol name: 1054 -- symbol:file:line:column 1055 1056 Set_Default_Match (False); 1057 1058 -- The parent hierarchy is defined in the same unit as 1059 -- the derived type. So we want to revisit the unit. 1060 1061 File_Pos_Backup := File.Current_Line; 1062 1063 Skip_To_First_X_Line 1064 (File, D_Lines => False, W_Lines => False); 1065 1066 while File.Buffer (File.Current_Line) /= EOF loop 1067 Parse_X_Filename (File); 1068 Parse_Identifier_Info 1069 (Pattern => Pattern, 1070 File => File, 1071 Local_Symbols => False, 1072 Der_Info => Der_Info, 1073 Type_Tree => True, 1074 Wide_Search => False, 1075 Labels_As_Ref => Labels_As_Ref); 1076 end loop; 1077 1078 File.Current_Line := File_Pos_Backup; 1079 end Search_Parent_Tree; 1080 end if; 1081 end Parse_Derived_Info; 1082 1083 else 1084 while Ali (Ptr) /= '>' 1085 and then Ali (Ptr) /= ')' 1086 and then Ali (Ptr) /= '}' 1087 loop 1088 Ptr := Ptr + 1; 1089 end loop; 1090 Ptr := Ptr + 1; 1091 end if; 1092 end loop; 1093 1094 -- To find the body, we will have to parse the file too 1095 1096 if Wide_Search then 1097 declare 1098 File_Name : constant String := Get_Gnatchop_File (File.X_File); 1099 Ignored : File_Reference; 1100 begin 1101 Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False); 1102 end; 1103 end if; 1104 1105 -- Parse references to this entity. 1106 -- Ptr points to next reference with leading blanks 1107 1108 loop 1109 -- Process references on current line 1110 1111 while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop 1112 1113 -- For every reference read the line, type and column, 1114 -- optionally preceded by a file number and a pipe symbol. 1115 1116 Parse_Number (Ali, Ptr, R_Line); 1117 1118 if Ali (Ptr) = Pipe then 1119 Ptr := Ptr + 1; 1120 File_Ref := File_Name (File, R_Line); 1121 1122 Parse_Number (Ali, Ptr, R_Line); 1123 end if; 1124 1125 if Ali (Ptr) > ' ' then 1126 R_Type := Ali (Ptr); 1127 Ptr := Ptr + 1; 1128 end if; 1129 1130 -- Imported entities may have an indication specifying information 1131 -- about the corresponding external name: 1132 -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity 1133 -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity 1134 1135 if Ali (Ptr) = '<' 1136 and then (R_Type = 'b' or else R_Type = 'i') 1137 then 1138 while Ptr <= Ali'Last 1139 and then Ali (Ptr) /= '>' 1140 loop 1141 Ptr := Ptr + 1; 1142 end loop; 1143 Ptr := Ptr + 1; 1144 end if; 1145 1146 Parse_Number (Ali, Ptr, R_Col); 1147 1148 pragma Assert (R_Type /= ASCII.NUL); 1149 1150 -- Insert the reference or body in the table 1151 1152 Add_Reference 1153 (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); 1154 1155 -- Skip generic information, if any 1156 1157 if Ali (Ptr) = '[' then 1158 declare 1159 Num_Nested : Integer := 1; 1160 1161 begin 1162 Ptr := Ptr + 1; 1163 while Num_Nested /= 0 loop 1164 if Ali (Ptr) = ']' then 1165 Num_Nested := Num_Nested - 1; 1166 elsif Ali (Ptr) = '[' then 1167 Num_Nested := Num_Nested + 1; 1168 end if; 1169 1170 Ptr := Ptr + 1; 1171 end loop; 1172 end; 1173 end if; 1174 1175 end loop; 1176 1177 Parse_EOL (Ali, Ptr); 1178 1179 -- Loop until new line is no continuation line 1180 1181 exit when Ali (Ptr) /= '.'; 1182 Ptr := Ptr + 1; 1183 end loop; 1184 end Parse_Identifier_Info; 1185 1186 ------------------ 1187 -- Parse_Number -- 1188 ------------------ 1189 1190 procedure Parse_Number 1191 (Source : not null access String; 1192 Ptr : in out Positive; 1193 Number : out Natural) 1194 is 1195 begin 1196 -- Skip separators 1197 1198 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1199 Ptr := Ptr + 1; 1200 end loop; 1201 1202 Number := 0; 1203 while Source (Ptr) in '0' .. '9' loop 1204 Number := 1205 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); 1206 Ptr := Ptr + 1; 1207 end loop; 1208 end Parse_Number; 1209 1210 ----------------- 1211 -- Parse_Token -- 1212 ----------------- 1213 1214 procedure Parse_Token 1215 (Source : not null access String; 1216 Ptr : in out Positive; 1217 Token_Ptr : out Positive) 1218 is 1219 In_Quotes : Character := ASCII.NUL; 1220 1221 begin 1222 -- Skip separators 1223 1224 while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop 1225 Ptr := Ptr + 1; 1226 end loop; 1227 1228 Token_Ptr := Ptr; 1229 1230 -- Find end-of-token 1231 1232 while (In_Quotes /= ASCII.NUL or else 1233 not (Source (Ptr) = ' ' 1234 or else Source (Ptr) = ASCII.HT 1235 or else Source (Ptr) = '<' 1236 or else Source (Ptr) = '{' 1237 or else Source (Ptr) = '[' 1238 or else Source (Ptr) = '=' 1239 or else Source (Ptr) = '(')) 1240 and then Source (Ptr) >= ' ' 1241 loop 1242 -- Double-quotes are used for operators 1243 -- Simple-quotes are used for character constants, for instance when 1244 -- they are found in an enumeration type "type A is ('+', '-');" 1245 1246 case Source (Ptr) is 1247 when '"' | ''' => 1248 if In_Quotes = Source (Ptr) then 1249 In_Quotes := ASCII.NUL; 1250 elsif In_Quotes = ASCII.NUL then 1251 In_Quotes := Source (Ptr); 1252 end if; 1253 1254 when others => 1255 null; 1256 end case; 1257 1258 Ptr := Ptr + 1; 1259 end loop; 1260 end Parse_Token; 1261 1262 ---------------------- 1263 -- Parse_X_Filename -- 1264 ---------------------- 1265 1266 procedure Parse_X_Filename (File : in out ALI_File) is 1267 Ali : String_Access renames File.Buffer; 1268 Ptr : Positive renames File.Current_Line; 1269 File_Nr : Natural; 1270 1271 Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); 1272 1273 begin 1274 while Ali (Ptr) = 'X' loop 1275 1276 -- The current line is the start of a new Xref file section, 1277 -- whose format looks like: 1278 1279 -- " X 1 debug.ads" 1280 1281 -- Skip the X and read the file number for the new X_File 1282 1283 Ptr := Ptr + 1; 1284 Parse_Number (Ali, Ptr, File_Nr); 1285 1286 -- If the referenced file is unknown, we simply ignore it 1287 1288 if File_Nr in Table'Range then 1289 File.X_File := Table (File_Nr); 1290 else 1291 File.X_File := Empty_File; 1292 end if; 1293 1294 Parse_EOL (Ali, Ptr); 1295 end loop; 1296 end Parse_X_Filename; 1297 1298 -------------------- 1299 -- Print_Gnatfind -- 1300 -------------------- 1301 1302 procedure Print_Gnatfind 1303 (References : Boolean; 1304 Full_Path_Name : Boolean) 1305 is 1306 Decls : constant Declaration_Array_Access := Get_Declarations; 1307 Decl : Declaration_Reference; 1308 Arr : Reference_Array_Access; 1309 1310 procedure Print_Ref 1311 (Ref : Reference; 1312 Msg : String := " "); 1313 -- Print a reference, according to the extended tag of the output 1314 1315 --------------- 1316 -- Print_Ref -- 1317 --------------- 1318 1319 procedure Print_Ref 1320 (Ref : Reference; 1321 Msg : String := " ") 1322 is 1323 F : String_Access := 1324 Osint.To_Host_File_Spec 1325 (Get_Gnatchop_File (Ref, Full_Path_Name)); 1326 1327 Buffer : constant String := 1328 F.all & 1329 ":" & Get_Line (Ref) & 1330 ":" & Get_Column (Ref) & 1331 ": "; 1332 1333 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1334 1335 begin 1336 Free (F); 1337 Num_Blanks := Integer'Max (0, Num_Blanks); 1338 Write_Line 1339 (Buffer 1340 & String'(1 .. Num_Blanks => ' ') 1341 & Msg & " " & Get_Symbol (Decl)); 1342 1343 if Get_Source_Line (Ref)'Length /= 0 then 1344 Write_Line (" " & Get_Source_Line (Ref)); 1345 end if; 1346 end Print_Ref; 1347 1348 -- Start of processing for Print_Gnatfind 1349 1350 begin 1351 for D in Decls'Range loop 1352 Decl := Decls (D); 1353 1354 if Match (Decl) then 1355 1356 -- Output the declaration 1357 1358 declare 1359 Parent : constant Declaration_Reference := Get_Parent (Decl); 1360 1361 F : String_Access := 1362 Osint.To_Host_File_Spec 1363 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1364 1365 Buffer : constant String := 1366 F.all & 1367 ":" & Get_Line (Decl) & 1368 ":" & Get_Column (Decl) & 1369 ": "; 1370 1371 Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; 1372 1373 begin 1374 Free (F); 1375 Num_Blanks := Integer'Max (0, Num_Blanks); 1376 Write_Line 1377 (Buffer & String'(1 .. Num_Blanks => ' ') 1378 & "(spec) " & Get_Symbol (Decl)); 1379 1380 if Parent /= Empty_Declaration then 1381 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1382 Write_Line 1383 (Buffer & String'(1 .. Num_Blanks => ' ') 1384 & " derived from " & Get_Symbol (Parent) 1385 & " (" 1386 & F.all 1387 & ':' & Get_Line (Parent) 1388 & ':' & Get_Column (Parent) & ')'); 1389 Free (F); 1390 end if; 1391 end; 1392 1393 if Get_Source_Line (Decl)'Length /= 0 then 1394 Write_Line (" " & Get_Source_Line (Decl)); 1395 end if; 1396 1397 -- Output the body (sorted) 1398 1399 Arr := Get_References (Decl, Get_Bodies => True); 1400 1401 for R in Arr'Range loop 1402 Print_Ref (Arr (R), "(body)"); 1403 end loop; 1404 1405 Free (Arr); 1406 1407 if References then 1408 Arr := Get_References 1409 (Decl, Get_Writes => True, Get_Reads => True); 1410 1411 for R in Arr'Range loop 1412 Print_Ref (Arr (R)); 1413 end loop; 1414 1415 Free (Arr); 1416 end if; 1417 end if; 1418 end loop; 1419 end Print_Gnatfind; 1420 1421 ------------------ 1422 -- Print_Unused -- 1423 ------------------ 1424 1425 procedure Print_Unused (Full_Path_Name : Boolean) is 1426 Decls : constant Declaration_Array_Access := Get_Declarations; 1427 Decl : Declaration_Reference; 1428 Arr : Reference_Array_Access; 1429 F : String_Access; 1430 1431 begin 1432 for D in Decls'Range loop 1433 Decl := Decls (D); 1434 1435 if References_Count 1436 (Decl, Get_Reads => True, Get_Writes => True) = 0 1437 then 1438 F := Osint.To_Host_File_Spec 1439 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1440 Write_Str (Get_Symbol (Decl) 1441 & " (" 1442 & Get_Full_Type (Decl) 1443 & ") " 1444 & F.all 1445 & ':' 1446 & Get_Line (Decl) 1447 & ':' 1448 & Get_Column (Decl)); 1449 Free (F); 1450 1451 -- Print the body if any 1452 1453 Arr := Get_References (Decl, Get_Bodies => True); 1454 1455 for R in Arr'Range loop 1456 F := Osint.To_Host_File_Spec 1457 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1458 Write_Str (' ' 1459 & F.all 1460 & ':' & Get_Line (Arr (R)) 1461 & ':' & Get_Column (Arr (R))); 1462 Free (F); 1463 end loop; 1464 1465 Write_Eol; 1466 Free (Arr); 1467 end if; 1468 end loop; 1469 end Print_Unused; 1470 1471 -------------- 1472 -- Print_Vi -- 1473 -------------- 1474 1475 procedure Print_Vi (Full_Path_Name : Boolean) is 1476 Tab : constant Character := ASCII.HT; 1477 Decls : constant Declaration_Array_Access := 1478 Get_Declarations (Sorted => False); 1479 Decl : Declaration_Reference; 1480 Arr : Reference_Array_Access; 1481 F : String_Access; 1482 1483 begin 1484 for D in Decls'Range loop 1485 Decl := Decls (D); 1486 1487 F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); 1488 Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); 1489 Free (F); 1490 1491 -- Print the body if any 1492 1493 Arr := Get_References (Decl, Get_Bodies => True); 1494 1495 for R in Arr'Range loop 1496 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1497 Write_Line 1498 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1499 Free (F); 1500 end loop; 1501 1502 Free (Arr); 1503 1504 -- Print the modifications 1505 1506 Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); 1507 1508 for R in Arr'Range loop 1509 F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); 1510 Write_Line 1511 (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); 1512 Free (F); 1513 end loop; 1514 1515 Free (Arr); 1516 end loop; 1517 end Print_Vi; 1518 1519 ---------------- 1520 -- Print_Xref -- 1521 ---------------- 1522 1523 procedure Print_Xref (Full_Path_Name : Boolean) is 1524 Decls : constant Declaration_Array_Access := Get_Declarations; 1525 Decl : Declaration_Reference; 1526 1527 Margin : constant := 10; 1528 -- Column where file names start 1529 1530 procedure New_Line80; 1531 -- Go to start of new line 1532 1533 procedure Print80 (S : String); 1534 -- Print the text, respecting the 80 columns rule 1535 1536 procedure Print_Ref (Line, Column : String); 1537 -- The beginning of the output is aligned on a column multiple of 9 1538 1539 procedure Print_List 1540 (Decl : Declaration_Reference; 1541 Msg : String; 1542 Get_Reads : Boolean := False; 1543 Get_Writes : Boolean := False; 1544 Get_Bodies : Boolean := False); 1545 -- Print a list of references. If the list is not empty, Msg will 1546 -- be printed prior to the list. 1547 1548 ---------------- 1549 -- New_Line80 -- 1550 ---------------- 1551 1552 procedure New_Line80 is 1553 begin 1554 Write_Eol; 1555 Write_Str (String'(1 .. Margin - 1 => ' ')); 1556 end New_Line80; 1557 1558 ------------- 1559 -- Print80 -- 1560 ------------- 1561 1562 procedure Print80 (S : String) is 1563 Align : Natural := Margin - (Integer (Column) mod Margin); 1564 1565 begin 1566 if Align = Margin then 1567 Align := 0; 1568 end if; 1569 1570 Write_Str (String'(1 .. Align => ' ') & S); 1571 end Print80; 1572 1573 --------------- 1574 -- Print_Ref -- 1575 --------------- 1576 1577 procedure Print_Ref (Line, Column : String) is 1578 Line_Align : constant Integer := 4 - Line'Length; 1579 1580 S : constant String := String'(1 .. Line_Align => ' ') 1581 & Line & ':' & Column; 1582 1583 Align : Natural := Margin - (Integer (Output.Column) mod Margin); 1584 1585 begin 1586 if Align = Margin then 1587 Align := 0; 1588 end if; 1589 1590 if Integer (Output.Column) + Align + S'Length > 79 then 1591 New_Line80; 1592 Align := 0; 1593 end if; 1594 1595 Write_Str (String'(1 .. Align => ' ') & S); 1596 end Print_Ref; 1597 1598 ---------------- 1599 -- Print_List -- 1600 ---------------- 1601 1602 procedure Print_List 1603 (Decl : Declaration_Reference; 1604 Msg : String; 1605 Get_Reads : Boolean := False; 1606 Get_Writes : Boolean := False; 1607 Get_Bodies : Boolean := False) 1608 is 1609 Arr : Reference_Array_Access := 1610 Get_References 1611 (Decl, 1612 Get_Writes => Get_Writes, 1613 Get_Reads => Get_Reads, 1614 Get_Bodies => Get_Bodies); 1615 File : File_Reference := Empty_File; 1616 F : String_Access; 1617 1618 begin 1619 if Arr'Length /= 0 then 1620 Write_Eol; 1621 Write_Str (Msg); 1622 end if; 1623 1624 for R in Arr'Range loop 1625 if Get_File_Ref (Arr (R)) /= File then 1626 if File /= Empty_File then 1627 New_Line80; 1628 end if; 1629 1630 File := Get_File_Ref (Arr (R)); 1631 F := Osint.To_Host_File_Spec 1632 (Get_Gnatchop_File (Arr (R), Full_Path_Name)); 1633 1634 if F = null then 1635 Write_Str ("<unknown> "); 1636 else 1637 Write_Str (F.all & ' '); 1638 Free (F); 1639 end if; 1640 end if; 1641 1642 Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); 1643 end loop; 1644 1645 Free (Arr); 1646 end Print_List; 1647 1648 F : String_Access; 1649 1650 -- Start of processing for Print_Xref 1651 1652 begin 1653 for D in Decls'Range loop 1654 Decl := Decls (D); 1655 1656 Write_Str (Get_Symbol (Decl)); 1657 1658 -- Put the declaration type in column Type_Position, but if the 1659 -- declaration name is too long, put at least one space between its 1660 -- name and its type. 1661 1662 while Column < Type_Position - 1 loop 1663 Write_Char (' '); 1664 end loop; 1665 1666 Write_Char (' '); 1667 1668 Write_Line (Get_Full_Type (Decl)); 1669 1670 Write_Parent_Info : declare 1671 Parent : constant Declaration_Reference := Get_Parent (Decl); 1672 1673 begin 1674 if Parent /= Empty_Declaration then 1675 Write_Str (" Ptype: "); 1676 F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); 1677 Print80 (F.all); 1678 Free (F); 1679 Print_Ref (Get_Line (Parent), Get_Column (Parent)); 1680 Print80 (" " & Get_Symbol (Parent)); 1681 Write_Eol; 1682 end if; 1683 end Write_Parent_Info; 1684 1685 Write_Str (" Decl: "); 1686 F := Osint.To_Host_File_Spec 1687 (Get_Gnatchop_File (Decl, Full_Path_Name)); 1688 1689 if F = null then 1690 Print80 ("<unknown> "); 1691 else 1692 Print80 (F.all & ' '); 1693 Free (F); 1694 end if; 1695 1696 Print_Ref (Get_Line (Decl), Get_Column (Decl)); 1697 1698 Print_List 1699 (Decl, " Body: ", Get_Bodies => True); 1700 Print_List 1701 (Decl, " Modi: ", Get_Writes => True); 1702 Print_List 1703 (Decl, " Ref: ", Get_Reads => True); 1704 Write_Eol; 1705 end loop; 1706 end Print_Xref; 1707 1708 ------------ 1709 -- Search -- 1710 ------------ 1711 1712 procedure Search 1713 (Pattern : Search_Pattern; 1714 Local_Symbols : Boolean; 1715 Wide_Search : Boolean; 1716 Read_Only : Boolean; 1717 Der_Info : Boolean; 1718 Type_Tree : Boolean) 1719 is 1720 type String_Access is access String; 1721 procedure Free is new Unchecked_Deallocation (String, String_Access); 1722 1723 ALIfile : ALI_File; 1724 File_Ref : File_Reference; 1725 Strip_Num : Natural := 0; 1726 Ali_Name : String_Access; 1727 1728 begin 1729 -- If we want all the .ali files, then find them 1730 1731 if Wide_Search then 1732 Find_ALI_Files; 1733 end if; 1734 1735 loop 1736 -- Get the next unread ali file 1737 1738 File_Ref := Next_Unvisited_File; 1739 1740 exit when File_Ref = Empty_File; 1741 1742 -- Find the ALI file to use. Most of the time, it will be the unit 1743 -- name, with a different extension. However, when dealing with 1744 -- separates the ALI file is in fact the parent's ALI file (and this 1745 -- is recursive, in case the parent itself is a separate). 1746 1747 Strip_Num := 0; 1748 loop 1749 Free (Ali_Name); 1750 Ali_Name := new String' 1751 (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); 1752 1753 -- Stripped too many things... 1754 1755 if Ali_Name.all = "" then 1756 if Get_Emit_Warning (File_Ref) then 1757 Set_Standard_Error; 1758 Write_Line 1759 ("warning : file " & Get_File (File_Ref, With_Dir => True) 1760 & " not found"); 1761 Set_Standard_Output; 1762 end if; 1763 Free (Ali_Name); 1764 exit; 1765 1766 -- If not found, try the parent's ALI file (this is needed for 1767 -- separate units and subprograms). 1768 1769 -- Reset the cached directory first, in case the separate's 1770 -- ALI file is not in the same directory. 1771 1772 elsif not File_Exists (Ali_Name.all) then 1773 Strip_Num := Strip_Num + 1; 1774 Reset_Directory (File_Ref); 1775 1776 -- Else we finally found it 1777 1778 else 1779 exit; 1780 end if; 1781 end loop; 1782 1783 -- If we had to get the parent's ALI, insert it in the list as usual. 1784 -- This is to avoid parsing it twice in case it has already been 1785 -- parsed. 1786 1787 if Ali_Name /= null and then Strip_Num /= 0 then 1788 File_Ref := Add_To_Xref_File 1789 (File_Name => Ali_Name.all, 1790 Visited => False); 1791 1792 -- Now that we have a file name, parse it to find any reference to 1793 -- the entity. 1794 1795 elsif Ali_Name /= null 1796 and then (Read_Only or else Is_Writable_File (Ali_Name.all)) 1797 then 1798 begin 1799 Open (Ali_Name.all, ALIfile); 1800 1801 -- The cross-reference section in the ALI file may be followed 1802 -- by other sections, which can be identified by the starting 1803 -- character of every line, which should neither be 'X' nor a 1804 -- figure in '1' .. '9'. 1805 1806 -- The loop tests below also take into account the end-of-file 1807 -- possibility. 1808 1809 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1810 Parse_X_Filename (ALIfile); 1811 1812 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1813 loop 1814 Parse_Identifier_Info 1815 (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree, 1816 Wide_Search, Labels_As_Ref => True); 1817 end loop; 1818 end loop; 1819 1820 exception 1821 when No_Xref_Information => 1822 if Get_Emit_Warning (File_Ref) then 1823 Set_Standard_Error; 1824 Write_Line 1825 ("warning : No cross-referencing information in " 1826 & Ali_Name.all); 1827 Set_Standard_Output; 1828 end if; 1829 end; 1830 end if; 1831 end loop; 1832 1833 Free (Ali_Name); 1834 end Search; 1835 1836 ----------------- 1837 -- Search_Xref -- 1838 ----------------- 1839 1840 procedure Search_Xref 1841 (Local_Symbols : Boolean; 1842 Read_Only : Boolean; 1843 Der_Info : Boolean) 1844 is 1845 ALIfile : ALI_File; 1846 File_Ref : File_Reference; 1847 Null_Pattern : Search_Pattern; 1848 1849 begin 1850 Null_Pattern.Initialized := False; 1851 1852 loop 1853 -- Find the next unvisited file 1854 1855 File_Ref := Next_Unvisited_File; 1856 exit when File_Ref = Empty_File; 1857 1858 -- Search the object directories for the .ali file 1859 1860 declare 1861 F : constant String := Get_File (File_Ref, With_Dir => True); 1862 1863 begin 1864 if Read_Only or else Is_Writable_File (F) then 1865 Open (F, ALIfile, True); 1866 1867 -- The cross-reference section in the ALI file may be followed 1868 -- by other sections, which can be identified by the starting 1869 -- character of every line, which should neither be 'X' nor a 1870 -- figure in '1' .. '9'. 1871 1872 -- The loop tests below also take into account the end-of-file 1873 -- possibility. 1874 1875 while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop 1876 Parse_X_Filename (ALIfile); 1877 1878 while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' 1879 loop 1880 Parse_Identifier_Info 1881 (Null_Pattern, ALIfile, Local_Symbols, Der_Info, 1882 Labels_As_Ref => False); 1883 end loop; 1884 end loop; 1885 end if; 1886 1887 exception 1888 when No_Xref_Information => null; 1889 end; 1890 end loop; 1891 end Search_Xref; 1892 1893end Xref_Lib; 1894