public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-6372] [Ada] Read directory in Ada.Directories.Start_Search rather than Get_Next_Entry
@ 2022-01-07 16:29 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-01-07 16:29 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a64478660ee95930773d356760e39e05fe0147fe
commit r12-6372-ga64478660ee95930773d356760e39e05fe0147fe
Author: Patrick Bernardi <bernardi@adacore.com>
Date: Wed Dec 22 16:32:41 2021 -0500
[Ada] Read directory in Ada.Directories.Start_Search rather than Get_Next_Entry
gcc/ada/
* libgnat/a-direct.adb (Search_Data): Remove type.
(Directory_Vectors): New package instantiation.
(Search_State): New type.
(Fetch_Next_Entry): Remove.
(Close): Remove.
(Finalize): Rewritten.
(Full_Name): Ditto.
(Get_Next_Entry): Return next entry from Search results vector
rather than querying the directory directly using readdir.
(Kind): Rewritten.
(Modification_Time): Rewritten.
(More_Entries): Use Search state cursor to determine if more
entries are available for users to read.
(Simple_Name): Rewritten.
(Size): Rewritten.
(Start_Search_Internal): Rewritten to load the contents of the
directory that matches the pattern and filter into the search
object.
* libgnat/a-direct.ads (Search_Type): New type.
(Search_Ptr): Ditto.
(Directory_Entry_Type): Rewritten to support new Start_Search
procedure.
* libgnat/s-filatt.ads (File_Length_Attr): New function.
Diff:
---
gcc/ada/libgnat/a-direct.adb | 550 +++++++++++++++++++++----------------------
gcc/ada/libgnat/a-direct.ads | 82 ++++---
gcc/ada/libgnat/s-filatt.ads | 6 +
3 files changed, 330 insertions(+), 308 deletions(-)
diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb
index 41dca3c6a56..b8db8dcceb8 100644
--- a/gcc/ada/libgnat/a-direct.adb
+++ b/gcc/ada/libgnat/a-direct.adb
@@ -31,12 +31,14 @@
with Ada.Calendar; use Ada.Calendar;
with Ada.Characters.Handling; use Ada.Characters.Handling;
+with Ada.Containers.Vectors;
with Ada.Directories.Validity; use Ada.Directories.Validity;
with Ada.Directories.Hierarchical_File_Names;
-use 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;
+with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
@@ -78,40 +80,56 @@ package body Ada.Directories is
-- Result returned from C_Modification_Time call when routine unable to get
-- file modification time.
- type Search_Data is record
- Is_Valid : Boolean := False;
- Name : Unbounded_String;
- Pattern : Regexp;
- Filter : Filter_Type;
- Dir : Dir_Type_Value := No_Dir;
- Entry_Fetched : Boolean := False;
- Dir_Entry : Directory_Entry_Type;
- end record;
- -- The current state of a search
-
Empty_String : constant String := "";
-- Empty string, returned by function Extension when there is no extension
- procedure Free is new Ada.Unchecked_Deallocation (Search_Data, Search_Ptr);
+ ----------------------------
+ -- Directory Search Types --
+ ----------------------------
+
+ package Directory_Vectors is new
+ Ada.Containers.Vectors
+ (Index_Type => Natural,
+ Element_Type => Directory_Entry_Type);
+ use Directory_Vectors;
+ -- Used to store the results of the directory search
+
+ type Dir_Contents_Ptr is access Directory_Vectors.Vector;
+
+ procedure Free is new Ada.Unchecked_Deallocation
+ (Directory_Vectors.Vector, Dir_Contents_Ptr);
+ -- Directory_Vectors.Vector deallocation routine
+
+ type Search_State is new Ada.Finalization.Controlled with record
+ Dir_Contents : Dir_Contents_Ptr;
+ Next_Entry : Cursor;
+ end record;
+ -- The Search_State consists of a vector of directory items that match the
+ -- search pattern and filter, and a cursor pointing to the next item of the
+ -- vector to be returned to the user.
+
+ procedure Free is new Ada.Unchecked_Deallocation (Search_State, Search_Ptr);
+ -- Search_State deallocation routine
+
+ Dir_Vector_Initial_Size : constant := 100;
+ -- Initial size for the Dir_Contents vector, sized to ensure the vector
+ -- does not need to be reallocated for reasonably sized directory searches.
- procedure Close (Dir : Dir_Type_Value);
+ ------------------------
+ -- Helper Subprograms --
+ ------------------------
function File_Exists (Name : String) return Boolean;
-- Returns True if the named file exists
- procedure Fetch_Next_Entry (Search : Search_Type);
- -- Get the next entry in a directory, setting Entry_Fetched if successful
- -- or resetting Is_Valid if not.
-
procedure Start_Search_Internal
- (Search : in out Search_Type;
- Directory : String;
- Pattern : String;
- Filter : Filter_Type := [others => True];
- Force_Case_Insensitive : Boolean);
- -- Similar to Start_Search except we can force a search to be
- -- case-insensitive, which is important for detecting the name-case
- -- equivalence for a given directory.
+ (Search : in out Search_Type;
+ Directory : String;
+ Pattern : String;
+ Filter : Filter_Type := [others => True];
+ Case_Insensitive : Boolean);
+ -- Similar to Start_Search except we can specify a case-insensitive search.
+ -- This enables detecting the name-case equivalence for a given directory.
---------------
-- Base_Name --
@@ -137,21 +155,6 @@ package body Ada.Directories is
return Simple;
end Base_Name;
- -----------
- -- Close --
- -----------
-
- procedure Close (Dir : Dir_Type_Value) is
- Discard : Integer;
- pragma Warnings (Off, Discard);
-
- function closedir (directory : DIRs) return Integer;
- pragma Import (C, closedir, "__gnat_closedir");
-
- begin
- Discard := closedir (DIRs (Dir));
- end Close;
-
-------------
-- Compose --
-------------
@@ -378,7 +381,7 @@ package body Ada.Directories is
(New_Directory : String;
Form : String := "")
is
- C_Dir_Name : constant String := New_Directory & ASCII.NUL;
+ Dir_Name_C : constant String := New_Directory & ASCII.NUL;
begin
-- First, the invalid case
@@ -411,7 +414,7 @@ package body Ada.Directories is
raise Use_Error with "invalid Form";
end if;
- if CRTL.mkdir (C_Dir_Name, Encoding) /= 0 then
+ if CRTL.mkdir (Dir_Name_C, Encoding) /= 0 then
raise Use_Error with
"creation of new directory """ & New_Directory & """ failed";
end if;
@@ -553,9 +556,9 @@ package body Ada.Directories is
else
declare
- C_Dir_Name : constant String := Directory & ASCII.NUL;
+ Dir_Name_C : constant String := Directory & ASCII.NUL;
begin
- if rmdir (C_Dir_Name) /= 0 then
+ if rmdir (Dir_Name_C) /= 0 then
raise Use_Error with
"deletion of directory """ & Directory & """ failed";
end if;
@@ -640,10 +643,10 @@ package body Ada.Directories is
End_Search (Search);
declare
- C_Dir_Name : constant String := Directory & ASCII.NUL;
+ Dir_Name_C : constant String := Directory & ASCII.NUL;
begin
- if rmdir (C_Dir_Name) /= 0 then
+ if rmdir (Dir_Name_C) /= 0 then
raise Use_Error with
"directory tree rooted at """ &
Directory & """ could not be deleted";
@@ -710,141 +713,6 @@ package body Ada.Directories is
end if;
end Extension;
- ----------------------
- -- Fetch_Next_Entry --
- ----------------------
-
- procedure Fetch_Next_Entry (Search : Search_Type) is
- Name : String (1 .. NAME_MAX);
- Last : Natural;
-
- Kind : File_Kind := Ordinary_File;
- -- Initialized to avoid a compilation warning
-
- Filename_Addr : Address;
- Filename_Len : aliased Integer;
-
- Buffer : array (1 .. SIZEOF_struct_dirent_alloc) of Character;
-
- function readdir_gnat
- (Directory : Address;
- Buffer : Address;
- Last : not null access Integer) return Address;
- pragma Import (C, readdir_gnat, "__gnat_readdir");
-
- begin
- -- Search.Value.Is_Valid is always True when Fetch_Next_Entry is called
-
- loop
- Filename_Addr :=
- readdir_gnat
- (Address (Search.Value.Dir),
- Buffer'Address,
- Filename_Len'Access);
-
- -- If no matching entry is found, set Is_Valid to False
-
- if Filename_Addr = Null_Address then
- Search.Value.Is_Valid := False;
- exit;
- end if;
-
- if Filename_Len > Name'Length then
- raise Use_Error with "file name too long";
- end if;
-
- declare
- subtype Name_String is String (1 .. Filename_Len);
- Dent_Name : Name_String;
- for Dent_Name'Address use Filename_Addr;
- pragma Import (Ada, Dent_Name);
-
- begin
- Last := Filename_Len;
- Name (1 .. Last) := Dent_Name;
- end;
-
- -- Check if the entry matches the pattern
-
- if Match (Name (1 .. Last), Search.Value.Pattern) then
- declare
- C_Full_Name : constant String :=
- Compose (To_String (Search.Value.Name),
- Name (1 .. Last)) & ASCII.NUL;
- Full_Name : String renames
- C_Full_Name
- (C_Full_Name'First .. C_Full_Name'Last - 1);
- Found : Boolean := False;
- Attr : aliased File_Attributes;
- Exists : Integer;
- Error : Integer;
-
- begin
- Reset_Attributes (Attr'Access);
- Exists := File_Exists_Attr (C_Full_Name'Address, Attr'Access);
- Error := Error_Attributes (Attr'Access);
-
- if Error /= 0 then
- raise Use_Error
- with Full_Name & ": " & Errno_Message (Err => Error);
- 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
-
- if Is_Regular_File_Attr
- (C_Full_Name'Address, Attr'Access) = 1
- then
- if Search.Value.Filter (Ordinary_File) then
- Kind := Ordinary_File;
- Found := True;
- end if;
-
- elsif Is_Directory_Attr
- (C_Full_Name'Address, Attr'Access) = 1
- then
- if Search.Value.Filter (Directory) then
- Kind := Directory;
- Found := True;
- end if;
-
- elsif Search.Value.Filter (Special_File) then
- Kind := Special_File;
- Found := True;
- end if;
-
- -- If it does, update Search and return
-
- if Found then
- Search.Value.Entry_Fetched := True;
- Search.Value.Dir_Entry :=
- (Is_Valid => True,
- Simple => To_Unbounded_String (Name (1 .. Last)),
- Full => To_Unbounded_String (Full_Name),
- Kind => Kind);
- exit;
- end if;
- end if;
- end;
- end if;
- end loop;
- end Fetch_Next_Entry;
-
-----------------
-- File_Exists --
-----------------
@@ -867,15 +735,9 @@ package body Ada.Directories is
procedure Finalize (Search : in out Search_Type) is
begin
- if Search.Value /= null then
-
- -- Close the directory, if one is open
-
- if Search.Value.Dir /= No_Dir then
- Close (Search.Value.Dir);
- end if;
-
- Free (Search.Value);
+ if Search.State /= null then
+ Free (Search.State.Dir_Contents);
+ Free (Search.State);
end if;
end Finalize;
@@ -910,15 +772,13 @@ package body Ada.Directories is
function Full_Name (Directory_Entry : Directory_Entry_Type) return String is
begin
- -- First, the invalid case
+ -- If the Directory_Entry is valid return the full name contained in the
+ -- entry record.
- if not Directory_Entry.Is_Valid then
+ if not Directory_Entry.Valid then
raise Status_Error with "invalid directory entry";
-
else
- -- The value to return has already been computed
-
- return To_String (Directory_Entry.Full);
+ return To_String (Directory_Entry.Full_Name);
end if;
end Full_Name;
@@ -931,28 +791,34 @@ package body Ada.Directories is
Directory_Entry : out Directory_Entry_Type)
is
begin
- -- First, the invalid case
+ -- A Search with no state implies the user has not called Start_Search
- if Search.Value = null or else not Search.Value.Is_Valid then
- raise Status_Error with "invalid search";
+ if Search.State = null then
+ raise Status_Error with "search not started";
end if;
- -- Fetch the next entry, if needed
+ -- If the next entry is No_Element it means the search is finished and
+ -- there are no more entries to return.
- if not Search.Value.Entry_Fetched then
- Fetch_Next_Entry (Search);
+ if Search.State.Next_Entry = No_Element then
+ raise Status_Error with "no more entries";
end if;
- -- It is an error if no valid entry is found
+ -- Populate Directory_Entry with the next entry and update the search
+ -- state.
- if not Search.Value.Is_Valid then
- raise Status_Error with "no next entry";
+ Directory_Entry := Element (Search.State.Next_Entry);
+ Next (Search.State.Next_Entry);
- else
- -- Reset Entry_Fetched and return the entry
+ -- If Start_Search received a non-zero error code when trying to read
+ -- the file attributes of this entry, raise an Use_Error so the user
+ -- is aware that it was not possible to retrieve the attributes of this
+ -- entry.
- Search.Value.Entry_Fetched := False;
- Directory_Entry := Search.Value.Dir_Entry;
+ if Directory_Entry.Attr_Error_Code /= 0 then
+ raise Use_Error
+ with To_String (Directory_Entry.Full_Name) & ": " &
+ Errno_Message (Err => Directory_Entry.Attr_Error_Code);
end if;
end Get_Next_Entry;
@@ -982,14 +848,9 @@ package body Ada.Directories is
function Kind (Directory_Entry : Directory_Entry_Type) return File_Kind is
begin
- -- First, the invalid case
-
- if not Directory_Entry.Is_Valid then
+ if not Directory_Entry.Valid then
raise Status_Error with "invalid directory entry";
-
else
- -- The value to return has already be computed
-
return Directory_Entry.Kind;
end if;
end Kind;
@@ -1025,15 +886,15 @@ package body Ada.Directories is
(Directory_Entry : Directory_Entry_Type) return Ada.Calendar.Time
is
begin
- -- First, the invalid case
+ -- If the Directory_Entry is valid return the modification time
+ -- contained in the entry record. The modification time is recorded in
+ -- the entry since its cheap to query all the file the attributes in
+ -- one read when the directory is searched.
- if not Directory_Entry.Is_Valid then
+ if not Directory_Entry.Valid then
raise Status_Error with "invalid directory entry";
-
else
- -- The value to return has already be computed
-
- return Modification_Time (To_String (Directory_Entry.Full));
+ return Directory_Entry.Modification_Time;
end if;
end Modification_Time;
@@ -1043,19 +904,17 @@ package body Ada.Directories is
function More_Entries (Search : Search_Type) return Boolean is
begin
- if Search.Value = null then
- return False;
-
- elsif Search.Value.Is_Valid then
+ -- If the vector cursor Search.State.Next_Entry points to an element in
+ -- Search.State.Dir_Contents then there is another entry to return.
+ -- Otherwise, we return False.
- -- Fetch the next entry, if needed
-
- if not Search.Value.Entry_Fetched then
- Fetch_Next_Entry (Search);
- end if;
+ if Search.State = null then
+ return False;
+ elsif Search.State.Next_Entry = No_Element then
+ return False;
+ else
+ return True;
end if;
-
- return Search.Value.Is_Valid;
end More_Entries;
---------------------------
@@ -1115,7 +974,7 @@ package body Ada.Directories is
Directory => To_String (Dir_Path),
Pattern => Simple_Name (Test_File),
Filter => [Directory => False, others => True],
- Force_Case_Insensitive => True);
+ Case_Insensitive => True);
-- We will find at least one match due to the search hitting our test
-- file.
@@ -1237,7 +1096,7 @@ package body Ada.Directories is
-------------------
procedure Set_Directory (Directory : String) is
- C_Dir_Name : constant String := Directory & ASCII.NUL;
+ Dir_Name_C : constant String := Directory & ASCII.NUL;
begin
if not Is_Valid_Path_Name (Directory) then
raise Name_Error with
@@ -1247,7 +1106,7 @@ package body Ada.Directories is
raise Name_Error with
"directory """ & Directory & """ does not exist";
- elsif chdir (C_Dir_Name) /= 0 then
+ elsif chdir (Dir_Name_C) /= 0 then
raise Name_Error with
"could not set to designated directory """ & Directory & '"';
end if;
@@ -1344,15 +1203,13 @@ package body Ada.Directories is
function Simple_Name
(Directory_Entry : Directory_Entry_Type) return String is
begin
- -- First, the invalid case
+ -- If the Directory_Entry is valid return the simple name contained in
+ -- the entry record.
- if not Directory_Entry.Is_Valid then
+ if not Directory_Entry.Valid then
raise Status_Error with "invalid directory entry";
-
else
- -- The value to return has already be computed
-
- return To_String (Directory_Entry.Simple);
+ return To_String (Directory_Entry.Name);
end if;
end Simple_Name;
@@ -1381,15 +1238,15 @@ package body Ada.Directories is
function Size (Directory_Entry : Directory_Entry_Type) return File_Size is
begin
- -- First, the invalid case
+ -- If the Directory_Entry is valid return the size contained in the
+ -- entry record. The size is recorded in the entry since it is cheap to
+ -- query all the file the attributes in one read when the directory is
+ -- searched.
- if not Directory_Entry.Is_Valid then
+ if not Directory_Entry.Valid then
raise Status_Error with "invalid directory entry";
-
else
- -- The value to return has already be computed
-
- return Size (To_String (Directory_Entry.Full));
+ return Directory_Entry.Size;
end if;
end Size;
@@ -1412,69 +1269,206 @@ package body Ada.Directories is
---------------------------
procedure Start_Search_Internal
- (Search : in out Search_Type;
- Directory : String;
- Pattern : String;
- Filter : Filter_Type := [others => True];
- Force_Case_Insensitive : Boolean)
+ (Search : in out Search_Type;
+ Directory : String;
+ Pattern : String;
+ Filter : Filter_Type := [others => True];
+ Case_Insensitive : Boolean)
is
- function opendir (file_name : String) return DIRs;
- pragma Import (C, opendir, "__gnat_opendir");
+ function closedir (Directory : DIRs) return Integer
+ with Import, External_Name => "__gnat_closedir", Convention => C;
+ -- C lib function to close Directory
+
+ function opendir (Directory : String) return DIRs
+ with Import, External_Name => "__gnat_opendir", Convention => C;
+ -- C lib function to open Directory
+
+ function readdir_gnat
+ (Directory : Address;
+ Buffer : Address;
+ Last : not null access Integer) return Address
+ with Import, External_Name => "__gnat_readdir", Convention => C;
+ -- Read the next item in Directory
- C_File_Name : constant String := Directory & ASCII.NUL;
- Pat : Regexp;
- Dir : Dir_Type_Value;
+ Dir_Name_C : constant String := Directory & ASCII.NUL;
+ Dir_Entry_Buffer : array (1 .. SIZEOF_struct_dirent_alloc) of Character;
+ Dir_Pointer : Dir_Type_Value;
+ File_Name_Addr : Address;
+ File_Name_Len : aliased Integer;
+ Pattern_Regex : Regexp;
+
+ Call_Result : Integer;
+ pragma Warnings (Off, Call_Result);
+ -- Result of calling a C function that returns a status
begin
- -- First, the invalid case Name_Error
+ -- Check that Directory is a valid directory
if not Is_Directory (Directory) then
raise Name_Error with
"unknown directory """ & Simple_Name (Directory) & '"';
end if;
- -- Check the pattern
+ -- Check and compile the pattern
declare
Case_Sensitive : Boolean := Is_Path_Name_Case_Sensitive;
begin
- if Force_Case_Insensitive then
+ if Case_Insensitive then
Case_Sensitive := False;
end if;
- Pat :=
- Compile
- (Pattern,
- Glob => True,
- Case_Sensitive => Case_Sensitive);
+ Pattern_Regex :=
+ Compile (Pattern, Glob => True, Case_Sensitive => Case_Sensitive);
exception
when Error_In_Regexp =>
- Free (Search.Value);
raise Name_Error with "invalid pattern """ & Pattern & '"';
end;
- Dir := Dir_Type_Value (opendir (C_File_Name));
+ -- Open Directory
+
+ Dir_Pointer := Dir_Type_Value (opendir (Dir_Name_C));
- if Dir = No_Dir then
+ if Dir_Pointer = No_Dir then
raise Use_Error with
"unreadable directory """ & Simple_Name (Directory) & '"';
end if;
- -- If needed, finalize Search
+ -- If needed, finalize Search. Note: we should probably raise an
+ -- exception here if Search belongs to an existing search rather than
+ -- quietly end it. However, we first need to check that it won't break
+ -- existing software.
Finalize (Search);
- -- Allocate the default data
+ -- Allocate and initialize the search state
+
+ Search.State := new Search_State'
+ (Ada.Finalization.Controlled with
+ Dir_Contents => new Vector,
+ Next_Entry => No_Element);
+
+ -- Increase the size of the Dir_Contents vector so it does not need to
+ -- grow for most reasonable directory searches.
+
+ Search.State.Dir_Contents.Reserve_Capacity (Dir_Vector_Initial_Size);
+
+ -- Read the contents of Directory into Search.State
+
+ loop
+ -- Get next item in the directory
+
+ File_Name_Addr :=
+ readdir_gnat
+ (Address (Dir_Pointer),
+ Dir_Entry_Buffer'Address,
+ File_Name_Len'Access);
+
+ exit when File_Name_Addr = Null_Address;
+
+ -- If the file name matches the Pattern and the file type matches
+ -- the Filter add it to our search vector.
+
+ declare
+ subtype File_Name_String is String (1 .. File_Name_Len);
+
+ File_Name : constant File_Name_String
+ with Import, Address => File_Name_Addr;
+
+ begin
+ if Match (File_Name, Pattern_Regex) then
+ declare
+ Path_C : constant String :=
+ Compose (Directory, File_Name) & ASCII.NUL;
+ Path : String renames
+ Path_C (Path_C'First .. Path_C'Last - 1);
+ Found : Boolean := False;
+ Attr : aliased File_Attributes;
+ Exists : Integer;
+ Error : Integer;
+ Kind : File_Kind;
+ Size : File_Size;
+
+ begin
+ -- Get the file attributes for the directory item
+
+ Reset_Attributes (Attr'Access);
+ Exists := File_Exists_Attr (Path_C'Address, Attr'Access);
+ Error := Error_Attributes (Attr'Access);
+
+ -- If there was an error when trying to read the attributes
+ -- of a Directory entry, record the error so it can be
+ -- propagated to the user when they interate through the
+ -- directory results.
+
+ if Error /= 0 then
+ Search.State.Dir_Contents.Append
+ (Directory_Entry_Type'
+ [Valid => True,
+ Name => To_Unbounded_String (File_Name),
+ Full_Name => To_Unbounded_String (Path),
+ Attr_Error_Code => Error,
+ others => <>]);
+
+ -- Otherwise, if the file exists and matches the file kind
+ -- Filter, add the file to the search results. We capture
+ -- the size and modification time here as we have already
+ -- the entry's attributes above.
+
+ elsif Exists = 1 then
+ if Is_Regular_File_Attr (Path_C'Address, Attr'Access) = 1
+ and then Filter (Ordinary_File)
+ then
+ Found := True;
+ Kind := Ordinary_File;
+ Size :=
+ File_Size
+ (File_Length_Attr
+ (-1, Path_C'Address, Attr'Access));
+
+ elsif Is_Directory_Attr (Path_C'Address, Attr'Access) = 1
+ and then Filter (File_Kind'First)
+ then
+ Found := True;
+ Kind := File_Kind'First;
+ -- File_Kind'First is used instead of Directory due
+ -- to a name overload issue with the procedure
+ -- parameter Directory.
+ Size := 0;
+
+ elsif Filter (Special_File) then
+ Found := True;
+ Kind := Special_File;
+ Size := 0;
+ end if;
+
+ if Found then
+ Search.State.Dir_Contents.Append
+ (Directory_Entry_Type'
+ [Valid => True,
+ Name =>
+ To_Unbounded_String (File_Name),
+ Full_Name => To_Unbounded_String (Path),
+ Attr_Error_Code => 0,
+ Kind => Kind,
+ Modification_Time => Modification_Time (Path),
+ Size => Size]);
+ end if;
+ end if;
+ end;
+ end if;
+ end;
+ end loop;
+
+ -- Set the first entry to be returned to the user to be the first
+ -- element of the Dir_Contents vector. If no items were found, First
+ -- will return No_Element, which signals
+ Search.State.Next_Entry := Search.State.Dir_Contents.First;
- Search.Value := new Search_Data;
+ -- Search is finished, close Directory
- -- Initialize some Search components
+ Call_Result := closedir (DIRs (Dir_Pointer));
- Search.Value.Filter := Filter;
- Search.Value.Name := To_Unbounded_String (Full_Name (Directory));
- Search.Value.Pattern := Pat;
- Search.Value.Dir := Dir;
- Search.Value.Is_Valid := True;
end Start_Search_Internal;
end Ada.Directories;
diff --git a/gcc/ada/libgnat/a-direct.ads b/gcc/ada/libgnat/a-direct.ads
index a88cd014c23..05106b3aec0 100644
--- a/gcc/ada/libgnat/a-direct.ads
+++ b/gcc/ada/libgnat/a-direct.ads
@@ -372,14 +372,17 @@ package Ada.Directories is
-- matching pattern. If Pattern is null, all items in the directory are
-- matched; otherwise, the interpretation of Pattern is implementation-
-- defined. Only items which match Filter will be returned. After a
- -- successful call on Start_Search, the object Search may have entries
- -- available, but it may have no entries available if no files or
- -- directories match Pattern and Filter. The exception Name_Error is
- -- propagated if the string given by Directory does not identify an
- -- existing directory, or if Pattern does not allow the identification of
- -- any possible external file or directory. The exception Use_Error is
- -- propagated if the external environment does not support the searching
- -- of the directory with the given name (in the absence of Name_Error).
+ -- successful call on Start_Search, the object Search will be populated
+ -- with the items of the directory that match the Pattern and Filter, if
+ -- any. Any subsequent change to the directory after the call to
+ -- Start_Search will not be reflected in the Search object.
+ --
+ -- The exception Name_Error is propagated if the string given by Directory
+ -- does not identify an existing directory, or if Pattern does not allow
+ -- the identification of any possible external file or directory. The
+ -- exception Use_Error is propagated if the external environment does not
+ -- support the searching of the directory with the given name (in the
+ -- absence of Name_Error).
procedure End_Search (Search : in out Search_Type);
-- Ends the search represented by Search. After a successful call on
@@ -397,12 +400,12 @@ package Ada.Directories is
Directory_Entry : out Directory_Entry_Type);
-- Returns the next Directory_Entry for the search described by Search that
-- matches the pattern and filter. If no further matches are available,
- -- Status_Error is raised. It is implementation-defined as to whether the
- -- results returned by this routine are altered if the contents of the
- -- directory are altered while the Search object is valid (for example, by
- -- another program). The exception Use_Error is propagated if the external
- -- environment does not support continued searching of the directory
- -- represented by Search.
+ -- Status_Error is raised. The results returned by this routine reflect the
+ -- contents of the directory at the time of the Start_Search call.
+ -- Consequently, changes to the contents of the directory, by this or
+ -- another program, will not be reflected in the Search object. The
+ -- exception Use_Error is propagated if the external environment does not
+ -- support continued searching of the directory represented by Search.
procedure Search
(Directory : String;
@@ -472,30 +475,49 @@ package Ada.Directories is
Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
private
- type Directory_Entry_Type is record
- Is_Valid : Boolean := False;
- Simple : Ada.Strings.Unbounded.Unbounded_String;
- Full : Ada.Strings.Unbounded.Unbounded_String;
- Kind : File_Kind := Ordinary_File;
+ type Search_State;
+ type Search_Ptr is access Search_State;
+ -- To simplify the setup of a new search and its subsequent teardown, the
+ -- state of Search_Type is implemented in a seperate record type that can
+ -- be allocated when a new search is started and deallocated when the
+ -- search is ended. The type is defined in the body as it is not required
+ -- by child packages.
+
+ type Search_Type is new Ada.Finalization.Controlled with record
+ State : Search_Ptr;
end record;
- -- The type Search_Data is defined in the body, so that the spec does not
- -- depend on packages of the GNAT hierarchy.
+ type Directory_Entry_Type is record
+ Valid : Boolean := False;
+ -- Indicates if the record has been populated by the Get_Next_Entry
+ -- procedure. The default initialization ensures objects created through
+ -- declarations or allocators are identified as not valid for use with
+ -- the Directory_Entry_Type routines until Get_Next_Entry is called.
- type Search_Data;
- type Search_Ptr is access Search_Data;
+ Name : Ada.Strings.Unbounded.Unbounded_String;
+ -- The name of the item in the directory
- -- Search_Type need to be a controlled type, because it includes component
- -- of type Dir_Type (in GNAT.Directory_Operations) that need to be closed
- -- (if opened) during finalization. The component need to be an access
- -- value, because Search_Data is not fully defined in the spec.
+ Full_Name : Ada.Strings.Unbounded.Unbounded_String;
+ -- The full path to the item
- type Search_Type is new Ada.Finalization.Controlled with record
- Value : Search_Ptr;
+ Attr_Error_Code : Integer;
+ -- The error code returned when querying the item's file attributes
+ -- during Start_Search. Allows Get_Next_Entry to raise an exception when
+ -- the error code is non-zero.
+
+ Kind : File_Kind;
+ -- The type of item
+
+ Modification_Time : Ada.Calendar.Time;
+ -- The modification time of the item at the time of Start_Search
+
+ Size : File_Size;
+ -- The size of an ordinary file at the time of Start_Search. For special
+ -- files and directories, Size is always zero.
end record;
procedure Finalize (Search : in out Search_Type);
- -- Close the directory, if opened, and deallocate Value
+ -- Deallocate the data structures used for the search
procedure End_Search (Search : in out Search_Type) renames Finalize;
diff --git a/gcc/ada/libgnat/s-filatt.ads b/gcc/ada/libgnat/s-filatt.ads
index 30fa83691d1..39d4e5535a2 100644
--- a/gcc/ada/libgnat/s-filatt.ads
+++ b/gcc/ada/libgnat/s-filatt.ads
@@ -46,6 +46,11 @@ package System.File_Attributes is
(N : System.Address;
A : access File_Attributes) return Integer;
+ function File_Length_Attr
+ (FD : Integer;
+ N : System.Address;
+ A : access File_Attributes) return Long_Long_Integer;
+
function Is_Regular_File_Attr
(N : System.Address;
A : access File_Attributes) return Integer;
@@ -65,6 +70,7 @@ private
pragma Import (C, Reset_Attributes, "__gnat_reset_attributes");
pragma Import (C, Error_Attributes, "__gnat_error_attributes");
pragma Import (C, File_Exists_Attr, "__gnat_file_exists_attr");
+ pragma Import (C, File_Length_Attr, "__gnat_file_length_attr");
pragma Import (C, Is_Regular_File_Attr, "__gnat_is_regular_file_attr");
pragma Import (C, Is_Directory_Attr, "__gnat_is_directory_attr");
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-01-07 16:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-07 16:29 [gcc r12-6372] [Ada] Read directory in Ada.Directories.Start_Search rather than Get_Next_Entry Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).