* TDirectory.GetDirectories should actually only return directories. Patch by Artem Izmaylov. Fixes issue #41137

packages/vcl-compat/src/system.ioutils.pp

@@ -76,11 +76,10 @@ type
 
 type
   TDirectory = class
-
   protected
-    class function GetFilesAndDirectories(const aPath, aSearchPattern: string;const aSearchOption: TSearchOption; const SearchAttributes: TFileAttributes; const aPredicate: TFilterPredicateLocal): TStringDynArray;  overload; static;
-    class function GetFilesAndDirectories(const aPath, aSearchPattern: string;const aSearchOption: TSearchOption; const SearchAttributes: TFileAttributes; const aPredicate: TFilterPredicateObject): TStringDynArray;  overload; static;
-    class function GetFilesAndDirectories(const aPath, aSearchPattern: string;const aSearchOption: TSearchOption; const SearchAttributes: TFileAttributes; const aPredicate: TFilterPredicate): TStringDynArray;  overload; static;
+    class function GetFilesAndDirectories(const aPath, aSearchPattern: string;
+      const aSearchOption: TSearchOption; const SearchAttributes: TFileAttributes;
+      const aPredicate: TFilterPredicateLocal): TStringDynArray;  static;
   public
     class procedure Copy(const SourceDirName, DestDirName: string); static;
     class procedure CreateDirectory(const aPath: string); static;
@@ -2205,32 +2204,6 @@ begin
   {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.FindClose(SearchRec);
 end;
 
-class function TDirectory.GetFilesAndDirectories(const aPath,
-  aSearchPattern: string; const aSearchOption: TSearchOption;
-  const SearchAttributes: TFileAttributes;
-  const aPredicate: TFilterPredicateObject): TStringDynArray;
-
-  function DoFilterPredicate(const aPath: string; const SearchRec: TSearchRec): Boolean;
-  begin
-    Result:=aPredicate(aPath, SearchRec);
-  end;
-
-begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption, SearchAttributes,@DoFilterPredicate);
-end;
-
-class function TDirectory.GetFilesAndDirectories(const aPath,
-  aSearchPattern: string; const aSearchOption: TSearchOption;
-const SearchAttributes: TFileAttributes; const aPredicate: TFilterPredicate
-  ): TStringDynArray;
-  function DoFilterPredicate(const aPath: string; const SearchRec: TSearchRec): Boolean;
-  begin
-    Result:=aPredicate(aPath, SearchRec);
-  end;
-begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption, SearchAttributes, @DoFilterPredicate);
-end;
-
 class procedure TDirectory.Copy(const SourceDirName, DestDirName: string);
 begin
   CopyFile(SourceDirName, DestDirName,[],True);
