123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350 |
- unit tciotuils;
- {$mode objfpc}{$H+}
- interface
- uses
- 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;
- Property CWD : String Read FCWD;
- Property BaseDir : String Read FBaseDir;
- end;
- TTestTPath = Class(TTestIO)
- Published
- Procedure TestIsValidPathChar;
- Procedure TestIsValidFileNameChar;
- Procedure TestHasValidPathChars;
- Procedure TestHasValidFileNameChars;
- Procedure TestGetExtendedPrefix;
- Procedure TestIsDriveRooted;
- Procedure TestIsExtendedPrefixed;
- Procedure TestIsRelativePath;
- Procedure TestIsUNCPath;
- Procedure TestIsUNCRooted;
- Procedure TestGetGUIDFileName;
- Procedure TestDriveExists;
- Procedure TestMatchesPattern;
- Procedure TestChangeExtension;
- Procedure TestCombine;
- Procedure TestCombineMulti;
- Procedure TestGetDirectoryName;
- Procedure TestGetExtension;
- Procedure TestGetFileName;
- Procedure TestGetFileNameWithoutExtension;
- Procedure TestGetFullPath;
- Procedure TestGetInvalidFileNameChars;
- Procedure TestGetInvalidPathChars;
- Procedure TestGetPathRoot;
- Procedure TestGetRandomFileName;
- Procedure TestGetTempFileName;
- Procedure TestGetTempPath;
- Procedure TestGetHomePath;
- Procedure TestGetDocumentsPath;
- Procedure TestGetSharedDocumentsPath;
- Procedure TestGetLibraryPath;
- Procedure TestGetCachePath;
- Procedure TestGetPublicPath;
- Procedure TestGetPicturesPath;
- Procedure TestGetSharedPicturesPath;
- Procedure TestGetCameraPath;
- Procedure TestGetSharedCameraPath;
- Procedure TestGetMusicPath;
- Procedure TestGetSharedMusicPath;
- Procedure TestGetMoviesPath;
- Procedure TestGetSharedMoviesPath;
- Procedure TestGetAlarmsPath;
- Procedure TestGetSharedAlarmsPath;
- Procedure TestGetDownloadsPath;
- Procedure TestGetSharedDownloadsPath;
- Procedure TestGetRingtonesPath;
- Procedure TestGetSharedRingtonesPath;
- Procedure TestGetTemplatesPath;
- Procedure TestGetSetAttributes;
- Procedure TestHasExtension;
- Procedure TestIsPathRooted;
- Procedure TestExtensionSeparatorChar;
- Procedure TestAltDirectorySeparatorChar;
- Procedure TestDirectorySeparatorChar;
- Procedure TestPathSeparator;
- Procedure TestVolumeSeparatorChar;
- end;
- { TTestTDirectory }
- TTestTDirectory = Class(TTestIO)
- Published
- Procedure TestGetDirectories;
- end;
- implementation
- procedure TTestTPath.TestIsValidPathChar;
- Var
- C : AnsiChar;
- begin
- For C:=#0 to #31 do
- AssertFalse('Char #'+intToStr(Ord(C)),TPath.IsValidPathChar(C));
- {$IFNDEF UNIX}
- AssertFalse('Char "',TPath.IsValidPathChar('"'));
- AssertFalse('Char <',TPath.IsValidPathChar('<'));
- AssertFalse('Char >',TPath.IsValidPathChar('>'));
- AssertFalse('Char |',TPath.IsValidPathChar('|'));
- {$ENDIF}
- end;
- procedure TTestTPath.TestIsValidFileNameChar;
- Var
- C : AnsiChar;
- begin
- For C:=#0 to #31 do
- AssertFalse('Char #'+intToStr(Ord(C)),TPath.IsValidPathChar(C));
- {$IFNDEF UNIX}
- {$IFDEF WINDOWS}
- AssertFalse('Char /',TPath.IsValidFileNameChar('/'));
- AssertFalse('Char *',TPath.IsValidFileNameChar('*'));
- AssertFalse('Char :',TPath.IsValidFileNameChar(':'));
- AssertFalse('Char >',TPath.IsValidFileNameChar('>'));
- AssertFalse('Char <',TPath.IsValidFileNameChar('<'));
- AssertFalse('Char ?',TPath.IsValidFileNameChar('?'));
- AssertFalse('Char \',TPath.IsValidFileNameChar('\'));
- AssertFalse('Char |',TPath.IsValidFileNameChar('|'));
- {$ENDIF}
- {$ELSE}
- AssertFalse('Char /',TPath.IsValidFileNameChar('/'));
- AssertFalse('Char ~',TPath.IsValidFileNameChar('~'));
- {$ENDIF}
- end;
- procedure TTestTPath.TestHasValidPathChars;
- procedure testok(s: string);
- begin
- AssertTrue(S+' is OK',TPath.HasValidPathChars(S,False))
- end;
- procedure testnok(s: string);
- begin
- AssertFalse(S+' is NOK',TPath.HasValidPathChars(S,False))
- end;
- var
- C : Char;
- begin
- TestOK('abcde12');
- TestOK('abcde/12');
- TestNOK(#10'abcde12');
- For C:=#0 to #31 do
- TestNOK(C+'abcde12');
- end;
- procedure TTestTPath.TestHasValidFileNameChars;
- procedure testok(s: string);
- begin
- AssertTrue(S+' is OK',TPath.HasValidFIleNameChars(S,False))
- end;
- procedure testnok(s: string);
- begin
- AssertFalse(S+' is NOK',TPath.HasValidFileNameChars(S,False))
- end;
- var
- C : Char;
- begin
- TestOK('abcde12');
- TestNOK('abcde/12');
- TestNOK(#10'abcde12');
- For C:=#0 to #31 do
- TestNOK(C+'abcde12');
- end;
- procedure TTestTPath.TestGetExtendedPrefix;
- Procedure TestIt(aExpected : TPathPrefixType; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- {$IFNDEF WINDOWS}
- aExpected:=TPathPrefixType.pptNoPrefix;
- {$ENDIF}
- AssertTrue(aPath+' -> '+S,aExpected=TPath.GetExtendedPrefix(aPath));
- end;
- begin
- TestIt(TPathPrefixType.pptNoPrefix,'/a/b/c.txt');
- TestIt(TPathPrefixType.pptExtended,'//?/a/b/c.txt');
- TestIt(TPathPrefixType.pptExtendedUNC,'//?/UNC/a/b/c.txt');
- end;
- procedure TTestTPath.TestIsDriveRooted;
- Procedure TestIt(aExpected : Boolean; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- {$IFNDEF WINDOWS}
- aExpected:=False;
- {$ENDIF}
- AssertTrue(aPath+' -> '+S,aExpected=TPath.IsDriveRooted(aPath));
- end;
- begin
- TestIt(True,'c:/me/you.txt');
- TestIt(True,'A:/me/you.txt');
- TestIt(False,'1:/me/you.txt');
- TestIt(False,'/me/you.txt');
- end;
- procedure TTestTPath.TestIsExtendedPrefixed;
- Procedure TestIt(aExpected : Boolean; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- {$IFNDEF WINDOWS}
- aExpected:=False;
- {$ENDIF}
- AssertTrue(aPath+' -> '+S,aExpected=TPath.IsExtendedPrefixed(aPath));
- end;
- begin
- TestIt(False,'/a/b/c.txt');
- TestIt(True,'//?/a/b/c.txt');
- TestIt(True,'//?/UNC/a/b/c.txt');
- end;
- procedure TTestTPath.TestIsRelativePath;
- Procedure TestIt(aExpected : Boolean; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- AssertTrue(aPath+' -> '+S,aExpected=TPath.IsRelativePath(aPath));
- end;
- begin
- TestIt(False,'/a/b/c.txt');
- TestIt(True,'a/b/c.txt');
- TestIt(True,'../a/b/c.txt');
- TestIt(True,'./a/b/c.txt');
- end;
- procedure TTestTPath.TestIsUNCPath;
- Procedure TestIt(aExpected : Boolean; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- {$IFNDEF WINDOWS}
- aExpected:=False;
- {$ENDIF}
- AssertTrue(aPath+' -> '+S,aExpected=TPath.IsUNCPath(aPath));
- end;
- begin
- TestIt(False,'/a/b/c.txt');
- TestIt(False,'a/b/c.txt');
- TestIt(True,'//a/b/c.txt');
- TestIt(True,'//?/a/b/c.txt');
- TestIt(True,'//?/UNC/a/b/c.txt');
- end;
- procedure TTestTPath.TestIsUNCRooted;
- Procedure TestIt(aExpected : Boolean; aPath : String);
- Var
- S : String;
- begin
- DoDirSeparators(aPath);
- Str(aExpected,S);
- {$IFNDEF WINDOWS}
- aExpected:=False;
- {$ENDIF}
- AssertTrue(aPath+' -> '+S,aExpected=TPath.IsUNCRooted(aPath));
- end;
- begin
- TestIt(False,'//a/b/c.txt');
- TestIt(False,'/a/b/c.txt');
- TestIt(False,'//a/');
- TestIt(True,'//?/a/b/c.txt');
- TestIt(True,'//?/UNC/a/b/c.txt');
- end;
- procedure TTestTPath.TestGetGUIDFileName;
- var
- G : TGUID;
- S : String;
- begin
- S:=TPath.GetGUIDFileName(True);
- S:='{'+S+'}';
- AssertTrue('Correct GUID1',TryStringToGUID(S,G));
- S:=TPath.GetGUIDFileName(False);
- //['{AC1AF8B9-C050-4D5E-86FD-199A72E93313}']
- System.Insert('-',S,21);
- Insert('-',S,17);
- Insert('-',S,13);
- Insert('-',S,9);
- S:='{'+S+'}';
- AssertTrue('Correct GUID2',TryStringToGUID(S,G));
- end;
- procedure TTestTPath.TestDriveExists;
- Var
- C : String;
- begin
- {$IFDEF WINDOWS}
- C:=GetEnvironmentVariable('SYSTEMDRIVE');
- AssertTrue('Systemdrive',TPath.DriveExists(C));
- C:=GetEnvironmentVariable('SYSTEMROOT');
- AssertTrue('Systemroot',TPath.DriveExists(C));
- {$ELSE}
- C:='/tmp';
- AssertFalse('Unix',TPath.DriveExists(C));
- {$ENDIF}
- end;
- procedure TTestTPath.TestMatchesPattern;
- Procedure TestIt(aResult : Boolean; const aFileName,aPattern : string);
- begin
- AssertEquals(aFIleName+' matches '+aPattern,aResult,TPath.MatchesPattern(aFileName,aPattern,True));
- end;
- begin
- TestIt(True,'a.txt','?.txt');
- TestIt(False,'ab','?');
- TestIt(True,'ab','*');
- TestIt(True,'abc','*c*');
- end;
- procedure TTestTPath.TestChangeExtension;
- begin
- AssertEquals('1','a.txt',TPath.ChangeExtension('a.doc','.txt'));
- AssertEquals('2','a',TPath.ChangeExtension('a.doc',''));
- end;
- procedure TTestTPath.TestCombine;
- Procedure TestIt(aResult,aPath,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aPath);
- DoDirSeparators(aFile);
- AssertEquals(aPath+'+'+aFile,aResult,TPath.Combine(aPath,aFile));
- end;
- begin
- TestIt('a.txt','','a.txt');
- TestIt('/path','/path','');
- TestIt('/path/','/path/','');
- TestIt('/path/a.doc','/path','a.doc');
- TestIt('/path/a.doc','/path/','a.doc');
- end;
- procedure TTestTPath.TestCombineMulti;
- procedure DoTest(const Paths: array of String; Validate: Boolean; Expected: string; ExceptionExpected: Boolean=False);
- function ArgsToStr: string;
- var
- i: Integer;
- begin
- Result := '';
- for i := Low(Paths) to High(Paths) do
- Result := Result+''''+Paths[i] + ''',';
- if (Result <> '') then SetLength(Result, Length(Result)-1);
- Result := '['+Result+']';
- end;
- var
- Res,FailMsg: String;
- P : Array of string;
- I : Integer;
- begin
- P:=[];
- FailMsg:='';
- try
- SetLength(P,Length(Paths));
- for I:=0 to Length(Paths)-1 do
- begin
- P[i]:=Paths[i];
- DoDirSeparators(P[i]);
- end;
- DoDirSeparators(Expected);
- Res := TPath.Combine(P,Validate);
- AssertEquals(ArgsToStr,Expected,Res)
- except
- on E: Exception do
- if not ExceptionExpected then
- FailMsg:=Format('%s : an unexpected exception %s occurred: %s',[ArgsToStr,E.ClassName,E.Message])
- end;
- if FailMsg<>'' then
- Fail(FailMsg);
- end;
- begin
- //EInOutError
- DoTest([''],True,'');
- DoTest(['',''],True,'');
- DoTest(['','',''],True,'');
- DoTest(['a','b','c'],True,'a\b\c');
- DoTest(['a','b','\c'],True,'\c');
- DoTest(['a','\b','c'],True,'\b\c');
- DoTest(['\a','\b','c'],True,'\b\c');
- DoTest(['\a','\b','\c'],True,'\c');
- DoTest(['\a','b','\c:'],True,'\c:');
- DoTest(['a','<>','\b','c','\d'],True,'',True);
- {$IFDEF WINDOWS}
- DoTest(['c:','a','b'],True,'c:a\b',False);
- {$ENDIF}
- DoTest(['\1','..\2','..\3','..4'],True,'\1\..\2\..\3\..4');
- DoTest(['\1','','','4','','6',''],True,'\1\4\6');
- DoTest(['','','','<>|'],True,'<>|',True);
- DoTest([''],False,'');
- DoTest(['',''],False,'');
- DoTest(['','',''],False,'');
- DoTest(['a','b','c'],False,'a\b\c');
- DoTest(['a','b','\c'],False,'\c');
- DoTest(['a','\b','c'],False,'\b\c');
- DoTest(['\a','\b','c'],False,'\b\c');
- DoTest(['\a','\b','\c'],False,'\c');
- DoTest(['\a','b','\c:'],False,'\c:');
- DoTest(['a','<>','\b','c','\d'],False,'\d',False);
- end;
- procedure TTestTPath.TestGetDirectoryName;
- Procedure TestIt(aResult,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile,aResult,TPath.GetDirectoryName(aFile));
- end;
- begin
- TestIt('/a','/a/b.txt');
- TestIt('','b.txt');
- TestIt('.','./b.txt');
- end;
- procedure TTestTPath.TestGetExtension;
- Procedure TestIt(aResult,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile,aResult,TPath.GetExtension(aFile));
- end;
- begin
- TestIt('.txt','/a/b.txt');
- TestIt('.txt','b.txt');
- TestIt('','.txt');
- end;
- procedure TTestTPath.TestGetFileName;
- Procedure TestIt(aResult,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile,aResult,TPath.GetFileName(aFile));
- end;
- begin
- TestIt('b.txt','/a/b.txt');
- TestIt('b.txt','b.txt');
- TestIt('.txt','.txt');
- end;
- procedure TTestTPath.TestGetFileNameWithoutExtension;
- Procedure TestIt(aResult,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile,aResult,TPath.GetFileNameWithoutExtension(aFile));
- end;
- begin
- TestIt('b','/a/b.txt');
- TestIt('b','b.txt');
- TestIt('.txt','.txt');
- end;
- procedure TTestTPath.TestGetFullPath;
- Procedure TestIt(aResult,aFile : String);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile,aResult,TPath.GetFullPath(aFile));
- end;
- begin
- TestIt('/a/b.txt','/a/b.txt');
- TestIt(CWD+'b.txt','b.txt');
- TestIt(CWD+'a/b.txt','a/b.txt');
- end;
- Function IndexOf(C : Char; A : TCharArray) : Integer; overload;
- Var
- Len : Integer;
- begin
- Result:=0;
- Len:=Length(A);
- While (Result<Len) and (A[Result]<>C) do
- Inc(Result);
- if Result>=Len then
- Result:=-1;
- end;
- procedure TTestTPath.TestGetInvalidFileNameChars;
- Const
- {$IFDEF UNIX}
- CExtraInvalid = '/~';
- {$ELSE}
- CExtraInvalid = '"*/:<>?\|';
- {$ENDIF}
- Var
- CA : TCharArray;
- C : Char;
- P : Integer;
- begin
- CA:=TPath.GetInvalidFileNameChars;
- For C:=#0 to #31 do
- begin
- P:=IndexOf(C,CA);
- AssertTrue('1 Have #'+IntToStr(Ord(C)),P<>-1);
- System.Delete(CA,P,1);
- end;
- For C in CExtraInvalid do
- begin
- P:=IndexOf(C,CA);
- AssertTrue('2 Have #'+IntToStr(Ord(C)),P<>-1);
- System.Delete(CA,P,1);
- end;
- AssertEquals('All characters accounted for',0,Length(CA));
- end;
- procedure TTestTPath.TestGetInvalidPathChars;
- Const
- {$IFDEF UNIX}
- CExtraInvalid = '"<>|';
- {$ELSE}
- CExtraInvalid = '';
- {$ENDIF}
- Var
- CA : TCharArray;
- C : Char;
- P : Integer;
- begin
- CA:=TPath.GetInvalidPathChars;
- For C:=#0 to #31 do
- begin
- P:=IndexOf(C,CA);
- AssertTrue('1 Have #'+IntToStr(Ord(C)),P<>-1);
- System.Delete(CA,P,1);
- end;
- For C in CExtraInvalid do
- begin
- P:=IndexOf(C,CA);
- AssertTrue('2 Have #'+IntToStr(Ord(C)),P<>-1);
- System.Delete(CA,P,1);
- end;
- AssertEquals('All characters accounted for',0,Length(CA));
- end;
- procedure TTestTPath.TestGetPathRoot;
- Procedure TestIt(aResult,aFile : string);
- begin
- DoDirSeparators(aResult);
- DoDirSeparators(aFile);
- AssertEquals(aFile+' -> '+aResult,aResult,TPath.GetPathRoot(aFIle));
- end;
- begin
- TestIt('/','/a/b/c.txt');
- {$IFDEF WINDOWS}
- TestIt('a:/','a:/b/c.txt');
- TestIt('//a/','//a/b/c.txt');
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetRandomFileName;
- Const
- allowed = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.';
- Var
- FN : String;
- C : Char;
- begin
- FN:=TPath.GetRandomFileName;
- AssertEquals('Have correct length',12,Length(FN));
- AssertTrue('Have dot',(Pos('.',FN)<>0) and (Pos('.',FN)<Length(FN)));
- For C in FN do
- if (Pos(Upcase(C),Allowed)=0) then
- Fail('Invalid char in string: '+c);
- end;
- procedure TTestTPath.TestGetTempFileName;
- Var
- aDir,FN : String;
- begin
- FN:=GetTempFileName;
- AssertEquals('Path',TPath.GetTempPath,ExtractFilePath(FN));
- FN:=ExtractFileName(FN);
- AssertTrue('Not empty name',0<Length(FN));
- AssertTrue('Not empty extension',0<Length(ExtractFileExt(FN)));
- aDir:=BaseDir;
- DoDirSeparators(aDir);
- FN:=GetTempFileName(aDir,'ttt');
- AssertEquals('2 Path',adir,ExtractFilePath(FN));
- FN:=ExtractFileName(FN);
- AssertTrue('2 Not empty name',0<Length(FN));
- AssertEquals('Prefix',1,Pos('ttt',FN));
- AssertTrue('2 Not empty extension',0<Length(ExtractFileExt(FN)));
- end;
- procedure TTestTPath.TestGetTempPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetTempPath;
- AssertTrue('Dir exists',DirectoryExists(FN));
- end;
- procedure TTestTPath.TestGetHomePath;
- Var
- FN : String;
- begin
- FN:=TPath.GetHomePath;
- AssertTrue('Dir exists',DirectoryExists(FN));
- AssertEquals('UserDir exists',GetUserDir,FN);
- end;
- {$IFDEF UNIX}
- //Names : array[TSpecialDir] of string
- // = ('DESKTOP', 'DOCUMENTS', 'DOWNLOAD', 'MUSIC', 'PICTURES', 'PUBLICSHARE', 'TEMPLATES', 'VIDEOS');
- function UnixSpecialDir(const AType: String): string;
- var
- cfg,varname: string;
- L: TStringList;
- begin
- Result := '';
- // XDG variable name
- varName:=Format('XDG_%s_DIR',[UpperCase(AType)]);
- Cfg:=GetEnvironmentVariable('XDG_CONFIG_HOME');
- if (Cfg='') then
- Cfg:=GetUserDir+'.config/user-dirs.dirs'
- else
- CFG:=CFG+'user-dirs.dirs';
- if not FileExists(Cfg) then
- Exit;
- L:=TStringList.Create;
- try
- L.LoadFromFile(Cfg);
- Result:=AnsiDequotedStr(L.Values[VarName],'"');
- finally
- FreeAndNil(L);
- end;
- Result:=StringReplace(Result,'$HOME', ExcludeTrailingPathDelimiter(GetUserDir), [rfIgnoreCase]);
- end;
- {$ENDIF}
- procedure TTestTPath.TestGetDocumentsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetDocumentsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Documents'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_PERSONAL),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedDocumentsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedDocumentsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_DOCUMENTS),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetLibraryPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetLibraryPath;
- {$IFDEF UNIX}
- AssertEquals(GetCurrentDir,FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(ExtractFilePath(Paramstr(0)),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetCachePath;
- Var
- FN : String;
- begin
- FN:=TPath.GetCachePath;
- {$IFDEF UNIX}
- AssertEquals(GetUserDir+'.cache',FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_LOCAL_APPDATA),FN);
- {$ELSE}
- AssertEquals(GetTempDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetPublicPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetPublicPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_APPDATA),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetPicturesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetPicturesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Pictures'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYPICTURES),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedPicturesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedPicturesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_PICTURES),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetCameraPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetPicturesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Pictures'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYPICTURES),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedCameraPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedCameraPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_PICTURES),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetMusicPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetMusicPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Music'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYMUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedMusicPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedMusicPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_MUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetMoviesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetMoviesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Videos'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYVIDEO),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedMoviesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedMoviesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_VIDEO),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetAlarmsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetAlarmsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Music'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYMUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedAlarmsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedAlarmsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_MUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetDownloadsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetDownloadsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Download'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYMUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedDownloadsPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedDownloadsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_APPDATA),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetRingtonesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetAlarmsPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Music'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_MYMUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSharedRingtonesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetSharedRingtonesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('PublicShare'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_COMMON_MUSIC),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetTemplatesPath;
- Var
- FN : String;
- begin
- FN:=TPath.GetTemplatesPath;
- {$IFDEF UNIX}
- AssertEquals(UnixSpecialDir('Templates'),FN);
- {$ELSE}
- {$IFDEF WINDOWS}
- AssertEquals(GetSpecialDir(CSIDL_PERSONAL),FN);
- {$ELSE}
- AssertEquals(GetUserDir,FN);
- {$ENDIF}
- {$ENDIF}
- end;
- procedure TTestTPath.TestGetSetAttributes;
- Const
- {$IFDEF UNIX}
- FAS = [TFileAttribute.faOwnerRead, TFileAttribute.faOwnerWrite, TFileAttribute.faOwnerExecute,
- TFileAttribute.faGroupRead, TFileAttribute.faGroupWrite, TFileAttribute.faGroupExecute,
- TFileAttribute.faOthersRead, TFileAttribute.faOthersWrite, TFileAttribute.faOthersExecute,
- TFileAttribute.faUserIDExecution, TFileAttribute.faGroupIDExecution, TFileAttribute.faStickyBit];
- {$ENDIF}
- Var
- FN : String;
- H : THandle;
- FAG : TFileAttributes;
- begin
- FN:=BaseDir+'attrfile.txt';
- if FileExists(FN) then
- DeleteFile(FN);
- h:=FileCreate(Fn);
- try
- {$IFDEF UNIX}
- TPath.SetAttributes(FN,FAS);
- FAG:=TPath.GetAttributes(FN);
- AssertTrue('All attributes set',FAS*FAG=FAG);
- {$ENDIF}
- finally
- FileCLose(h);
- DeleteFile(FN);
- end;
- end;
- procedure TTestTPath.TestHasExtension;
- Procedure TestIt(aResult : Boolean; aFileName : string);
- begin
- DoDirSeparators(aFileName);
- AssertEquals(aFileName+' has extension',aResult,TPatH.HasExtension(aFileName));
- end;
- begin
- TestIt(False,'abc');
- TestIt(True,'abc.def');
- TestIt(True,'/123/abc.def');
- TestIt(True,'123/abc.def');
- TestIt(True,'123.345/abc.def');
- TestIt(False,'123.345/abcdef');
- {$ifdef unix}
- TestIt(False,'.abcdef');
- TestIt(False,'/123/.abcdef');
- {$endif}
- end;
- procedure TTestTPath.TestIsPathRooted;
- Procedure TestIt(aResult : Boolean; aFileName : string);
- begin
- DoDirSeparators(aFileName);
- AssertEquals(aFileName+' is rooted',aResult,TPatH.IsPathRooted(aFileName));
- end;
- begin
- TestIt(False,'abc.def');
- TestIt(False,'ad/abc.def');
- TestIt(False,'../abc.def');
- TestIt(False,'/abc.def');
- TestIt(False,'/a/abc.def');
- {$IFDEF WINDOWS}
- TestIt(True,'a:/abc.def');
- TestIt(True,'//share/o/abc.def');
- {$ENDIF}
- end;
- procedure TTestTPath.TestExtensionSeparatorChar;
- begin
- AssertEquals('.',TPath.ExtensionSeparatorChar);
- end;
- procedure TTestTPath.TestAltDirectorySeparatorChar;
- begin
- {$ifdef Windows}
- AssertEquals('/',TPath.AltDirectorySeparatorChar);
- {$elseif defined(unix)}
- AssertEquals('\',TPath.AltDirectorySeparatorChar);
- {$else}
- AssertEquals('\',TPath.AltDirectorySeparatorChar);
- {$endif}
- end;
- procedure TTestTPath.TestDirectorySeparatorChar;
- begin
- {$ifdef Windows}
- AssertEquals('\',TPath.DirectorySeparatorChar);
- {$else}
- AssertEquals('/',TPath.DirectorySeparatorChar);
- {$endif}
- end;
- procedure TTestTPath.TestPathSeparator;
- begin
- {$ifdef Windows}
- AssertEquals(';',TPath.PathSeparator);
- {$else}
- AssertEquals(':',TPath.PathSeparator);
- {$endif}
- end;
- procedure TTestTPath.TestVolumeSeparatorChar;
- begin
- {$ifdef Windows}
- AssertEquals(':',TPath.VolumeSeparatorChar);
- {$else}
- AssertEquals(#0,TPath.VolumeSeparatorChar);
- {$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);
- begin
- if not ForceDirectories(FBaseDir+aDir) then
- Fail('Could not create directory %s',[FBaseDir+aDir]);
- end;
- begin
- DoCreateDir('testpath');
- DoCreateDir('testpath/dir1');
- DoCreateDir('testpath/dir2');
- 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
- Info : TSearchRec;
- lDir,lFull : String;
- begin
- lDir:=IncludeTrailingPathDelimiter(aDir);
- If FIndFirst(lDir+AllFilesMask,sysutils.faDirectory,Info)=0 then
- try
- Repeat
- lFull:=lDir+Info.Name;
- if Info.IsDirectory then
- begin
- if not (Info.IsCurrentOrParentDir) then
- begin
- CleanDirs(lFull);
- if not RemoveDir(lFull) then
- Fail('Failed to remove directory %s',[lFull])
- end;
- end
- else if not DeleteFile(lFull) then
- Fail('Failed to remove file %s',[lFull])
- until FindNext(Info)<>0;
- finally
- FindClose(Info);
- end;
- end;
- procedure TTestIO.SetUp;
- begin
- FCWD:=IncludeTrailingPathDelimiter(GetCurrentDir);
- FBaseDir:=GetTempDir(False)+'testio/';
- end;
- procedure TTestIO.TearDown;
- begin
- CleanDirs(FBaseDir);
- ChDir(FCWD);
- end;
- initialization
- RegisterTests([TTestTPath,TTestTDirectory]);
- end.
|