-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, 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. --
-- --
------------------------------------------------------------------------------
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with Namet; use Namet;
-with Opt; use Opt;
-with Osint; use Osint;
-with Output; use Output;
+with Opt; use Opt;
+with Osint; use Osint;
+with Output; use Output;
with Table;
+with Types; use Types;
+
+with System.OS_Lib; use System.OS_Lib;
with Unchecked_Conversion;
-- Hash table to map unit names to file names. Used in conjunction with
-- table File_Mapping above.
+ function Hash (F : File_Name_Type) return Header_Num;
+ -- Function used to compute hash of file name
+
package File_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => Header_Num,
Element => Int,
-- Add_Forbidden_File_Name --
-----------------------------
- procedure Add_Forbidden_File_Name (Name : Name_Id) is
+ procedure Add_Forbidden_File_Name (Name : File_Name_Type) is
begin
Forbidden_Names.Set (Name, True);
end Add_Forbidden_File_Name;
File_Name : File_Name_Type;
Path_Name : File_Name_Type)
is
+ Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name);
+ File_Entry : constant Int := File_Hash_Table.Get (File_Name);
begin
- File_Mapping.Increment_Last;
- Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
- File_Mapping.Table (File_Mapping.Last) :=
- (Uname => Unit_Name, Fname => File_Name);
- Path_Mapping.Increment_Last;
- File_Hash_Table.Set (File_Name, Path_Mapping.Last);
- Path_Mapping.Table (Path_Mapping.Last) :=
- (Uname => Unit_Name, Fname => Path_Name);
+ if Unit_Entry = No_Entry or else
+ File_Mapping.Table (Unit_Entry).Fname /= File_Name
+ then
+ File_Mapping.Increment_Last;
+ Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
+ File_Mapping.Table (File_Mapping.Last) :=
+ (Uname => Unit_Name, Fname => File_Name);
+ end if;
+
+ if File_Entry = No_Entry or else
+ Path_Mapping.Table (File_Entry).Fname /= Path_Name
+ then
+ Path_Mapping.Increment_Last;
+ File_Hash_Table.Set (File_Name, Path_Mapping.Last);
+ Path_Mapping.Table (Path_Mapping.Last) :=
+ (Uname => Unit_Name, Fname => Path_Name);
+ end if;
end Add_To_File_Map;
----------
-- Hash --
----------
+ function Hash (F : File_Name_Type) return Header_Num is
+ begin
+ return Header_Num (Int (F) rem Header_Num'Range_Length);
+ end Hash;
+
function Hash (F : Unit_Name_Type) return Header_Num is
begin
return Header_Num (Int (F) rem Header_Num'Range_Length);
Last : Natural := 0;
Uname : Unit_Name_Type;
- Fname : Name_Id;
- Pname : Name_Id;
-
- The_Mapping : Mapping;
+ Fname : File_Name_Type;
+ Pname : File_Name_Type;
- procedure Empty_Tables (Warning : Boolean := True);
+ procedure Empty_Tables;
-- Remove all entries in case of incorrect mapping file
- function Find_Name return Name_Id;
- -- Return Error_Name for "/", otherwise call Name_Find
+ function Find_File_Name return File_Name_Type;
+ -- Return Error_File_Name for "/", otherwise call Name_Find
+ -- What is this about, explanation required ???
+
+ function Find_Unit_Name return Unit_Name_Type;
+ -- Return Error_Unit_Name for "/", otherwise call Name_Find
+ -- Even more mysterious??? function appeared when Find_Name was split
+ -- for the two types, but this routine is definitely called!
procedure Get_Line;
-- Get a line from the mapping file
-- Empty_Tables --
------------------
- procedure Empty_Tables (Warning : Boolean := True) is
+ procedure Empty_Tables is
begin
- if Warning then
- Write_Str ("mapping file """);
- Write_Str (File_Name);
- Write_Line (""" is not taken into account");
- end if;
-
Unit_Hash_Table.Reset;
File_Hash_Table.Reset;
Path_Mapping.Set_Last (0);
Last_In_Table := 0;
end Empty_Tables;
- ---------------
- -- Find_Name --
- ---------------
+ --------------------
+ -- Find_File_Name --
+ --------------------
- function Find_Name return Name_Id is
+ -- Why is only / illegal, why not \ on windows ???
+
+ function Find_File_Name return File_Name_Type is
begin
if Name_Buffer (1 .. Name_Len) = "/" then
- return Error_Name;
-
+ return Error_File_Name;
else
return Name_Find;
end if;
- end Find_Name;
+ end Find_File_Name;
+
+ --------------------
+ -- Find_Unit_Name --
+ --------------------
+
+ function Find_Unit_Name return Unit_Name_Type is
+ begin
+ return Unit_Name_Type (Find_File_Name);
+ -- very odd ???
+ end Find_Unit_Name;
--------------
-- Get_Line --
Write_Line (""" is truncated");
end Report_Truncated;
- -- Start of procedure Initialize
+ -- Start of processing for Initialize
begin
- Empty_Tables (Warning => False);
+ Empty_Tables;
Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name;
Read_Source_File (Name_Enter, 0, Hi, Src, Config);
Name_Len := Last - First + 1;
Name_Buffer (1 .. Name_Len) := SP (First .. Last);
- Uname := Find_Name;
+ Uname := Find_Unit_Name;
-- Get the file name
Name_Len := Last - First + 1;
Name_Buffer (1 .. Name_Len) := SP (First .. Last);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Fname := Find_Name;
+ Fname := Find_File_Name;
-- Get the path name
Name_Len := Last - First + 1;
Name_Buffer (1 .. Name_Len) := SP (First .. Last);
- Pname := Find_Name;
-
- -- Check for duplicate entries
-
- if Unit_Hash_Table.Get (Uname) /= No_Entry then
- Write_Str ("warning: duplicate entry """);
- Write_Str (Get_Name_String (Uname));
- Write_Str (""" in mapping file """);
- Write_Str (File_Name);
- Write_Line ("""");
- The_Mapping := File_Mapping.Table (Unit_Hash_Table.Get (Uname));
- Write_Line (Get_Name_String (The_Mapping.Uname));
- Write_Line (Get_Name_String (The_Mapping.Fname));
- Empty_Tables;
- return;
- end if;
-
- if File_Hash_Table.Get (Fname) /= No_Entry then
- Write_Str ("warning: duplicate entry """);
- Write_Str (Get_Name_String (Fname));
- Write_Str (""" in mapping file """);
- Write_Str (File_Name);
- Write_Line ("""");
- The_Mapping := Path_Mapping.Table (File_Hash_Table.Get (Fname));
- Write_Line (Get_Name_String (The_Mapping.Uname));
- Write_Line (Get_Name_String (The_Mapping.Fname));
- Empty_Tables;
- return;
- end if;
+ Pname := Find_File_Name;
-- Add the mappings for this unit name
-- Record the length of the two mapping tables
Last_In_Table := File_Mapping.Last;
-
end Initialize;
----------------------
begin
if Forbidden_Names.Get (File) then
- return Error_Name;
+ return Error_File_Name;
end if;
Index := File_Hash_Table.Get (File);
-- Remove_Forbidden_File_Name --
--------------------------------
- procedure Remove_Forbidden_File_Name (Name : Name_Id) is
+ procedure Remove_Forbidden_File_Name (Name : File_Name_Type) is
begin
Forbidden_Names.Set (Name, False);
end Remove_Forbidden_File_Name;
File : File_Descriptor;
N_Bytes : Integer;
+ File_Entry : Int;
+
Status : Boolean;
-- For the call to Close
end if;
for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
- Put_Line (File_Mapping.Table (Unit).Uname);
- Put_Line (File_Mapping.Table (Unit).Fname);
- Put_Line (Path_Mapping.Table (Unit).Fname);
+ Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
+ Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
+ File_Entry :=
+ File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
+ Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
end loop;
- -- Before closing the file, write the buffer to the file.
- -- It is guaranteed that the Buffer is not empty, because
- -- Put_Line has been called at least 3 times, and after
- -- a call to Put_Line, the Buffer is not empty.
+ -- Before closing the file, write the buffer to the file. It is
+ -- guaranteed that the Buffer is not empty, because Put_Line has
+ -- been called at least 3 times, and after a call to Put_Line, the
+ -- Buffer is not empty.
N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
OSDN Git Service
