[Ada] Implement Ada.Directories.Hierarchical_File_Names

This patch corrects certain behaviors within Ada.Directories to better
conform to conformance tests and implements the package
Ada.Directories.Hierarchical_File_Names outlined in AI05-0049-1.

Only partial test sources are included.

------------
-- Source --
------------

--  main.ads

with Ada.Directories.Hierarchical_File_Names;
use Ada.Directories.Hierarchical_File_Names;

with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO;    use Ada.Text_IO;

procedure Main is
   FULL_PATH_A : constant String := "/export/work/user/bug";
   FULL_PATH_B : constant String := "/export/work/user";

   RELATIVE_PATH_A : constant String := "export/work/user/bug/";
   RELATIVE_PATH_B : constant String := "export/work/user/bug";

   SIMPLE_PATH_A : constant String := "bug/";
   SIMPLE_PATH_B : constant String := "bug";

   ROOT_PATH : constant String := "/";

   CURRENT_DIR : constant String := ".";
   PARENT_DIR  : constant String := "..";

   RELATIVE_WITH_CURRENT : constant String := RELATIVE_PATH_A & ".";
   RELATIVE_WITH_PARENT  : constant String := RELATIVE_PATH_A & "..";
begin
   Put_Line ("Simple_Name");
   Put_Line (Is_Simple_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Simple_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Simple_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Simple_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Simple_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Simple_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Simple_Name (ROOT_PATH)'Image);
   Put_Line (Is_Simple_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Simple_Name (PARENT_DIR)'Image);
   Put_Line (Is_Simple_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Simple_Name (RELATIVE_WITH_PARENT)'Image);
   Put_Line (Simple_Name (FULL_PATH_A));
   Put_Line (Simple_Name (FULL_PATH_B));
   Put_Line (Simple_Name (RELATIVE_PATH_A));
   Put_Line (Simple_Name (RELATIVE_PATH_B));
   Put_Line (Simple_Name (SIMPLE_PATH_A));
   Put_Line (Simple_Name (SIMPLE_PATH_B));
   Put_Line (Simple_Name (ROOT_PATH));
   Put_Line (Simple_Name (CURRENT_DIR));
   Put_Line (Simple_Name (PARENT_DIR));
   Put_Line (Simple_Name (RELATIVE_WITH_CURRENT));
   Put_Line (Simple_Name (RELATIVE_WITH_PARENT));

   Put_Line ("Root_Directory_Name");
   Put_Line (Is_Root_Directory_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Root_Directory_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Root_Directory_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Root_Directory_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Root_Directory_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Root_Directory_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Root_Directory_Name (ROOT_PATH)'Image);
   Put_Line (Is_Root_Directory_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Root_Directory_Name (PARENT_DIR)'Image);
   Put_Line (Is_Root_Directory_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Root_Directory_Name (RELATIVE_WITH_PARENT)'Image);

   Put_Line ("Is_Parent_Directory_Name");
   Put_Line (Is_Parent_Directory_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Parent_Directory_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Parent_Directory_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Parent_Directory_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Parent_Directory_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Parent_Directory_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Parent_Directory_Name (ROOT_PATH)'Image);
   Put_Line (Is_Parent_Directory_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Parent_Directory_Name (PARENT_DIR)'Image);
   Put_Line (Is_Parent_Directory_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Parent_Directory_Name (RELATIVE_WITH_PARENT)'Image);

   Put_Line ("Is_Current_Directory_Name");
   Put_Line (Is_Current_Directory_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Current_Directory_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Current_Directory_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Current_Directory_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Current_Directory_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Current_Directory_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Current_Directory_Name (ROOT_PATH)'Image);
   Put_Line (Is_Current_Directory_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Current_Directory_Name (PARENT_DIR)'Image);
   Put_Line (Is_Current_Directory_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Current_Directory_Name (RELATIVE_WITH_PARENT)'Image);

   Put_Line ("Is_Full_Name");
   Put_Line (Is_Full_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Full_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Full_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Full_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Full_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Full_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Full_Name (ROOT_PATH)'Image);
   Put_Line (Is_Full_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Full_Name (PARENT_DIR)'Image);
   Put_Line (Is_Full_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Full_Name (RELATIVE_WITH_PARENT)'Image);

   Put_Line ("Relative_Name");
   Put_Line (Is_Relative_Name (FULL_PATH_A)'Image);
   Put_Line (Is_Relative_Name (FULL_PATH_B)'Image);
   Put_Line (Is_Relative_Name (RELATIVE_PATH_A)'Image);
   Put_Line (Is_Relative_Name (RELATIVE_PATH_B)'Image);
   Put_Line (Is_Relative_Name (SIMPLE_PATH_A)'Image);
   Put_Line (Is_Relative_Name (SIMPLE_PATH_B)'Image);
   Put_Line (Is_Relative_Name (ROOT_PATH)'Image);
   Put_Line (Is_Relative_Name (CURRENT_DIR)'Image);
   Put_Line (Is_Relative_Name (PARENT_DIR)'Image);
   Put_Line (Is_Relative_Name (RELATIVE_WITH_CURRENT)'Image);
   Put_Line (Is_Relative_Name (RELATIVE_WITH_PARENT)'Image);
   Put_Line (Relative_Name (FULL_PATH_A));
   Put_Line (Relative_Name (FULL_PATH_B));
   Put_Line (Relative_Name (RELATIVE_PATH_A));
   Put_Line (Relative_Name (RELATIVE_PATH_B));
   begin
      Put_Line (Relative_Name (SIMPLE_PATH_A));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Relative_Name (SIMPLE_PATH_B));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Relative_Name (ROOT_PATH));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Relative_Name (CURRENT_DIR));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Relative_Name (PARENT_DIR));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   Put_Line (Relative_Name (RELATIVE_WITH_CURRENT));
   Put_Line (Relative_Name (RELATIVE_WITH_PARENT));

   Put_Line ("Containing_Directory");
   Put_Line (Containing_Directory (FULL_PATH_A));
   Put_Line (Containing_Directory (FULL_PATH_B));
   Put_Line (Containing_Directory (RELATIVE_PATH_A));
   Put_Line (Containing_Directory (RELATIVE_PATH_B));
   Put_Line (Containing_Directory (SIMPLE_PATH_A));
   Put_Line (Containing_Directory (SIMPLE_PATH_B));
   begin
      Put_Line (Containing_Directory (ROOT_PATH));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Containing_Directory (CURRENT_DIR));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   begin
      Put_Line (Containing_Directory (PARENT_DIR));
   exception
      when E: others =>
         Put_Line (Exception_Information (E));
   end;
   Put_Line (Containing_Directory (RELATIVE_WITH_CURRENT));
   Put_Line (Containing_Directory (RELATIVE_WITH_PARENT));

   Put_Line ("Initial_Directory");
   Put_Line (Initial_Directory (FULL_PATH_A));
   Put_Line (Initial_Directory (FULL_PATH_B));
   Put_Line (Initial_Directory (RELATIVE_PATH_A));
   Put_Line (Initial_Directory (RELATIVE_PATH_B));
   Put_Line (Initial_Directory (SIMPLE_PATH_A));
   Put_Line (Initial_Directory (SIMPLE_PATH_B));
   Put_Line (Initial_Directory (ROOT_PATH));
   Put_Line (Initial_Directory (CURRENT_DIR));
   Put_Line (Initial_Directory (PARENT_DIR));
   Put_Line (Initial_Directory (RELATIVE_WITH_CURRENT));
   Put_Line (Initial_Directory (RELATIVE_WITH_PARENT));
end;

-----------------
-- Compilation --
-----------------

$ gnatmake -q main.adb
Simple_Name
FALSE
FALSE
FALSE
FALSE
TRUE
TRUE
FALSE
TRUE
TRUE
FALSE
FALSE
bug
user
bug
bug
bug
bug
/
.
..
.
..
Root_Directory_Name
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
TRUE
FALSE
FALSE
FALSE
FALSE
Is_Parent_Directory_Name
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
TRUE
FALSE
FALSE
Is_Current_Directory_Name
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
FALSE
TRUE
FALSE
FALSE
FALSE
Is_Full_Name
TRUE
TRUE
FALSE
FALSE
FALSE
FALSE
TRUE
FALSE
FALSE
FALSE
FALSE
Relative_Name
FALSE
FALSE
TRUE
TRUE
TRUE
TRUE
FALSE
TRUE
TRUE
TRUE
TRUE
export/work/user/bug
export/work/user
work/user/bug/
work/user/bug
raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "bug/" is
composed of a single part

raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "bug" is
composed of a single part

raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "/" is
composed of a single part

raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name "." is
composed of a single part

raised ADA.IO_EXCEPTIONS.NAME_ERROR : relative path name ".." is
composed of a single part

work/user/bug/.
work/user/bug/..
Containing_Directory
/export/work/user
/export/work
export/work/user/bug
export/work/user
bug
.
raised ADA.IO_EXCEPTIONS.USE_ERROR : directory "/" has no containing directory

raised ADA.IO_EXCEPTIONS.USE_ERROR : directory "." has no containing directory

raised ADA.IO_EXCEPTIONS.USE_ERROR : directory ".." has no containing directory

export/work/user/bug
export/work/user/bug
Initial_Directory
/
/
export
export
bug
bug
/
.
..
export
export

2019-08-12  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* libgnat/a-dhfina.adb, libgnat/a-dhfina.ads (Is_Simple_Name,
	Is_Root_Directory, Is_Parent_Directory,
	Is_Current_Directory_Name, Is_Relative_Name, Initial_Directory,
	Relative_Name, Compose): Add implementation and documentation.
	* libgnat/a-direct.adb (Containing_Directory): Modify routine to
	use routines from Ada.Directories.Hierarchical_File_Names and
	remove incorrect special case for parent directories.
	(Fetch_Next_Entry): Add check for current directory and parent
	directory and ignore them under certain circumstances.
	(Simple_Nmae): Add check for null result from
	Simple_Name_Internal and raise Name_Error.
	(Simple_Name_Internal): Add explicit check for root directories,
	sanitize trailing directory separators, and modify behavior so
	that current and parent directories are considered valid
	results.
	* Makefile.rtl: Add entry to GNATRTL_NONTASKING_OBJS.

From-SVN: r274295

1 files changed, 332 insertions, 0 deletions

diff --git a/gcc/ada/libgnat/a-dhfina.adb b/gcc/ada/libgnat/a-dhfina.adb
new file mode 100644
index 0000000..df7c345
--- /dev/null
+++ b/gcc/ada/libgnat/a-dhfina.adb
@@ -0,0 +1,332 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  ADA.DIRECTORIES.HIERARCHICAL_FILE_NAMES                 --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2004-2019, 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 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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- In particular,  you can freely  distribute your programs  built with the --
+-- GNAT Pro compiler, including any required library run-time units,  using --
+-- any licensing terms  of your choosing.  See the AdaCore Software License --
+-- for full details.                                                        --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Characters.Handling;  use Ada.Characters.Handling;
+with Ada.Directories.Validity; use Ada.Directories.Validity;
+with Ada.Strings.Fixed;        use Ada.Strings.Fixed;
+with System;                   use System;
+
+package body Ada.Directories.Hierarchical_File_Names is
+
+   Dir_Separator : constant Character;
+   pragma Import (C, Dir_Separator, "__gnat_dir_separator");
+   --  Running system default directory separator
+
+   -----------------
+   -- Subprograms --
+   -----------------
+
+   function Equivalent_File_Names
+     (Left  : String;
+      Right : String)
+      return Boolean;
+   --  Perform an OS-independent comparison between two file paths
+
+   function Is_Absolute_Path (Name : String) return Boolean;
+   --  Returns True if Name is an absolute path name, i.e. it designates a
+   --  file or directory absolutely rather than relative to another directory.
+
+   ---------------------------
+   -- Equivalent_File_Names --
+   ---------------------------
+
+   function Equivalent_File_Names
+     (Left  : String;
+      Right : String)
+      return Boolean
+   is
+   begin
+      --  Check the validity of the input paths
+
+      if not Is_Valid_Path_Name (Left)
+        or else not Is_Valid_Path_Name (Right)
+      then
+         return False;
+      end if;
+
+      --  Normalize the paths by removing any trailing directory separators and
+      --  perform the comparison.
+
+      declare
+         Normal_Left  : constant String :=
+           (if Index (Left, Dir_Separator & "", Strings.Backward) = Left'Last
+              and then not Is_Root_Directory_Name (Left)
+            then
+               Left (Left'First .. Left'Last - 1)
+            else
+               Left);
+
+         Normal_Right : constant String :=
+           (if Index (Right, Dir_Separator & "", Strings.Backward) = Right'Last
+              and then not Is_Root_Directory_Name (Right)
+            then
+               Right (Right'First .. Right'Last - 1)
+            else
+               Right);
+      begin
+         --  Within Windows we assume case insensitivity
+
+         if not Windows then
+            return Normal_Left = Normal_Right;
+         end if;
+
+         --  Otherwise do a straight comparison
+
+         return To_Lower (Normal_Left) = To_Lower (Normal_Right);
+      end;
+   end Equivalent_File_Names;
+
+   ----------------------
+   -- Is_Absolute_Path --
+   ----------------------
+
+   function Is_Absolute_Path (Name : String) return Boolean is
+      function Is_Absolute_Path
+        (Name   : Address;
+         Length : Integer) return Integer;
+      pragma Import (C, Is_Absolute_Path, "__gnat_is_absolute_path");
+   begin
+      return Is_Absolute_Path (Name'Address, Name'Length) /= 0;
+   end Is_Absolute_Path;
+
+   --------------------
+   -- Is_Simple_Name --
+   --------------------
+
+   function Is_Simple_Name (Name : String) return Boolean is
+   begin
+      --  Verify the file path name is valid and that it is not a root
+
+      if not Is_Valid_Path_Name (Name)
+        or else Is_Root_Directory_Name (Name)
+      then
+         return False;
+      end if;
+
+      --  Check for the special paths "." and "..", which are considered simple
+
+      if Is_Parent_Directory_Name (Name)
+        or else Is_Current_Directory_Name (Name)
+      then
+         return True;
+      end if;
+
+      --  Perform a comparison with the calculated simple path name
+
+      return Equivalent_File_Names (Simple_Name (Name), Name);
+   end Is_Simple_Name;
+
+   ----------------------------
+   -- Is_Root_Directory_Name --
+   ----------------------------
+
+   function Is_Root_Directory_Name (Name : String) return Boolean is
+   begin
+      --  Check if the path name is a root directory by looking for a slash in
+      --  the general case, and a drive letter in the case of Windows.
+
+      return Name = "/"
+               or else
+                 (Windows
+                   and then
+                     (Name = "\"
+                       or else
+                         (Name'Length = 3
+                           and then Name (Name'Last - 1) = ':'
+                           and then Name (Name'Last) in '/' | '\'
+                           and then (Name (Name'First) in 'a' .. 'z'
+                                      or else
+                                        Name (Name'First) in 'A' .. 'Z'))
+                       or else
+                         (Name'Length = 2
+                           and then Name (Name'Last) = ':'
+                           and then (Name (Name'First) in 'a' .. 'z'
+                                      or else
+                                        Name (Name'First) in 'A' .. 'Z'))));
+   end Is_Root_Directory_Name;
+
+   ------------------------------
+   -- Is_Parent_Directory_Name --
+   ------------------------------
+
+   function Is_Parent_Directory_Name (Name : String) return Boolean is
+   begin
+      return Name = "..";
+   end Is_Parent_Directory_Name;
+
+   -------------------------------
+   -- Is_Current_Directory_Name --
+   -------------------------------
+
+   function Is_Current_Directory_Name (Name : String) return Boolean is
+   begin
+      return Name = ".";
+   end Is_Current_Directory_Name;
+
+   ------------------
+   -- Is_Full_Name --
+   ------------------
+
+   function Is_Full_Name (Name : String) return Boolean is
+   begin
+      return Equivalent_File_Names (Full_Name (Name), Name);
+   end Is_Full_Name;
+
+   ----------------------
+   -- Is_Relative_Name --
+   ----------------------
+
+   function Is_Relative_Name (Name : String) return Boolean is
+   begin
+      return not Is_Absolute_Path (Name)
+               and then Is_Valid_Path_Name (Name);
+   end Is_Relative_Name;
+
+   -----------------------
+   -- Initial_Directory --
+   -----------------------
+
+   function Initial_Directory (Name : String) return String is
+      Start : constant Integer := Index (Name, Dir_Separator & "");
+   begin
+      --  Verify path name
+
+      if not Is_Valid_Path_Name (Name) then
+         raise Name_Error with "invalid path name """ & Name & '"';
+      end if;
+
+      --  When there is no starting directory separator or the path name is a
+      --  root directory then the path name is already simple - so return it.
+
+      if Is_Root_Directory_Name (Name) or else Start = 0 then
+         return Name;
+      end if;
+
+      --  When the initial directory of the path name is a root directory then
+      --  the starting directory separator is part of the result so we must
+      --  return it in the slice.
+
+      if Is_Root_Directory_Name (Name (Name'First .. Start)) then
+         return Name (Name'First .. Start);
+      end if;
+
+      --  Otherwise we grab a slice up to the starting directory separator
+
+      return Name (Name'First .. Start - 1);
+   end Initial_Directory;
+
+   -------------------
+   -- Relative_Name --
+   -------------------
+
+   function Relative_Name (Name : String) return String is
+   begin
+      --  We cannot derive a relative name if Name does not exist
+
+      if not Is_Relative_Name (Name)
+        and then not Is_Valid_Path_Name (Name)
+      then
+         raise Name_Error with "invalid relative path name """ & Name & '"';
+      end if;
+
+      --  Name only has a single part and thus cannot be made relative
+
+      if Is_Simple_Name (Name)
+        or else Is_Root_Directory_Name (Name)
+      then
+         raise Name_Error with
+           "relative path name """ & Name & """ is composed of a single part";
+      end if;
+
+      --  Trim the input according to the initial directory and maintain proper
+      --  directory separation due to the fact that root directories may
+      --  contain separators.
+
+      declare
+         Init_Dir : constant String := Initial_Directory (Name);
+      begin
+         if Init_Dir (Init_Dir'Last) = Dir_Separator then
+            return Name (Name'First + Init_Dir'Length .. Name'Last);
+         end if;
+
+         return Name (Name'First + Init_Dir'Length + 1 .. Name'Last);
+      end;
+   end Relative_Name;
+
+   -------------
+   -- Compose --
+   -------------
+
+   function Compose
+     (Directory     : String := "";
+      Relative_Name : String;
+      Extension     : String := "") return String
+   is
+      --  Append a directory separator if none is present
+
+      Separated_Dir : constant String :=
+        (if    Directory = "" then ""
+         elsif Directory (Directory'Last) = Dir_Separator then Directory
+         else  Directory & Dir_Separator);
+   begin
+      --  Check that relative name is valid
+
+      if not Is_Relative_Name (Relative_Name) then
+         raise Name_Error with
+           "invalid relative path name """ & Relative_Name & '"';
+      end if;
+
+      --  Check that directory is valid
+
+      if Separated_Dir /= ""
+        and then (not Is_Valid_Path_Name (Separated_Dir & Relative_Name))
+      then
+         raise Name_Error with
+           "invalid path composition """ & Separated_Dir & Relative_Name & '"';
+      end if;
+
+      --  Check that the extension is valid
+
+      if Extension /= ""
+        and then not Is_Valid_Path_Name
+                       (Separated_Dir & Relative_Name & Extension)
+      then
+         raise Name_Error with
+           "invalid path composition """
+             & Separated_Dir & Relative_Name & Extension & '"';
+      end if;
+
+      --  Concatenate the result
+
+      return Separated_Dir & Relative_Name & Extension;
+   end Compose;
+
+end Ada.Directories.Hierarchical_File_Names;