[Ada] Implement Ada.Directories.Hierarchical_File_Names

[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