@@ -2394,21 +2367,38 @@ class function TDirectory.GetDirectories(const aPath, aSearchPattern: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicateLocal
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption, [TFileAttribute.faDirectory], aPredicate);
+  Result:=GetFilesAndDirectories(aPath, aSearchPattern,
+    aSearchOption, TFile.IntegerToFileAttributes(faAnyFile),
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result :=
+        (SearchRec.Attr and {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.faDirectory <> 0) and
+        (SearchRec.Name <> '.') and (SearchRec.Name <> '..');
+      if Result and Assigned(aPredicate) then
+        Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetDirectories(const aPath, aSearchPattern: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicateObject
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption, [TFileAttribute.faDirectory], aPredicate);
+  Result:=GetDirectories(aPath, aSearchPattern, aSearchOption,
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetDirectories(const aPath, aSearchPattern: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicate
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption, [TFileAttribute.faDirectory], aPredicate);
+  Result:=GetDirectories(aPath, aSearchPattern, aSearchOption,
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetDirectories(const aPath: string;
@@ -2490,22 +2480,35 @@ class function TDirectory.GetFiles(const aPath, aSearchPattern: string;
   ): TStringDynArray;
 begin
   Result:=GetFilesAndDirectories(aPath, aSearchPattern, aSearchOption,
-                                   TFile.IntegerToFileAttributes(faAnyFile) - [TFileAttribute.faDirectory],
-                                   aPredicate);
+    TFile.IntegerToFileAttributes(faAnyFile) - [TFileAttribute.faDirectory],
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := SearchRec.Attr and {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}SysUtils.faDirectory = 0;
+      if Result and Assigned(aPredicate) then
+        Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFiles(const aPath, aSearchPattern: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicateObject
   ): TStringDynArray;
 begin
-  Result:=GetFiles(aPath, aSearchPattern, aSearchOption, aPredicate);
+  Result:=GetFiles(aPath, aSearchPattern, aSearchOption,
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFiles(const aPath, aSearchPattern: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicate
   ): TStringDynArray;
 begin
-  Result:=GetFiles(aPath, aSearchPattern, aSearchOption, aPredicate);
+  Result:=GetFiles(aPath, aSearchPattern, aSearchOption,
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFiles(const aPath: string;
@@ -2571,13 +2574,23 @@ class function TDirectory.GetFileSystemEntries(const aPath,
   aSearchPattern: string; const aPredicate: TFilterPredicateObject
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern, TSearchOption.soTopDirectoryOnly, TFile.IntegerToFileAttributes(faAnyFile), aPredicate);
+  Result:=GetFilesAndDirectories(aPath, aSearchPattern,
+    TSearchOption.soTopDirectoryOnly, TFile.IntegerToFileAttributes(faAnyFile),
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFileSystemEntries(const aPath,
   aSearchPattern: string; const aPredicate: TFilterPredicate): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, aSearchPattern,  TSearchOption.soTopDirectoryOnly, TFile.IntegerToFileAttributes(faAnyFile), aPredicate);
+  Result:=GetFilesAndDirectories(aPath, aSearchPattern,
+    TSearchOption.soTopDirectoryOnly, TFile.IntegerToFileAttributes(faAnyFile),
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFileSystemEntries(const aPath: string;
@@ -2591,14 +2604,22 @@ class function TDirectory.GetFileSystemEntries(const aPath: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicateObject
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, '*', aSearchOption, TFile.IntegerToFileAttributes(faAnyFile),aPredicate);
+  Result:=GetFilesAndDirectories(aPath, '*', aSearchOption, TFile.IntegerToFileAttributes(faAnyFile),
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class function TDirectory.GetFileSystemEntries(const aPath: string;
   const aSearchOption: TSearchOption; const aPredicate: TFilterPredicate
   ): TStringDynArray;
 begin
-  Result:=GetFilesAndDirectories(aPath, '*', aSearchOption, TFile.IntegerToFileAttributes(faAnyFile),aPredicate);
+  Result:=GetFilesAndDirectories(aPath, '*', aSearchOption, TFile.IntegerToFileAttributes(faAnyFile),
+    function(const aPath: string; const SearchRec: TSearchRec): Boolean
+    begin
+      Result := aPredicate(aPath, SearchRec);
+    end);
 end;
 
 class procedure TDirectory.ForAllEntries(const aPath, aPattern: string; const aBefore, aAfter: TFilterPredicateLocal; aRecursive: Boolean);

packages/vcl-compat/tests/tciotuils.pas

@@ -5,18 +5,21 @@ unit tciotuils;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, system.ioutils;
+  Types, Classes, SysUtils, fpcunit, testregistry, system.ioutils;
 
 type
 
   { TTestTPath }
 
+  { TTestIO }
+
   TTestIO = class(TTestCase)
   Private
     FCWD : String;
     FBaseDir : String;
   protected
     Procedure CreateTestDirs;
+    procedure CreateTestFiles(aCount: Integer=3; InTestPath: Boolean=True);
     Procedure CleanDirs(aDir : String);
     procedure SetUp; override;
     procedure TearDown; override;
@@ -84,6 +87,16 @@ type
     Procedure TestVolumeSeparatorChar;
   end;
 
+  { TTestTDirectory }
+
+  TTestTDirectory = Class(TTestIO)
+  Published
+    Procedure TestGetDirectories;
+  end;
+
+
+
+
 implementation
 
 
@@ -412,6 +425,7 @@ procedure TTestTPath.TestCombineMulti;
     I : Integer;
 
   begin
+    P:=[];
     FailMsg:='';
     try
       SetLength(P,Length(Paths));
@@ -432,8 +446,6 @@ procedure TTestTPath.TestCombineMulti;
       Fail(FailMsg);
   end;
 
-  var
-    S: String;
 
 begin
   //EInOutError
@@ -577,7 +589,7 @@ Const
 Var
   CA : TCharArray;
   C : Char;
-  I,P : Integer;
+  P : Integer;
 
 begin
   CA:=TPath.GetInvalidFileNameChars;
@@ -608,7 +620,7 @@ Const
 Var
   CA : TCharArray;
   C : Char;
-  I,P : Integer;
+  P : Integer;
 
 begin
   CA:=TPath.GetInvalidPathChars;
@@ -1217,6 +1229,33 @@ begin
 {$endif}
 end;
 
+{ TTestTDirectory }
+
+procedure TTestTDirectory.TestGetDirectories;
+
+var
+  Dirs : TStringDynArray;
+
+  Function Find(D : String) : Integer;
+
+  begin
+    Result:=Length(Dirs)-1;
+    While (Result>=0) and (ExtractFileName(Dirs[Result])<>D) do
+      Dec(Result);
+  end;
+
+
+begin
+  CreateTestFiles(1,True);
+  Dirs:=TDirectory.GetDirectories(FBaseDir+'testpath/');
+  AssertEquals('Count',3,Length(dirs));
+  AssertTrue('Dir 1',Find('dir1')<>-1);
+  AssertTrue('Dir 2',Find('dir2')<>-1);
+  AssertTrue('Dir 2',Find('dir3')<>-1);
+end;
+
+{ TTestIO }
+
 procedure TTestIO.CreateTestDirs;
 
   procedure DoCreateDir(const aDir : string);
@@ -1233,6 +1272,36 @@ begin
   DoCreateDir('testpath/dir3');
 end;
 
+procedure TTestIO.CreateTestFiles(aCount : Integer = 3; InTestPath : Boolean = True);
+
+  procedure DoCreateFile(const aName : string);
+  var
+    FN : String;
+    FD : THandle;
+
+  begin
+    FN:=IncludeTrailingPathDelimiter(FBaseDir);
+    if InTestPath then
+      FN:=IncludeTrailingPathDelimiter(FN+'testpath');
+    FN:=FN+aName;
+    if not FileExists(FN) then
+      begin
+      FD:=FileCreate(FN);
+      FileWrite(FD,FN[1],Length(FN));
+      FileClose(FD);
+      end;
+  end;
+
+var
+  I : integer;
+
+begin
+  if InTestPath then
+    CreateTestDirs;
+  For I:=1 to aCount do
+    DoCreateFile(Format('testfile%d.txt',[I]));
+end;
+
 procedure TTestIO.CleanDirs(aDir: String);
 
 Var
@@ -1247,14 +1316,16 @@ begin
         lFull:=lDir+Info.Name;
         if Info.IsDirectory then
           begin
-          if not Info.IsCurrentOrParentDir then
+          if not (Info.IsCurrentOrParentDir) then
+            begin
             CleanDirs(lFull);
-          if not RemoveDir(lFull) then
-            Fail('Failed to remove directory %s',[lFull])
+            if not RemoveDir(lFull) then
+              Fail('Failed to remove directory %s',[lFull])
+            end;
           end
-        else if not DeleteFIle(lFull) then
+        else if not DeleteFile(lFull) then
           Fail('Failed to remove file %s',[lFull])
-      until FIndNext(Info)>0;
+      until FindNext(Info)<>0;
     finally
       FindClose(Info);
     end;
@@ -1274,6 +1345,6 @@ end;
 
 initialization
 
-  RegisterTest(TTestTPath);
+  RegisterTests([TTestTPath,TTestTDirectory]);
 end.
 

packages/vcl-compat/tests/testcompat.lpi

@@ -96,6 +96,11 @@
       <OtherUnitFiles Value="../src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions>