Files · 5076fb182e2f99b46dca619f7be8e6e158bc902f · lvzhengyang / riscv-gcc-1

[Ada] Implement Ada.Directories.Hierarchical_File_Names · 5076fb18

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

committed Aug 12, 2019

5076fb18

Name	Last commit	Last update
INSTALL		Loading commit data...
config		Loading commit data...
contrib		Loading commit data...
fixincludes		Loading commit data...
gcc		Loading commit data...
gnattools		Loading commit data...
gotools		Loading commit data...
include		Loading commit data...
intl		Loading commit data...
libada		Loading commit data...
libatomic		Loading commit data...
libbacktrace		Loading commit data...
libcc1		Loading commit data...
libcpp		Loading commit data...
libdecnumber		Loading commit data...
libffi		Loading commit data...
libgcc		Loading commit data...
libgfortran		Loading commit data...
libgo		Loading commit data...
libgomp		Loading commit data...
libhsail-rt		Loading commit data...
libiberty		Loading commit data...
libitm		Loading commit data...
libobjc		Loading commit data...
liboffloadmic		Loading commit data...
libphobos		Loading commit data...
libquadmath		Loading commit data...
libsanitizer		Loading commit data...
libssp		Loading commit data...
libstdc++-v3		Loading commit data...
libvtv		Loading commit data...
lto-plugin		Loading commit data...
maintainer-scripts		Loading commit data...
zlib		Loading commit data...
.dir-locals.el		Loading commit data...
.gitattributes		Loading commit data...
.gitignore		Loading commit data...
ABOUT-NLS		Loading commit data...
COPYING		Loading commit data...
COPYING.LIB		Loading commit data...
COPYING.RUNTIME		Loading commit data...
COPYING3		Loading commit data...
COPYING3.LIB		Loading commit data...
ChangeLog		Loading commit data...
ChangeLog.jit		Loading commit data...
ChangeLog.tree-ssa		Loading commit data...
MAINTAINERS		Loading commit data...
Makefile.def		Loading commit data...
Makefile.in		Loading commit data...
Makefile.tpl		Loading commit data...
README		Loading commit data...
ar-lib		Loading commit data...
compile		Loading commit data...
config-ml.in		Loading commit data...
config.guess		Loading commit data...
config.rpath		Loading commit data...
config.sub		Loading commit data...
configure		Loading commit data...
configure.ac		Loading commit data...
depcomp		Loading commit data...
install-sh		Loading commit data...
libtool-ldflags		Loading commit data...
libtool.m4		Loading commit data...
ltgcc.m4		Loading commit data...
ltmain.sh		Loading commit data...
ltoptions.m4		Loading commit data...
ltsugar.m4		Loading commit data...
ltversion.m4		Loading commit data...
lt~obsolete.m4		Loading commit data...
missing		Loading commit data...
mkdep		Loading commit data...
mkinstalldirs		Loading commit data...
move-if-change		Loading commit data...
multilib.am		Loading commit data...
symlink-tree		Loading commit data...
test-driver		Loading commit data...
ylwrap		Loading commit data...

README