a-dhfina.adb
11.4 KB
-
[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
Justin Squirek committed