[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

5 files changed, 466 insertions, 50 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d1e74ab..244e917 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2019-08-12  Justin Squirek  <squirek@adacore.com>
+
+	* 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.
+
 2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* freeze.adb (Freeze_Entity): Give the same error for an
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 6528df8..d6dd151 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -171,6 +171,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-cwila1$(objext) \
   a-cwila9$(objext) \
   a-decima$(objext) \
+  a-dhfina$(objext) \
   a-diocst$(objext) \
   a-direct$(objext) \
   a-direio$(objext) \
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;
diff --git a/gcc/ada/libgnat/a-dhfina.ads b/gcc/ada/libgnat/a-dhfina.ads
index e34c664..fe32d01 100644
--- a/gcc/ada/libgnat/a-dhfina.ads
+++ b/gcc/ada/libgnat/a-dhfina.ads
@@ -6,41 +6,101 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT.  In accordance with the copyright of that document, you can freely --
--- copy and modify this specification,  provided that if you redistribute a --
--- modified version,  any changes that you have made are clearly indicated. --
+--          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.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
 package Ada.Directories.Hierarchical_File_Names is
-   pragma Unimplemented_Unit;
 
    function Is_Simple_Name (Name : String) return Boolean;
+   --  Returns True if Name is a simple name, and returns False otherwise.
 
    function Is_Root_Directory_Name (Name : String) return Boolean;
+   --  Returns True if Name is syntactically a root (a directory that cannot
+   --  be decomposed further), and returns False otherwise.
 
    function Is_Parent_Directory_Name (Name : String) return Boolean;
+   --  Returns True if Name can be used to indicate symbolically the parent
+   --  directory of any directory, and returns False otherwise.
 
    function Is_Current_Directory_Name (Name : String) return Boolean;
+   --  Returns True if Name can be used to indicate symbolically the directory
+   --  itself for any directory, and returns False otherwise.
 
    function Is_Full_Name (Name : String) return Boolean;
+   --  Returns True if the leftmost directory part of Name is a root, and
+   --  returns False otherwise.
 
    function Is_Relative_Name (Name : String) return Boolean;
+   --  Returns True if Name allows the identification of an external file
+   --  (including directories and special files) but is not a full name, and
+   --  returns False otherwise.
 
    function Simple_Name (Name : String) return String
      renames Ada.Directories.Simple_Name;
+   --  Returns the simple name portion of the file name specified by Name. The
+   --  exception Name_Error is propagated if the string given as Name does not
+   --  allow the identification of an external file (including directories and
+   --  special files).
 
    function Containing_Directory (Name : String) return String
      renames Ada.Directories.Containing_Directory;
+   --  Returns the name of the containing directory of the external file
+   --  (including directories) identified by Name. If more than one directory
+   --  can contain Name, the directory name returned is implementation-defined.
+   --  The exception Name_Error is propagated if the string given as Name does
+   --  not allow the identification of an external file. The exception
+   --  Use_Error is propagated if the external file does not have a containing
+   --  directory.
 
    function Initial_Directory (Name : String) return String;
+   --  Returns the leftmost directory part in Name. That is, it returns a root
+   --  directory name (for a full name), or one of a parent directory name, a
+   --  current directory name, or a simple name (for a relative name). The
+   --  exception Name_Error is propagated if the string given as Name does not
+   --  allow the identification of an external file (including directories and
+   --  special files).
 
    function Relative_Name (Name : String) return String;
+   --  Returns the entire file name except the Initial_Directory portion. The
+   --  exception Name_Error is propagated if the string given as Name does not
+   --  allow the identification of an external file (including directories and
+   --  special files), or if Name has a single part (this includes if any of
+   --  Is_Simple_Name, Is_Root_Directory_Name, Is_Parent_Directory_Name, or
+   --  Is_Current_Directory_Name are True).
 
    function Compose
      (Directory      : String := "";
       Relative_Name  : String;
       Extension      : String := "") return String;
+   --  Returns the name of the external file with the specified Directory,
+   --  Relative_Name, and Extension. The exception Name_Error is propagated if
+   --  the string given as Directory is not the null string and does not allow
+   --  the identification of a directory, or if Is_Relative_Name
+   --  (Relative_Name) is False, or if the string given as Extension is not
+   --  the null string and is not a possible extension, or if Extension is not
+   --  the null string and Simple_Name (Relative_Name) is not a base name.
+   --
+   --  The result of Compose is a full name if Is_Full_Name (Directory) is
+   --  True; result is a relative name otherwise.
 
 end Ada.Directories.Hierarchical_File_Names;
diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb
index bc489ca..1a1b708 100644
--- a/gcc/ada/libgnat/a-direct.adb
+++ b/gcc/ada/libgnat/a-direct.adb
@@ -33,6 +33,8 @@ with Ada.Calendar;               use Ada.Calendar;
 with Ada.Calendar.Formatting;    use Ada.Calendar.Formatting;
 with Ada.Characters.Handling;    use Ada.Characters.Handling;
 with Ada.Directories.Validity;   use Ada.Directories.Validity;
+with Ada.Directories.Hierarchical_File_Names;
+use Ada.Directories.Hierarchical_File_Names;
 with Ada.Strings.Fixed;
 with Ada.Strings.Maps;           use Ada.Strings.Maps;
 with Ada.Strings.Unbounded;      use Ada.Strings.Unbounded;
@@ -224,31 +226,22 @@ package body Ada.Directories is
               Strings.Fixed.Index (Name, Dir_Seps, Going => Strings.Backward);
 
          begin
-            if Last_DS = 0 then
-
-               --  There is no directory separator, returns "." representing
-               --  the current working directory.
-
-               return ".";
-
             --  If Name indicates a root directory, raise Use_Error, because
             --  it has no containing directory.
 
-            elsif Name = "/"
-              or else
-                (Windows
-                  and then
-                  (Name = "\"
-                      or else
-                        (Name'Length = 3
-                          and then Name (Name'Last - 1 .. Name'Last) = ":\"
-                          and then (Name (Name'First) in 'a' .. 'z'
-                                     or else
-                                       Name (Name'First) in 'A' .. 'Z'))))
+            if Is_Parent_Directory_Name (Name)
+              or else Is_Current_Directory_Name (Name)
+              or else Is_Root_Directory_Name (Name)
             then
                raise Use_Error with
                  "directory """ & Name & """ has no containing directory";
 
+            elsif Last_DS = 0 then
+               --  There is no directory separator, so return ".", representing
+               --  the current working directory.
+
+               return ".";
+
             else
                declare
                   Last   : Positive := Last_DS - Name'First + 1;
@@ -262,31 +255,14 @@ package body Ada.Directories is
                   --  number on Windows.
 
                   while Last > 1 loop
-                     exit when
-                       Result (Last) /= '/'
-                         and then
-                       Result (Last) /= Directory_Separator;
-
-                     exit when Windows
-                       and then Last = 3
-                       and then Result (2) = ':'
-                       and then
-                         (Result (1) in 'A' .. 'Z'
-                           or else
-                          Result (1) in 'a' .. 'z');
+                     exit when Is_Root_Directory_Name (Result (1 .. Last))
+                                 or else (Result (Last) /= Directory_Separator
+                                           and then Result (Last) /= '/');
 
                      Last := Last - 1;
                   end loop;
 
-                  --  Special case of "..": the current directory may be a root
-                  --  directory.
-
-                  if Last = 2 and then Result (1 .. 2) = ".." then
-                     return Containing_Directory (Current_Directory);
-
-                  else
-                     return Result (1 .. Last);
-                  end if;
+                  return Result (1 .. Last);
                end;
             end if;
          end;
@@ -806,6 +782,20 @@ package body Ada.Directories is
                end if;
 
                if Exists = 1 then
+                  --  Ignore special directories "." and ".."
+
+                  if (Full_Name'Length > 1
+                       and then
+                         Full_Name
+                            (Full_Name'Last - 1 .. Full_Name'Last) = "\.")
+                    or else
+                     (Full_Name'Length > 2
+                        and then
+                          Full_Name
+                            (Full_Name'Last - 2 .. Full_Name'Last) = "\..")
+                  then
+                     Exists := 0;
+                  end if;
 
                   --  Now check if the file kind matches the filter
 
@@ -1280,16 +1270,30 @@ package body Ada.Directories is
       function Simple_Name_Internal (Path : String) return String is
          Cut_Start : Natural :=
            Strings.Fixed.Index (Path, Dir_Seps, Going => Strings.Backward);
-         Cut_End   : Natural;
+
+         --  Cut_End points to the last simple name character
+
+         Cut_End   : Natural := Path'Last;
 
       begin
-         --  Cut_Start pointS to the first simple name character
+         --  Root directories are considered simple
 
-         Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1);
+         if Is_Root_Directory_Name (Path) then
+            return Path;
+         end if;
+
+         --  Handle trailing directory separators
+
+         if Cut_Start = Path'Last then
+            Cut_End   := Path'Last - 1;
+            Cut_Start := Strings.Fixed.Index
+                           (Path (Path'First .. Path'Last - 1),
+                             Dir_Seps, Going => Strings.Backward);
+         end if;
 
-         --  Cut_End point to the last simple name character
+         --  Cut_Start points to the first simple name character
 
-         Cut_End := Path'Last;
+         Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1);
 
          Check_For_Standard_Dirs : declare
             BN : constant String := Path (Cut_Start .. Cut_End);
@@ -1301,7 +1305,7 @@ package body Ada.Directories is
 
          begin
             if BN = "." or else BN = ".." then
-               return "";
+               return BN;
 
             elsif Has_Drive_Letter
               and then BN'Length > 2