paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 16:09:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ test for ExpandFileNameCase added

Browse Source 
git-svn-id: trunk@21468 -
This commit is contained in:
Tomas Hajny 2012-06-02 22:37:30 +00:00
parent 99a9955195
commit 6c6d2489d1
2 changed files with 192 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11407,6 +11407,7 @@ tests/test/units/sysutils/tencodingerrors.pp svneol=native#text/pascal
tests/test/units/sysutils/tencodingtest.pp svneol=native#text/pascal
tests/test/units/sysutils/texec1.pp svneol=native#text/plain
tests/test/units/sysutils/texec2.pp svneol=native#text/plain
tests/test/units/sysutils/texpfncase.pp svneol=native#text/plain
tests/test/units/sysutils/textractquote.pp svneol=native#text/plain
tests/test/units/sysutils/tfile1.pp svneol=native#text/plain
tests/test/units/sysutils/tfile2.pp svneol=native#text/plain

191
tests/test/units/sysutils/texpfncase.pp Normal file
View File

@ -0,0 +1,191 @@
program texpfncase;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF FPC}
{$H+}
{$APPTYPE CONSOLE}
{$IFDEF FPC}
{$DEFINE FPCTEST}
{$ENDIF FPC}
{$I+}
uses
SysUtils
{$IFNDEF FPC}
, StrUtils
{$ENDIF FPC}
;
const
TestFilesNumber = 3;
{$IFDEF UNIX}
MinPathLength = 1;
{$ELSE UNIX}
MinPathLength = 3;
{$ENDIF UNIX}
{$ifndef FPC}
DirectorySeparator = PathDelim;
AllowDirectorySeparators: set of char = [PathDelim];
{$endif}
type
TTestFiles = array [1..TestFilesNumber] of shortstring;
const
TestFiles: TTestFiles = ('testFile1.tst', 'testFile2.tst', 'TestFile2.tst');
{$IFNDEF FPC}
const
FilenameCaseMatchStr: array [mkNone..mkAmbiguous] of shortstring =
('mkNone', 'mkExactMatch', 'mkSingleMatch', 'mkAmbiguous');
{$ENDIF FPC}
var
Failed: byte;
procedure TestExpFNC (const FN1, ExpReturn: string; ExpMatch: TFilenameCaseMatch);
var
FN2: string;
Match: TFilenameCaseMatch;
begin
FN2 := ExpandFileNameCase (FN1, Match);
if (ExpReturn <> '') and (FN2 <> ExpReturn) or (Match <> ExpMatch) then
begin
Inc (Failed);
WriteLn ('Error: Input = ', FN1, ', Output = ', FN2, ' (expected ', ExpReturn, '), MatchFound = ',
{$IFNDEF FPC}
FileNameCaseMatchStr [
{$ENDIF FPC}
Match
{$IFNDEF FPC}
]
{$ENDIF FPC}
, ' (expected ',
{$IFNDEF FPC}
FileNameCaseMatchStr [
{$ENDIF FPC}
ExpMatch
{$IFNDEF FPC}
]
{$ENDIF FPC}
, ')');
end
{$IFDEF DEBUG}
else
WriteLn ('Input = ', FN1, ', Output = ', FN2, ', MatchFound = ',
{$IFNDEF FPC}
FileNameCaseMatchStr [
{$ENDIF FPC}
Match
{$IFNDEF FPC}
]
{$ENDIF FPC}
)
{$ENDIF DEBUG}
;
end;
var
I: byte;
TempDir, TestDir: string;
CurDir: string;
begin
{$IFNDEF FPC}
TempDir := ExpandFilename (GetEnvironmentVariable ('TEMP'));
{$ELSE FPC}
TempDir := ExpandFilename (GetTempDir);
{$ENDIF FPC}
if (Length (TempDir) > MinPathLength) and
(TempDir [Length (TempDir)] in AllowDirectorySeparators) then
TempDir := LeftStr (TempDir, Length (TempDir) - 1);
CurDir := GetCurrentDir;
{$IFDEF DEBUG}
{$IFDEF FPC}
WriteLn ('FileNameCaseSensitive = ', FileNameCaseSensitive);
{$ENDIF FPC}
WriteLn ('TempDir = ', TempDir);
WriteLn ('SetCurrentDir result = ', SetCurrentDir (TempDir));
WriteLn ('Current directory = ', GetCurrentDir);
{$ELSE DEBUG}
SetCurrentDir (TempDir);
{$ENDIF DEBUG}
for I := 1 to TestFilesNumber do
FileClose (FileCreate (TestFiles [I]));
TestExpFNC ('*File1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
if FileNameCaseSensitive then
TestExpFNC ('TestFile1.tst', ExpandFileName ('testFile1.tst'), mkSingleMatch)
else
TestExpFNC ('TestFile1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
TestExpFNC ('testFile1.tst', ExpandFileName ('testFile1.tst'), mkExactMatch);
TestExpFNC ('testFile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
if FileNameCaseSensitive then
TestExpFNC ('TestFile2.tst', ExpandFileName ('TestFile2.tst'), mkExactMatch)
else
TestExpFNC ('TestFile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
if FileNameCaseSensitive then
TestExpFNC ('testfile2.tst', ExpandFileName ('testFile2.tst'), mkAmbiguous)
else
TestExpFNC ('testfile2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
if FileNameCaseSensitive then
TestExpFNC ('*File2.tst', ExpandFileName ('TestFile2.tst'), mkExactMatch)
else
TestExpFNC ('*File2.tst', ExpandFileName ('testFile2.tst'), mkExactMatch);
(* Return value depends on ordering of files in the particular filesystem used thus not checked *)
if FileNameCaseSensitive then
TestExpFNC ('*File*.tst', '', mkExactMatch)
else
TestExpFNC ('*File*.tst', '', mkExactMatch);
TestExpFNC ('..' + DirectorySeparator + '*' + DirectorySeparator + '*File*.tst',
ExpandFileName ('..' + DirectorySeparator + '*' + DirectorySeparator + '*File*.tst'),
mkNone);
I := Length (TempDir);
TestDir := TempDir;
while (I > 1) and not (TempDir [I] in ['a'..'z','A'..'Z']) do
Dec (I);
if I > 0 then
begin
if TestDir [I] in ['a'..'z'] then
TestDir [I] := char (Ord (TestDir [I]) and not $20)
else
TestDir [I] := char (Ord (TestDir [I]) or $20);
end
else
WriteLn ('Warning: Cannot perform all required tests; please set TEMP!');
if FileNameCaseSensitive then
TestExpFNC (TestDir + DirectorySeparator + 'testFile1.tst',
ExpandFileName (TempDir + DirectorySeparator + 'testFile1.tst'), mkSingleMatch)
else
TestExpFNC (TestDir + DirectorySeparator + 'testFile1.tst',
ExpandFileName (TestDir + DirectorySeparator + 'testFile1.tst'), mkExactMatch);
if FileNameCaseSensitive then
TestExpFNC (TestDir + DirectorySeparator + 'testfile1.tst',
ExpandFileName (TempDir + DirectorySeparator + 'testFile1.tst'), mkSingleMatch)
else
TestExpFNC (TestDir + DirectorySeparator + 'testfile1.tst',
ExpandFileName (TestDir + DirectorySeparator + 'testFile1.tst'), mkExactMatch);
for I := 1 to TestFilesNumber do
if not (DeleteFile (TestFiles [I])) then
begin
if FileNameCaseSensitive or (I <> 3) then
WriteLn ('Warning: Deletion of ', TestFiles [I], ' (file #', I, ') failed - possibly due to case insensitive file system!');
end;
SetCurrentDir (CurDir);
if Failed > 0 then
begin
WriteLn (Failed, ' failures!!');
Halt (Failed);
end;
end.