Browse Source

--- Merging r21466 into '.':
U rtl/objpas/sysutils/fina.inc
U rtl/objpas/sysutils/finah.inc
--- Merging r21680 into '.':
U tests/test/packages/bzip2/tbzip2streamtest.pp
--- Merging r21749 into '.':
U packages/fcl-process/src/process.pp

# revisions: 21466,21680,21749
r21466 | hajny | 2012-06-03 00:30:08 +0200 (Sun, 03 Jun 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/sysutils/fina.inc
M /trunk/rtl/objpas/sysutils/finah.inc

+ ExpandFileNameCase implementation added
r21680 | jonas | 2012-06-22 16:31:48 +0200 (Fri, 22 Jun 2012) | 2 lines
Changed paths:
M /trunk/tests/test/packages/bzip2/tbzip2streamtest.pp

* also delete temporary files if the test crashes
r21749 | marco | 2012-07-01 17:42:59 +0200 (Sun, 01 Jul 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-process/src/process.pp

* properly initialize FPipeBuffersize. Follow up to Mantis #22327

git-svn-id: branches/fixes_2_6@22356 -

marco 13 years ago
parent
commit
95804ff1f0

+ 1 - 0
packages/fcl-process/src/process.pp

@@ -249,6 +249,7 @@ begin
   {$ifdef UNIX}
   FForkEvent:=nil;
   {$endif UNIX}
+  FPipeBufferSize := 1024;
   FEnvironment:=TStringList.Create;
   FParameters:=TStringList.Create;
 end;

+ 105 - 0
rtl/objpas/sysutils/fina.inc

@@ -156,6 +156,111 @@ end;
 {$endif HASEXPANDUNCFILENAME}
 
 
+function ExpandFileNameCase (const FileName: string; out MatchFound: TFilenameCaseMatch): string;
+var
+  SR: TSearchRec;
+  ItemsFound: byte;
+  FoundPath: string;
+  RestPos: SizeUInt;
+  Root: string;
+
+  procedure TryCase (const Base, Rest: string);
+  var
+    SR: TSearchRec;
+    RC: longint;
+    NextDirPos: SizeUInt;
+    NextPart: string;
+    NextRest: string;
+    SearchBase: string;
+  begin
+    NextDirPos := 1;
+    while (NextDirPos <= Length (Rest)) and
+                       not (Rest [NextDirPos] in (AllowDirectorySeparators)) do
+     Inc (NextDirPos);
+    NextPart := Copy (Rest, 1, Pred (NextDirPos));
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+    if (Length (Rest) >= NextDirPos) and
+                           (Rest [NextDirPos] in AllowDirectorySeparators) then
+{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
+    while (Length (Rest) >= NextDirPos) and
+                             (Rest [NextDirPos] in AllowDirectorySeparators) do
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+     Inc (NextDirPos);
+    NextRest := Copy (Rest, NextDirPos, Length (Rest) - Pred (NextDirPos));
+    if (Base = '') or (Base [Length (Base)] in AllowDirectorySeparators) then
+     SearchBase := Base
+    else
+     SearchBase := Base + DirectorySeparator;
+    RC := FindFirst (SearchBase + AllFilesMask, faAnyFile, SR);
+    while (RC = 0) and (ItemsFound < 2) do
+     begin
+      if UpCase (NextPart) = UpCase (SR.Name) then
+       begin
+        if Length (NextPart) = Length (Rest) then
+         begin
+          Inc (ItemsFound);
+          if ItemsFound = 1 then
+           FoundPath := SearchBase + SR.Name;
+         end
+        else if SR.Attr and faDirectory = faDirectory then
+         TryCase (SearchBase + SR.Name + DirectorySeparator, NextRest);
+       end;
+      if ItemsFound < 2 then
+       RC := FindNext (SR);
+     end;
+    FindClose (SR);
+  end;
+
+begin
+  Result := ExpandFileName (FileName);
+  if FileName = '' then
+   MatchFound := mkExactMatch
+  else
+   if (FindFirst (FileName, faAnyFile, SR) = 0) or
+(* Special check for a root directory or a directory with a trailing slash *)
+(* which are not found using FindFirst. *)
+                                                DirectoryExists (FileName) then
+    begin
+     MatchFound := mkExactMatch;
+     Result := ExtractFilePath (Result) + SR.Name;
+     FindClose (SR);
+    end
+   else
+    begin
+(* Better close the search handle here before starting the recursive search *)
+     FindClose (SR);
+     MatchFound := mkNone;
+     if FileNameCaseSensitive then
+      begin
+       ItemsFound := 0;
+       FoundPath := '';
+       RestPos := Length (ExtractFileDrive (FileName)) + 1;
+       if (Length (FileName) > RestPos) then
+        begin
+{$IFDEF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+         if (Length (FileName) >= RestPos) and
+                (FileName [RestPos] in AllowDirectorySeparators) then
+{$ELSE FPC_FEXPAND_DIRSEP_IS_UPDIR}
+         while (Length (FileName) >= RestPos) and
+                  (FileName [RestPos] in AllowDirectorySeparators) do
+{$ENDIF FPC_FEXPAND_DIRSEP_IS_UPDIR}
+          Inc (RestPos);
+         Root := Copy (FileName, 1, Pred (RestPos));
+         TryCase (Root, Copy (FileName, RestPos, Length (FileName) - Length (Root)));
+         if ItemsFound > 0 then
+          begin
+           Result := ExpandFileName (FoundPath);
+           if ItemsFound = 1 then
+            MatchFound := mkSingleMatch
+           else
+            MatchFound := mkAmbiguous;
+          end;
+        end;
+      end;
+    end;
+end;
+
+
 Const
   MaxDirs = 129;
 

+ 4 - 0
rtl/objpas/sysutils/finah.inc

@@ -20,6 +20,9 @@
     System Utilities For Free Pascal
 }
 
+type
+  TFilenameCaseMatch = (mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous);
+
 function ChangeFileExt(const FileName, Extension: string): string;
 function ExtractFilePath(const FileName: string): string;
 function ExtractFileDrive(const FileName: string): string;
@@ -28,6 +31,7 @@ function ExtractFileExt(const FileName: string): string;
 function ExtractFileDir(Const FileName : string): string;
 function ExtractShortPathName(Const FileName : String) : String;
 function ExpandFileName (Const FileName : string): String;
+function ExpandFileNameCase (const FileName: string; out MatchFound: TFilenameCaseMatch): string;
 function ExpandUNCFileName (Const FileName : string): String;
 function ExtractRelativepath (Const BaseName,DestNAme : String): String;
 function IncludeTrailingPathDelimiter(Const Path : String) : String;

+ 44 - 41
tests/test/packages/bzip2/tbzip2streamtest.pp

@@ -70,53 +70,56 @@ begin
   UncompressedFile:=SysUtils.GetTempFileName(EmptyStr, 'UNC');
   CompressedFile:=SysUtils.GetTempFileName(EmptyStr, 'BZ2');
 
-  // Set up test bz2 file
-  // create a resource stream which points to our resource
-  ExampleFileResourceStream := TResourceStream.Create(HInstance, 'ALL', 'RT_RCDATA');
   try
-    ExampleFileStream := TFileStream.Create(CompressedFile, fmCreate);
+    // Set up test bz2 file
+    // create a resource stream which points to our resource
+    ExampleFileResourceStream := TResourceStream.Create(HInstance, 'ALL', 'RT_RCDATA');
     try
-      ExampleFileStream.CopyFrom(ExampleFileResourceStream, ExampleFileResourceStream.Size);
+      ExampleFileStream := TFileStream.Create(CompressedFile, fmCreate);
+      try
+        ExampleFileStream.CopyFrom(ExampleFileResourceStream, ExampleFileResourceStream.Size);
+      finally
+        ExampleFileStream.Free;
+      end;
     finally
-      ExampleFileStream.Free;
+      ExampleFileResourceStream.Free;
     end;
-  finally
-    ExampleFileResourceStream.Free;
-  end;
 
-  // Actual decompression
-  if decompress(CompressedFile, UncompressedFile) then
-  begin
-    // Now check if contents match.
-  UncompressedHash:=MD5Print(MD5File(UncompressedFile, MDDefBufSize));
-	if UncompressedHash=ExpectedHash then
-	begin
-    code:=0; //success
-	end
-	else
-	begin
-    writeln('MD5 hash comparison between original file and uncompressed file failed');
-    writeln('Got hash:'+UncompressedHash);
-    writeln('Expected:'+ExpectedHash);
-	  code:=2;
-	end;
-  end
-  else
-  begin
-    writeln('bunzip2 decompression failure');
-    code:=1;
-  end;
+    // Actual decompression
+    if decompress(CompressedFile, UncompressedFile) then
+    begin
+      // Now check if contents match.
+      UncompressedHash:=MD5Print(MD5File(UncompressedFile, MDDefBufSize));
+      if UncompressedHash=ExpectedHash then
+      begin
+        code:=0; //success
+      end
+      else
+      begin
+        writeln('MD5 hash comparison between original file and uncompressed file failed');
+        writeln('Got hash:'+UncompressedHash);
+        writeln('Expected:'+ExpectedHash);
+        code:=2;
+      end;
+    end
+    else
+    begin
+      writeln('bunzip2 decompression failure');
+      code:=1;
+    end;
   
-  try
-    if CompressedFile<>EmptyStr then DeleteFile(CompressedFile);
-    if UncompressedFile<>EmptyStr then DeleteFile(UncompressedFile);
-  finally
-    // Ignore errors; operating system should clean out temp files
-  end; 
   
-  if code = 0 then
-    writeln('Basic bzip2 tests passed')
-  else
-    writeln('Basic bzip2 test failed: ', code);
+    if code = 0 then
+      writeln('Basic bzip2 tests passed')
+    else
+      writeln('Basic bzip2 test failed: ', code);
+  finally
+    try
+      if CompressedFile<>EmptyStr then DeleteFile(CompressedFile);
+      if UncompressedFile<>EmptyStr then DeleteFile(UncompressedFile);
+    finally
+      // Ignore errors; operating system should clean out temp files
+    end; 
+  end;
   Halt(code);
 end.