-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
No_Xref_Information : exception;
-- Exception raised when there is no cross-referencing information in
- -- the .ali files
+ -- the .ali files.
procedure Parse_EOL
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Skip_Continuation_Line : Boolean := False);
-- On return Source (Ptr) is the first character of the next line
-- the .ali files.
procedure Open
- (Name : in String;
+ (Name : String;
File : out ALI_File;
- Dependencies : in Boolean := False);
+ Dependencies : Boolean := False);
-- Open a new ALI file. If Dependencies is True, the insert every library
-- file 'with'ed in the files database (used for gnatxref)
-- The entity will never be reported as unreferenced by gnatxref -u
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive);
-- Skips any separators and stores the start of the token in Token_Ptr.
-- and ASCII.HT. Parse_Token will never skip to the next line.
procedure Parse_Number
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Number : out Natural);
- -- Skips any separators and parses Source upto the first character that
+ -- Skips any separators and parses Source up to the first character that
-- is not a decimal digit. Returns value of parsed digits or 0 if none.
procedure Parse_X_Filename (File : in out ALI_File);
Entity : String;
Glob : Boolean := False)
is
- File_Start : Natural;
- Line_Start : Natural;
- Col_Start : Natural;
- Line_Num : Natural := 0;
- Col_Num : Natural := 0;
- File_Ref : File_Reference := Empty_File;
- Has_Pattern : Boolean := False;
+ File_Start : Natural;
+ Line_Start : Natural;
+ Col_Start : Natural;
+ Line_Num : Natural := 0;
+ Col_Num : Natural := 0;
+
+ File_Ref : File_Reference := Empty_File;
+ pragma Warnings (Off, File_Ref);
begin
-- Find the end of the first item in Entity (pattern or file?)
end;
end;
- File_Start := File_Start + 1;
- Has_Pattern := True;
+ File_Start := File_Start + 1;
end if;
-- Parse the file name
Add_To_Xref_File
(Entity (File_Start .. Line_Start - 1), Visited => True);
Pattern.File_Ref := File_Ref;
+
Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
+
File_Ref :=
Add_To_Xref_File
(ALI_File_Name (Entity (File_Start .. Line_Start - 1)),
procedure Add_Xref_File (File : String) is
File_Ref : File_Reference := Empty_File;
+ pragma Unreferenced (File_Ref);
+
Iterator : Expansion_Iterator;
procedure Add_Xref_File_Internal (File : String);
-- Case where we have an ALI file, accept it even though this is
-- not official usage, since the intention is obvious
- if Tail (File, 4) = ".ali" then
+ if Tail (File, 4) = "." & Osint.ALI_Suffix.all then
File_Ref := Add_To_Xref_File
- (File, Visited => False, Emit_Warning => True);
+ (File, Visited => False, Emit_Warning => True);
-- Normal non-ali file case
File_Ref := Add_To_Xref_File (File, Visited => True);
File_Ref := Add_To_Xref_File
- (ALI_File_Name (File),
- Visited => False,
- Emit_Warning => True);
+ (ALI_File_Name (File),
+ Visited => False, Emit_Warning => True);
end if;
end Add_Xref_File_Internal;
if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then
- -- The first project file found is the good one.
+ -- The first project file found is the good one
Close (My_Dir);
return Dir_Ent (1 .. Last);
--------------------
procedure Find_ALI_Files is
- My_Dir : Rec_DIR;
- Dir_Ent : File_Name_String;
- Last : Natural;
- File_Ref : File_Reference;
+ My_Dir : Rec_DIR;
+ Dir_Ent : File_Name_String;
+ Last : Natural;
+
+ File_Ref : File_Reference;
+ pragma Unreferenced (File_Ref);
function Open_Next_Dir return Boolean;
-- Tries to open the next object directory, and return False if
return;
end if;
- elsif Last > 4 and then Dir_Ent (Last - 3 .. Last) = ".ali" then
+ elsif Last > 4
+ and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all
+ then
File_Ref :=
Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False);
end if;
function Get_Full_Type (Decl : Declaration_Reference) return String is
function Param_String return String;
- -- Return the string to display depending on whether Decl is a
- -- parameter or not
+ -- Return the string to display depending on whether Decl is a parameter
------------------
-- Param_String --
when 'd' => return Param_String & "decimal object";
when 'e' => return Param_String & "enumeration object";
when 'f' => return Param_String & "float object";
+ when 'h' => return "interface";
when 'i' => return Param_String & "integer object";
when 'm' => return Param_String & "modular object";
when 'o' => return Param_String & "fixed object";
Token : Positive;
Ptr : Positive := Ali'First;
Num_Dependencies : Natural := 0;
- File_Ref : File_Reference;
File_Start : Positive;
File_End : Positive;
Gnatchop_Offset : Integer;
Gnatchop_Name : Positive;
+ File_Ref : File_Reference;
+ pragma Unreferenced (File_Ref);
+
begin
-- Read all the lines possibly processing with-clauses and dependency
-- information and exit on finding the first Xref line.
-- which is an error condition.
while Ali (Ptr) /= EOF loop
-
if D_Lines and then Ali (Ptr) = 'D' then
-- Found dependency information. Format looks like:
Parse_Token (Ali, Ptr, Token);
Parse_Token (Ali, Ptr, Token);
- File_Ref := Add_To_Xref_File
- (Ali (Token .. Ptr - 1), Visited => False);
+ File_Ref :=
+ Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False);
elsif Ali (Ptr) = 'X' then
Dependencies : Boolean := False)
is
Ali : String_Access renames File.Buffer;
+ pragma Warnings (Off, Ali);
begin
if File.Buffer /= null then
---------------
procedure Parse_EOL
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Skip_Continuation_Line : Boolean := False)
is
Ptr := Ptr + 1;
end loop;
+ -- Skip CR or LF if not at end of file
+
if Source (Ptr) /= EOF then
- Ptr := Ptr + 1; -- skip CR or LF
+ Ptr := Ptr + 1;
end if;
-- Skip past CR/LF or LF/CR combination
-- to parse the ali file again because the parent entity is not in
-- the declaration table if it did not match the search pattern.
+ procedure Skip_To_Matching_Closing_Bracket;
+ -- When Ptr points to an opening square bracket, moves it to the
+ -- character following the matching closing bracket
+
---------------------
-- Get_Symbol_Name --
---------------------
E_Line : Natural; -- Line number of current entity
E_Col : Natural; -- Column number of current entity
E_Name : Positive; -- Pointer to begin of entity name
- E_Type : Character; -- Type of current entity
begin
-- Look for the X lines corresponding to unit Eun
loop
Parse_Number (Ali, Ptr, E_Line);
- E_Type := Ali (Ptr);
exit when Ali (Ptr) = EOF;
Ptr := Ptr + 1;
Parse_Number (Ali, Ptr, E_Col);
exit when Ali (Ptr) = EOF;
end loop;
- -- We were not able to find the symbol, this should not happend but
+ -- We were not able to find the symbol, this should not happen but
-- since we don't want to stop here we return a string of three
-- question marks as the symbol name.
return "???";
end Get_Symbol_Name;
+ --------------------------------------
+ -- Skip_To_Matching_Closing_Bracket --
+ --------------------------------------
+
+ procedure Skip_To_Matching_Closing_Bracket is
+ Num_Brackets : Natural;
+
+ begin
+ Num_Brackets := 1;
+ while Num_Brackets /= 0 loop
+ Ptr := Ptr + 1;
+ if Ali (Ptr) = '[' then
+ Num_Brackets := Num_Brackets + 1;
+ elsif Ali (Ptr) = ']' then
+ Num_Brackets := Num_Brackets - 1;
+ end if;
+ end loop;
+
+ Ptr := Ptr + 1;
+ end Skip_To_Matching_Closing_Bracket;
+
-- Start of processing for Parse_Identifier_Info
begin
Decl_Ref := Add_Declaration
(File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type);
+ if Ali (Ptr) = '[' then
+ Skip_To_Matching_Closing_Bracket;
+ end if;
+
+ -- Skip any renaming indication
+
+ if Ali (Ptr) = '=' then
+ declare
+ P_Line, P_Column : Natural;
+ pragma Warnings (Off, P_Line);
+ pragma Warnings (Off, P_Column);
+ begin
+ Ptr := Ptr + 1;
+ Parse_Number (Ali, Ptr, P_Line);
+ Ptr := Ptr + 1;
+ Parse_Number (Ali, Ptr, P_Column);
+ end;
+ end if;
+
if Ali (Ptr) = '<'
or else Ali (Ptr) = '('
or else Ali (Ptr) = '{'
Parse_Derived_Info : declare
P_Line : Natural; -- parent entity line
P_Column : Natural; -- parent entity column
- P_Type : Character; -- parent entity type
P_Eun : Positive; -- parent entity file number
begin
-- Then parse the type and column number
- P_Type := Ali (Ptr);
Ptr := Ptr + 1;
Parse_Number (Ali, Ptr, P_Column);
-- Skip the information for generics instantiations
if Ali (Ptr) = '[' then
- declare
- Num_Brackets : Natural := 1;
- begin
- while Num_Brackets /= 0 loop
- Ptr := Ptr + 1;
- if Ali (Ptr) = '[' then
- Num_Brackets := Num_Brackets + 1;
- elsif Ali (Ptr) = ']' then
- Num_Brackets := Num_Brackets - 1;
- end if;
- end loop;
-
- Ptr := Ptr + 1;
- end;
+ Skip_To_Matching_Closing_Bracket;
end if;
-- Skip '>', or ')' or '>'
end loop;
Ptr := Ptr + 1;
end if;
-
- elsif Ali (Ptr) = '=' then
- declare
- P_Line, P_Column : Natural;
-
- begin
- Ptr := Ptr + 1;
- Parse_Number (Ali, Ptr, P_Line);
- Ptr := Ptr + 1;
- Parse_Number (Ali, Ptr, P_Column);
- end;
end if;
-- To find the body, we will have to parse the file too
if Wide_Search then
declare
- File_Ref : File_Reference;
- File_Name : constant String :=
- Get_Gnatchop_File (File.X_File);
+ File_Ref : File_Reference;
+ pragma Unreferenced (File_Ref);
+ File_Name : constant String := Get_Gnatchop_File (File.X_File);
begin
File_Ref := Add_To_Xref_File (ALI_File_Name (File_Name), False);
end;
loop
-- Process references on current line
- while Ali (Ptr) = ' ' or Ali (Ptr) = ASCII.HT loop
+ while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop
-- For every reference read the line, type and column,
-- optionally preceded by a file number and a pipe symbol.
------------------
procedure Parse_Number
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Number : out Natural)
is
-----------------
procedure Parse_Token
- (Source : access String;
+ (Source : not null access String;
Ptr : in out Positive;
Token_Ptr : out Positive)
is
or else Source (Ptr) = ASCII.HT
or else Source (Ptr) = '<'
or else Source (Ptr) = '{'
+ or else Source (Ptr) = '['
or else Source (Ptr) = '='
or else Source (Ptr) = '('))
and then Source (Ptr) >= ' '
-- Print_Unused --
------------------
- procedure Print_Unused (Full_Path_Name : in Boolean) is
+ procedure Print_Unused (Full_Path_Name : Boolean) is
Decls : constant Declaration_Array_Access := Get_Declarations;
Decl : Declaration_Reference;
Arr : Reference_Array_Access;
-- Print_Vi --
--------------
- procedure Print_Vi (Full_Path_Name : in Boolean) is
+ procedure Print_Vi (Full_Path_Name : Boolean) is
Tab : constant Character := ASCII.HT;
Decls : constant Declaration_Array_Access :=
Get_Declarations (Sorted => False);
-- Print_Xref --
----------------
- procedure Print_Xref (Full_Path_Name : in Boolean) is
+ procedure Print_Xref (Full_Path_Name : Boolean) is
Decls : constant Declaration_Array_Access := Get_Declarations;
Decl : Declaration_Reference;
procedure New_Line80;
-- Go to start of new line
- procedure Print80 (S : in String);
- -- Print the text, respecting the 80 columns rule.
+ procedure Print80 (S : String);
+ -- Print the text, respecting the 80 columns rule
procedure Print_Ref (Line, Column : String);
-- The beginning of the output is aligned on a column multiple of 9
-- Print80 --
-------------
- procedure Print80 (S : in String) is
+ procedure Print80 (S : String) is
Align : Natural := Margin - (Integer (Column) mod Margin);
begin
Write_Str (Get_Symbol (Decl));
- while Column < Type_Position loop
+ -- Put the declaration type in column Type_Position, but if the
+ -- declaration name is too long, put at least one space between its
+ -- name and its type.
+
+ while Column < Type_Position - 1 loop
Write_Char (' ');
end loop;
+ Write_Char (' ');
+
Write_Line (Get_Full_Type (Decl));
Write_Parent_Info : declare
OSDN Git Service
