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