paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 07:09:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Add traling separators tests

Browse Source 
git-svn-id: trunk@18177 -
This commit is contained in:
pierre 2011-08-12 09:01:29 +00:00
parent 9d763ec052
commit 47b943d236
1 changed files with 11 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
tests/test/units/sysutils/tdirex.pp
View File

@ -7,6 +7,7 @@ uses
const const
HasErrors : boolean = false; HasErrors : boolean = false;
AllowsTrailingSepartors: boolean = false;
procedure TestDirectoryExists(Const DirName : string; ExpectedResult : boolean); procedure TestDirectoryExists(Const DirName : string; ExpectedResult : boolean);
var var
@ -67,6 +68,10 @@ begin
Writeln('Name="',N,'"'); Writeln('Name="',N,'"');
Writeln('Ext="',E,'"'); Writeln('Ext="',E,'"');
TestDirectoryExists(P,true); TestDirectoryExists(P,true);
if DirectoryExists(P+DirectorySeparator) and
DirectoryExists(P+DirectorySeparator+DirectorySeparator) then
AllowsTrailingSepartors:=true;
dir:=P; dir:=P;
TestParents(dir); TestParents(dir);
dir:=P+'_Dummy'; dir:=P+'_Dummy';
@ -75,6 +80,12 @@ begin
TestDirectoryExists(dir,false); TestDirectoryExists(dir,false);
mkdir(dir); mkdir(dir);
TestDirectoryExists(dir,true); TestDirectoryExists(dir,true);
{ Check that using two directory separators fails }
TestDirectoryExists(dir+DirectorySeparator,AllowsTrailingSepartors);
TestDirectoryExists(dir+'/',AllowsTrailingSepartors);
TestDirectoryExists(dir+'//',AllowsTrailingSepartors);
if DirectorySeparator='\' then
TestDirectoryExists(dir+'\\',AllowsTrailingSepartors);
dir2:=dir+'_Dummy2'; dir2:=dir+'_Dummy2';
TestDirectoryExists(dir2,false); TestDirectoryExists(dir2,false);
mkdir(dir2); mkdir(dir2);