files_map: add normalize_pathname

3 files changed, 53 insertions, 14 deletions

diff --git a/src/files_map.adb b/src/files_map.adb
index 1b45d51d6..94e4badbe 100644
--- a/src/files_map.adb
+++ b/src/files_map.adb
@@ -502,6 +502,37 @@ package body Files_Map is
       return Nam_Buffer (1 .. Nam_Length);
    end Get_Pathname;
 
+   procedure Normalize_Pathname
+     (Directory : in out Name_Id; Name : in out Name_Id)
+   is
+      Separator_Pos : Natural;
+      Filename : constant String := Image (Name);
+   begin
+      --  Find a directory part in NAME, return now if none.
+      Separator_Pos := 0;
+      for I in Filename'Range loop
+         if Filename (I) = '/' or Filename (I) = '\' then
+            Separator_Pos := I;
+         end if;
+      end loop;
+      if Separator_Pos = 0 then
+         return;
+      end if;
+
+      --  Move the directory part to DIRECTORY.
+      if Directory /= Null_Identifier then
+         Image (Directory);
+      else
+         Nam_Length := 0;
+      end if;
+      for I in Filename'First .. Separator_Pos loop
+         Nam_Length := Nam_Length + 1;
+         Nam_Buffer (Nam_Length) := Filename (I);
+      end loop;
+      Directory := Get_Identifier;
+      Name := Get_Identifier (Filename (Separator_Pos + 1 .. Filename'Last));
+   end Normalize_Pathname;
+
    --  Find a source_file by DIRECTORY and NAME.
    --  Return NO_SOURCE_FILE_ENTRY if not already opened.
    function Find_Source_File (Directory : Name_Id; Name: Name_Id)
diff --git a/src/files_map.ads b/src/files_map.ads
index 265e3d04d..861d0a5a8 100644
--- a/src/files_map.ads
+++ b/src/files_map.ads
@@ -29,7 +29,13 @@ package Files_Map is
    function Get_Pathname
      (Directory : Name_Id; Name : Name_Id; Add_Nul : Boolean) return String;
 
-   --  Return an entry for a filename.
+   --  If NAME contains a directory separator, move it to the DIRECTORY name.
+   --  At the return point, NAME has no directory components.
+   procedure Normalize_Pathname
+     (Directory : in out Name_Id; Name : in out Name_Id);
+
+   --  Return an entry for a filename.  Null_Identifier for DIRECTORY means
+   --  current directory.
    --  Load the filename if necessary.
    --  Return No_Source_File_Entry if the file does not exist.
    function Load_Source_File (Directory : Name_Id; Name : Name_Id)
@@ -54,6 +60,13 @@ package Files_Map is
    -- Return the length of the file (which is the size of the file buffer).
    function Get_File_Length (File : Source_File_Entry) return Source_Ptr;
 
+   -- Return the name of the file.
+   function Get_File_Name (File : Source_File_Entry) return Name_Id;
+
+   -- Return the directory of the file.
+   function Get_Source_File_Directory (File : Source_File_Entry)
+                                      return Name_Id;
+
    --  Return the entry of the last known file.
    --  This allow the user to create a table of Source_File_Entry.
    function Get_Last_Source_File_Entry return Source_File_Entry;
@@ -80,13 +93,6 @@ package Files_Map is
    -- Return the home directory (current directory).
    function Get_Home_Directory return Name_Id;
 
-   -- Return the directory of the file.
-   function Get_Source_File_Directory (File : Source_File_Entry)
-                                      return Name_Id;
-
-   -- Return the name of the file.
-   function Get_File_Name (File : Source_File_Entry) return Name_Id;
-
    --  Get the path of directory DIR.
    --function Get_Directory_Path (Dir : Directory_Index) return String;
 
diff --git a/src/name_table.ads b/src/name_table.ads
index e44e87f5e..5a6219f5e 100644
--- a/src/name_table.ads
+++ b/src/name_table.ads
@@ -46,6 +46,10 @@ package Name_Table is
    --  If the name is a character, then single quote are added.
    function Image (Id: Name_Id) return String;
 
+   --  Set NAME_BUFFER/NAME_LENGTH with the image of ID.  Characters aren't
+   --  quoted.
+   procedure Image (Id : Name_Id);
+
    --  Get the address of the first character of ID.  The address is valid
    --  until the next call to Get_Identifier (which may reallocate the string
    --  table).
@@ -72,10 +76,6 @@ package Name_Table is
    --  is not found (and do not create an entry for it).
    function Get_Identifier_No_Create return Name_Id;
 
-   --  Set NAME_BUFFER/NAME_LENGTH with the image of ID.  Characters aren't
-   --  quoted.
-   procedure Image (Id : Name_Id);
-
    --  Get and set the info field associated with each identifier.
    --  Used to store interpretations of the name.
    function Get_Info (Id: Name_Id) return Int32;
@@ -94,9 +94,11 @@ package Name_Table is
    --  case is 'normalized' as VHDL is case insensitive.
    --  To avoid name clash with std_names, Nam_Buffer and Nam_Length are used
    --  instead of Name_Buffer and Name_Length.
-   Nam_Buffer : String (1 .. 1024);
+   Max_Nam_Length : constant Natural := 1024;
+   Nam_Buffer : String (1 .. Max_Nam_Length);
+
    --  The length of the name string.
-   Nam_Length: Natural;
+   Nam_Length: Natural range 0 .. Max_Nam_Length;
 
    --  Disp statistics.
    --  Used for debugging.