1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . D I R E C T O R I E S --
9 -- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Calendar
; use Ada
.Calendar
;
33 with Ada
.Calendar
.Formatting
; use Ada
.Calendar
.Formatting
;
34 with Ada
.Directories
.Validity
; use Ada
.Directories
.Validity
;
35 with Ada
.Strings
.Maps
;
36 with Ada
.Strings
.Fixed
;
37 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
38 with Ada
.Unchecked_Conversion
;
39 with Ada
.Unchecked_Deallocation
;
40 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
42 with System
.CRTL
; use System
.CRTL
;
43 with System
.OS_Lib
; use System
.OS_Lib
;
44 with System
.Regexp
; use System
.Regexp
;
48 package body Ada
.Directories
is
50 Filename_Max
: constant Integer := 1024;
51 -- 1024 is the value of FILENAME_MAX in stdio.h
53 type Dir_Type_Value
is new System
.Address
;
54 -- This is the low-level address directory structure as returned by the C
57 No_Dir
: constant Dir_Type_Value
:= Dir_Type_Value
(System
.Null_Address
);
59 Dir_Separator
: constant Character;
60 pragma Import
(C
, Dir_Separator
, "__gnat_dir_separator");
61 -- Running system default directory separator
63 Dir_Seps
: constant Ada
.Strings
.Maps
.Character_Set
:=
64 Ada
.Strings
.Maps
.To_Set
("/\");
65 -- UNIX and DOS style directory separators
68 pragma Import (C, Max_Path, "__gnat_max_path_len
");
69 -- The maximum length of a path
71 type Search_Data is record
72 Is_Valid : Boolean := False;
73 Name : Unbounded_String;
76 Dir : Dir_Type_Value := No_Dir;
77 Entry_Fetched : Boolean := False;
78 Dir_Entry : Directory_Entry_Type;
80 -- The current state of a search
82 Empty_String : constant String := (1 .. 0 => ASCII.NUL);
83 -- Empty string, returned by function Extension when there is no extension
85 procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
87 procedure Close (Dir : Dir_Type_Value);
89 function File_Exists (Name : String) return Boolean;
90 -- Returns True if the named file exists
92 procedure Fetch_Next_Entry (Search : Search_Type);
93 -- Get the next entry in a directory, setting Entry_Fetched if successful
94 -- or resetting Is_Valid if not.
100 function Base_Name (Name : String) return String is
101 Simple : constant String := Simple_Name (Name);
102 -- Simple'First is guaranteed to be 1
105 -- Look for the last dot in the file name and return the part of the
106 -- file name preceding this last dot. If the first dot is the first
107 -- character of the file name, the base name is the empty string.
109 for Pos in reverse Simple'Range loop
110 if Simple (Pos) = '.' then
111 return Simple (1 .. Pos - 1);
115 -- If there is no dot, return the complete file name
124 procedure Close (Dir : Dir_Type_Value) is
126 pragma Warnings (Off, Discard);
128 function closedir (directory : DIRs) return Integer;
129 pragma Import (C, closedir, "__gnat_closedir
");
132 Discard := closedir (DIRs (Dir));
140 (Containing_Directory : String := "";
142 Extension : String := "") return String
144 Result : String (1 .. Containing_Directory'Length +
145 Name'Length + Extension'Length + 2);
149 -- First, deal with the invalid cases
151 if Containing_Directory /= ""
152 and then not Is_Valid_Path_Name (Containing_Directory)
154 raise Name_Error with
155 "invalid directory path name
""" & Containing_Directory & '"';
158 Extension'Length = 0 and then (not Is_Valid_Simple_Name (Name))
160 raise Name_Error with
161 "invalid simple name """ & Name & '"';
163 elsif Extension'Length /= 0
164 and then not Is_Valid_Simple_Name (Name & '.' & Extension)
166 raise Name_Error with
167 "invalid file name
""" & Name & '.' & Extension & '"';
169 -- This is not an invalid case so build the path name
172 Last := Containing_Directory'Length;
173 Result (1 .. Last) := Containing_Directory;
175 -- Add a directory separator if needed
177 if Last /= 0 and then Result (Last) /= Dir_Separator then
179 Result (Last) := Dir_Separator;
184 Result (Last + 1 .. Last + Name'Length) := Name;
185 Last := Last + Name'Length;
187 -- If extension was specified, add dot followed by this extension
189 if Extension'Length /= 0 then
191 Result (Last) := '.';
192 Result (Last + 1 .. Last + Extension'Length) := Extension;
193 Last := Last + Extension'Length;
196 return Result (1 .. Last);
200 --------------------------
201 -- Containing_Directory --
202 --------------------------
204 function Containing_Directory (Name : String) return String is
206 -- First, the invalid case
208 if not Is_Valid_Path_Name (Name) then
209 raise Name_Error with "invalid path name """ & Name & '"';
213 -- We need to resolve links because of A.16(47), since we must not
214 -- return alternative names for files.
216 Norm : constant String := Normalize_Pathname (Name);
217 Last_DS : constant Natural :=
219 (Name, Dir_Seps, Going => Strings.Backward);
224 -- There is no directory separator, returns current working
227 return Current_Directory;
229 -- If Name indicates a root directory, raise Use_Error, because
230 -- it has no containing directory.
239 and then Norm
(Norm
'Last - 1 .. Norm
'Last) = ":\"
240 and then (Norm (Norm'First) in 'a' .. 'z'
241 or else Norm (Norm'First) in 'A' .. 'Z'))))
244 "directory
""" & Name & """ has no containing directory
";
248 Last : Positive := Last_DS - Name'First + 1;
249 Result : String (1 .. Last);
252 Result := Name (Name'First .. Last_DS);
254 -- Remove any trailing directory separator, except as the
255 -- first character or the first character following a drive
256 -- number on Windows.
262 Result (Last) /= Directory_Separator;
266 and then Result (2) = ':'
268 (Result (1) in 'A' .. 'Z'
270 Result (1) in 'a' .. 'z');
275 -- Special case of current directory, identified by "."
277 if Last = 1 and then Result (1) = '.' then
278 return Current_Directory;
280 -- Special case of "..": the current directory may be a root
283 elsif Last = 2 and then Result (1 .. 2) = ".." then
284 return Containing_Directory (Current_Directory);
287 return Result (1 .. Last);
293 end Containing_Directory;
300 (Source_Name : String;
301 Target_Name : String;
304 pragma Unreferenced (Form);
308 -- First, the invalid cases
310 if not Is_Valid_Path_Name (Source_Name) then
311 raise Name_Error with
312 "invalid source path name
""" & Source_Name & '"';
314 elsif not Is_Valid_Path_Name (Target_Name) then
315 raise Name_Error with
316 "invalid target path name """ & Target_Name & '"';
318 elsif not Is_Regular_File (Source_Name) then
319 raise Name_Error with '"' & Source_Name & """ is not a file";
321 elsif Is_Directory (Target_Name) then
322 raise Use_Error with "target """ & Target_Name & """ is a directory";
325 -- The implementation uses System.OS_Lib.Copy_File, with parameters
326 -- suitable for all platforms.
328 Copy_File (Source_Name, Target_Name, Success, Overwrite, None);
331 raise Use_Error with "copy of """ & Source_Name & """ failed";
336 ----------------------
337 -- Create_Directory --
338 ----------------------
340 procedure Create_Directory
341 (New_Directory : String;
344 pragma Unreferenced (Form);
346 C_Dir_Name : constant String := New_Directory & ASCII.NUL;
348 function mkdir (Dir_Name : String) return Integer;
349 pragma Import (C, mkdir, "__gnat_mkdir");
352 -- First, the invalid case
354 if not Is_Valid_Path_Name (New_Directory) then
355 raise Name_Error with
356 "invalid new directory path name """ & New_Directory & '"';
359 if mkdir (C_Dir_Name) /= 0 then
361 "creation
of new directory
""" & New_Directory & """ failed
";
364 end Create_Directory;
370 procedure Create_Path
371 (New_Directory : String;
374 pragma Unreferenced (Form);
376 New_Dir : String (1 .. New_Directory'Length + 1);
377 Last : Positive := 1;
380 -- First, the invalid case
382 if not Is_Valid_Path_Name (New_Directory) then
383 raise Name_Error with
384 "invalid
new directory path name
""" & New_Directory & '"';
387 -- Build New_Dir with a directory separator at the end, so that the
388 -- complete path will be found in the loop below.
390 New_Dir (1 .. New_Directory'Length) := New_Directory;
391 New_Dir (New_Dir'Last) := Directory_Separator;
393 -- Create, if necessary, each directory in the path
395 for J in 2 .. New_Dir'Last loop
397 -- Look for the end of an intermediate directory
399 if New_Dir (J) /= Dir_Separator and then
404 -- We have found a new intermediate directory each time we find
405 -- a first directory separator.
407 elsif New_Dir (J - 1) /= Dir_Separator and then
408 New_Dir (J - 1) /= '/'
411 -- No need to create the directory if it already exists
413 if Is_Directory (New_Dir (1 .. Last)) then
416 -- It is an error if a file with such a name already exists
418 elsif Is_Regular_File (New_Dir (1 .. Last)) then
420 "file """ & New_Dir (1 .. Last) & """ already exists";
423 Create_Directory (New_Directory => New_Dir (1 .. Last));
430 -----------------------
431 -- Current_Directory --
432 -----------------------
434 function Current_Directory return String is
435 Path_Len : Natural := Max_Path;
436 Buffer : String (1 .. 1 + Max_Path + 1);
438 procedure Local_Get_Current_Dir
439 (Dir : System.Address;
440 Length : System.Address);
441 pragma Import (C, Local_Get_Current_Dir, "__gnat_get_current_dir");
444 Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
447 -- We need to resolve links because of A.16(47), since we must not
448 -- return alternative names for files
449 Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len));
452 if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
453 return Cur (1 .. Cur'Last - 1);
458 end Current_Directory;
460 ----------------------
461 -- Delete_Directory --
462 ----------------------
464 procedure Delete_Directory (Directory : String) is
466 -- First, the invalid cases
468 if not Is_Valid_Path_Name (Directory) then
469 raise Name_Error with
470 "invalid directory path name """ & Directory & '"';
472 elsif not Is_Directory (Directory) then
473 raise Name_Error with '"' & Directory & """ not a directory";
477 C_Dir_Name : constant String := Directory & ASCII.NUL;
480 if rmdir (C_Dir_Name) /= 0 then
482 "deletion of directory """ & Directory & """ failed";
486 end Delete_Directory;
492 procedure Delete_File (Name : String) is
496 -- First, the invalid cases
498 if not Is_Valid_Path_Name (Name) then
499 raise Name_Error with "invalid path name """ & Name & '"';
501 elsif not Is_Regular_File (Name) then
502 raise Name_Error with "file
""" & Name & """ does
not exist
";
505 -- The implementation uses System.OS_Lib.Delete_File
507 Delete_File (Name, Success);
510 raise Use_Error with "file
""" & Name & """ could
not be deleted
";
519 procedure Delete_Tree (Directory : String) is
520 Current_Dir : constant String := Current_Directory;
521 Search : Search_Type;
522 Dir_Ent : Directory_Entry_Type;
524 -- First, the invalid cases
526 if not Is_Valid_Path_Name (Directory) then
527 raise Name_Error with
528 "invalid directory path name
""" & Directory & '"';
530 elsif not Is_Directory (Directory) then
531 raise Name_Error with '"' & Directory & """ not a directory
";
534 Set_Directory (Directory);
535 Start_Search (Search, Directory => ".", Pattern => "");
537 while More_Entries (Search) loop
538 Get_Next_Entry (Search, Dir_Ent);
541 File_Name : constant String := Simple_Name (Dir_Ent);
544 if System.OS_Lib.Is_Directory (File_Name) then
545 if File_Name /= "." and then File_Name /= ".." then
546 Delete_Tree (File_Name);
550 Delete_File (File_Name);
555 Set_Directory (Current_Dir);
559 C_Dir_Name : constant String := Directory & ASCII.NUL;
562 if rmdir (C_Dir_Name) /= 0 then
564 "directory tree rooted
at """ &
565 Directory & """ could
not be deleted
";
575 function Exists (Name : String) return Boolean is
577 -- First, the invalid case
579 if not Is_Valid_Path_Name (Name) then
580 raise Name_Error with "invalid path name
""" & Name & '"';
583 -- The implementation is in File_Exists
585 return File_Exists (Name);
593 function Extension (Name : String) return String is
595 -- First, the invalid case
597 if not Is_Valid_Path_Name (Name) then
598 raise Name_Error with "invalid path name """ & Name & '"';
601 -- Look for first dot that is not followed by a directory separator
603 for Pos in reverse Name'Range loop
605 -- If a directory separator is found before a dot, there is no
608 if Name (Pos) = Dir_Separator then
611 elsif Name (Pos) = '.' then
613 -- We found a dot, build the return value with lower bound 1
616 subtype Result_Type is String (1 .. Name'Last - Pos);
618 return Result_Type (Name (Pos + 1 .. Name'Last));
623 -- No dot were found, there is no extension
629 ----------------------
630 -- Fetch_Next_Entry --
631 ----------------------
633 procedure Fetch_Next_Entry (Search : Search_Type) is
634 Name : String (1 .. 255);
637 Kind : File_Kind := Ordinary_File;
638 -- Initialized to avoid a compilation warning
640 Filename_Addr : System.Address;
641 Filename_Len : aliased Integer;
643 Buffer : array (0 .. Filename_Max + 12) of Character;
644 -- 12 is the size of the dirent structure (see dirent.h), without the
645 -- field for the filename.
647 function readdir_gnat
648 (Directory : System.Address;
649 Buffer : System.Address;
650 Last : not null access Integer) return System.Address;
651 pragma Import (C, readdir_gnat, "__gnat_readdir
");
656 -- Search.Value.Is_Valid is always True when Fetch_Next_Entry is called
661 (System.Address (Search.Value.Dir),
663 Filename_Len'Access);
665 -- If no matching entry is found, set Is_Valid to False
667 if Filename_Addr = System.Null_Address then
668 Search.Value.Is_Valid := False;
673 subtype Path_String is String (1 .. Filename_Len);
674 type Path_String_Access is access Path_String;
676 function Address_To_Access is new
677 Ada.Unchecked_Conversion
679 Target => Path_String_Access);
681 Path_Access : constant Path_String_Access :=
682 Address_To_Access (Filename_Addr);
685 Last := Filename_Len;
686 Name (1 .. Last) := Path_Access.all;
689 -- Check if the entry matches the pattern
691 if Match (Name (1 .. Last), Search.Value.Pattern) then
693 Full_Name : constant String :=
696 (Search.Value.Name), Name (1 .. Last));
697 Found : Boolean := False;
700 if File_Exists (Full_Name) then
702 -- Now check if the file kind matches the filter
704 if Is_Regular_File (Full_Name) then
705 if Search.Value.Filter (Ordinary_File) then
706 Kind := Ordinary_File;
710 elsif Is_Directory (Full_Name) then
711 if Search.Value.Filter (Directory) then
716 elsif Search.Value.Filter (Special_File) then
717 Kind := Special_File;
721 -- If it does, update Search and return
724 Search.Value.Entry_Fetched := True;
725 Search.Value.Dir_Entry :=
727 Simple => To_Unbounded_String (Name (1 .. Last)),
728 Full => To_Unbounded_String (Full_Name),
736 end Fetch_Next_Entry;
742 function File_Exists (Name : String) return Boolean is
743 function C_File_Exists (A : System.Address) return Integer;
744 pragma Import (C, C_File_Exists, "__gnat_file_exists
");
746 C_Name : String (1 .. Name'Length + 1);
749 C_Name (1 .. Name'Length) := Name;
750 C_Name (C_Name'Last) := ASCII.NUL;
751 return C_File_Exists (C_Name (1)'Address) = 1;
758 procedure Finalize (Search : in out Search_Type) is
760 if Search.Value /= null then
762 -- Close the directory, if one is open
764 if Search.Value.Dir /= No_Dir then
765 Close (Search.Value.Dir);
776 function Full_Name (Name : String) return String is
778 -- First, the invalid case
780 if not Is_Valid_Path_Name (Name) then
781 raise Name_Error with "invalid path name
""" & Name & '"';
784 -- Build the return value with lower bound 1
786 -- Use System.OS_Lib.Normalize_Pathname
789 -- We need to resolve links because of A.16(47), since we must not
790 -- return alternative names for files
791 Value : constant String := Normalize_Pathname (Name);
792 subtype Result is String (1 .. Value'Length);
794 return Result (Value);
799 function Full_Name (Directory_Entry : Directory_Entry_Type) return String is
801 -- First, the invalid case
803 if not Directory_Entry.Is_Valid then
804 raise Status_Error with "invalid directory entry";
807 -- The value to return has already been computed
809 return To_String (Directory_Entry.Full);
817 procedure Get_Next_Entry
818 (Search : in out Search_Type;
819 Directory_Entry : out Directory_Entry_Type)
822 -- First, the invalid case
824 if Search.Value = null or else not Search.Value.Is_Valid then
825 raise Status_Error with "invalid search";
828 -- Fetch the next entry, if needed
830 if not Search.Value.Entry_Fetched then
831 Fetch_Next_Entry (Search);
834 -- It is an error if no valid entry is found
836 if not Search.Value.Is_Valid then
837 raise Status_Error with "no next entry";
840 -- Reset Entry_Fetched and return the entry
842 Search.Value.Entry_Fetched := False;
843 Directory_Entry := Search.Value.Dir_Entry;
851 function Kind (Name : String) return File_Kind is
853 -- First, the invalid case
855 if not File_Exists (Name) then
856 raise Name_Error with "file """ & Name & """ does not exist";
858 elsif Is_Regular_File (Name) then
859 return Ordinary_File;
861 elsif Is_Directory (Name) then
869 function Kind (Directory_Entry : Directory_Entry_Type) return File_Kind is
871 -- First, the invalid case
873 if not Directory_Entry.Is_Valid then
874 raise Status_Error with "invalid directory entry";
877 -- The value to return has already be computed
879 return Directory_Entry.Kind;
883 -----------------------
884 -- Modification_Time --
885 -----------------------
887 function Modification_Time (Name : String) return Time is
893 Minute : Minute_Type;
894 Second : Second_Type;
898 -- First, the invalid cases
900 if not (Is_Regular_File (Name) or else Is_Directory (Name)) then
901 raise Name_Error with '"' & Name & """ not a file
or directory
";
904 Date := File_Time_Stamp (Name);
906 -- Break down the time stamp into its constituents relative to GMT.
907 -- This version of Split does not recognize leap seconds or buffer
908 -- space for time zone processing.
910 GM_Split (Date, Year, Month, Day, Hour, Minute, Second);
912 -- On OpenVMS, the resulting time value must be in the local time
913 -- zone. Ada.Calendar.Time_Of is exactly what we need. Note that
914 -- in both cases, the sub seconds are set to zero (0.0) because the
915 -- time stamp does not store them in its value.
920 (Year, Month, Day, Seconds_Of (Hour, Minute, Second, 0.0));
922 -- On Unix and Windows, the result must be in GMT. Ada.Calendar.
923 -- Formatting.Time_Of with default time zone of zero (0) is the
924 -- routine of choice.
927 Result := Time_Of (Year, Month, Day, Hour, Minute, Second, 0.0);
932 end Modification_Time;
934 function Modification_Time
935 (Directory_Entry : Directory_Entry_Type) return Ada.Calendar.Time
938 -- First, the invalid case
940 if not Directory_Entry.Is_Valid then
941 raise Status_Error with "invalid directory
entry";
944 -- The value to return has already be computed
946 return Modification_Time (To_String (Directory_Entry.Full));
948 end Modification_Time;
954 function More_Entries (Search : Search_Type) return Boolean is
956 if Search.Value = null then
959 elsif Search.Value.Is_Valid then
961 -- Fetch the next entry, if needed
963 if not Search.Value.Entry_Fetched then
964 Fetch_Next_Entry (Search);
968 return Search.Value.Is_Valid;
975 procedure Rename (Old_Name, New_Name : String) is
979 -- First, the invalid cases
981 if not Is_Valid_Path_Name (Old_Name) then
982 raise Name_Error with "invalid old path name
""" & Old_Name & '"';
984 elsif not Is_Valid_Path_Name (New_Name) then
985 raise Name_Error with "invalid new path name """ & New_Name & '"';
987 elsif not Is_Regular_File (Old_Name)
988 and then not Is_Directory (Old_Name)
990 raise Name_Error with "old file
""" & Old_Name & """ does
not exist
";
992 elsif Is_Regular_File (New_Name) or else Is_Directory (New_Name) then
994 "new name
""" & New_Name
995 & """ designates a file that already exists
";
998 -- The implementation uses System.OS_Lib.Rename_File
1000 Rename_File (Old_Name, New_Name, Success);
1003 raise Use_Error with
1004 "file
""" & Old_Name & """ could
not be renamed
";
1014 (Directory : String;
1016 Filter : Filter_Type := (others => True);
1017 Process : not null access procedure
1018 (Directory_Entry : Directory_Entry_Type))
1021 Directory_Entry : Directory_Entry_Type;
1024 Start_Search (Srch, Directory, Pattern, Filter);
1026 while More_Entries (Srch) loop
1027 Get_Next_Entry (Srch, Directory_Entry);
1028 Process (Directory_Entry);
1038 procedure Set_Directory (Directory : String) is
1039 C_Dir_Name : constant String := Directory & ASCII.NUL;
1041 if not Is_Valid_Path_Name (Directory) then
1042 raise Name_Error with
1043 "invalid directory path name
& """ & Directory & '"';
1045 elsif not Is_Directory (Directory) then
1046 raise Name_Error with
1047 "directory """ & Directory & """ does not exist";
1049 elsif chdir (C_Dir_Name) /= 0 then
1050 raise Name_Error with
1051 "could not set to designated directory """ & Directory & '"';
1059 function Simple_Name (Name : String) return String is
1061 function Simple_Name_Internal (Path : String) return String;
1062 -- This function does the job
1064 --------------------------
1065 -- Simple_Name_Internal --
1066 --------------------------
1068 function Simple_Name_Internal (Path : String) return String is
1069 Cut_Start : Natural :=
1071 (Path, Dir_Seps, Going => Strings.Backward);
1075 -- Cut_Start pointS to the first simple name character
1077 Cut_Start := (if Cut_Start = 0 then Path'First else Cut_Start + 1);
1079 -- Cut_End point to the last simple name character
1081 Cut_End := Path'Last;
1083 Check_For_Standard_Dirs : declare
1084 BN : constant String := Path (Cut_Start .. Cut_End);
1085 Has_Drive_Letter : constant Boolean :=
1086 System.OS_Lib.Path_Separator /= ':';
1087 -- If Path separator is not ':' then we are on a DOS based OS
1088 -- where this character is used as a drive letter separator.
1091 if BN = "." or else BN = ".." then
1094 elsif Has_Drive_Letter
1095 and then BN'Length > 2
1096 and then Characters.Handling.Is_Letter (BN (BN'First))
1097 and then BN (BN'First + 1) = ':'
1099 -- We have a DOS drive letter prefix, remove it
1101 return BN (BN'First + 2 .. BN'Last);
1106 end Check_For_Standard_Dirs;
1107 end Simple_Name_Internal;
1109 -- Start of processing for Simple_Name
1112 -- First, the invalid case
1114 if not Is_Valid_Path_Name (Name) then
1115 raise Name_Error with "invalid path name
""" & Name & '"';
1118 -- Build the value to return with lower bound 1
1121 Value : constant String := Simple_Name_Internal (Name);
1122 subtype Result is String (1 .. Value'Length);
1124 return Result (Value);
1129 function Simple_Name
1130 (Directory_Entry : Directory_Entry_Type) return String is
1132 -- First, the invalid case
1134 if not Directory_Entry.Is_Valid then
1135 raise Status_Error with "invalid directory entry";
1138 -- The value to return has already be computed
1140 return To_String (Directory_Entry.Simple);
1148 function Size (Name : String) return File_Size is
1149 C_Name : String (1 .. Name'Length + 1);
1151 function C_Size (Name : System.Address) return Long_Integer;
1152 pragma Import (C, C_Size, "__gnat_named_file_length");
1155 -- First, the invalid case
1157 if not Is_Regular_File (Name) then
1158 raise Name_Error with "file """ & Name & """ does not exist";
1161 C_Name (1 .. Name'Length) := Name;
1162 C_Name (C_Name'Last) := ASCII.NUL;
1163 return File_Size (C_Size (C_Name'Address));
1167 function Size (Directory_Entry : Directory_Entry_Type) return File_Size is
1169 -- First, the invalid case
1171 if not Directory_Entry.Is_Valid then
1172 raise Status_Error with "invalid directory entry";
1175 -- The value to return has already be computed
1177 return Size (To_String (Directory_Entry.Full));
1185 procedure Start_Search
1186 (Search : in out Search_Type;
1189 Filter : Filter_Type := (others => True))
1191 function opendir (file_name : String) return DIRs;
1192 pragma Import (C, opendir, "__gnat_opendir");
1194 C_File_Name : constant String := Directory & ASCII.NUL;
1196 Dir : Dir_Type_Value;
1199 -- First, the invalid case Name_Error
1201 if not Is_Directory (Directory) then
1202 raise Name_Error with
1203 "unknown directory """ & Simple_Name (Directory) & '"';
1206 -- Check the pattern
1212 Case_Sensitive => Is_Path_Name_Case_Sensitive);
1214 when Error_In_Regexp =>
1215 Free (Search.Value);
1216 raise Name_Error with "invalid pattern
""" & Pattern & '"';
1219 Dir := Dir_Type_Value (opendir (C_File_Name));
1221 if Dir = No_Dir then
1222 raise Use_Error with
1223 "unreadable directory """ & Simple_Name (Directory) & '"';
1226 -- If needed, finalize Search
1230 -- Allocate the default data
1232 Search.Value := new Search_Data;
1234 -- Initialize some Search components
1236 Search.Value.Filter := Filter;
1237 Search.Value.Name := To_Unbounded_String (Full_Name (Directory));
1238 Search.Value.Pattern := Pat;
1239 Search.Value.Dir := Dir;
1240 Search.Value.Is_Valid := True;
1243 end Ada.Directories;