[Ada] Read directory in Ada.Directories.Start_Search rather than Get_Next_Entry
authorPatrick Bernardi <bernardi@adacore.com>
Wed, 22 Dec 2021 21:32:41 +0000 (16:32 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Fri, 7 Jan 2022 16:24:15 +0000 (16:24 +0000)
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.

gcc/ada/libgnat/a-direct.adb
gcc/ada/libgnat/a-direct.ads
gcc/ada/libgnat/s-filatt.ads

index 41dca3c..b8db8dc 100644 (file)
 
 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;
index a88cd01..05106b3 100644 (file)
@@ -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;
 
index 30fa836..39d4e55 100644 (file)
@@ -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");