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

* Avoid warning about unset variable in TestParents

Browse Source 
+ Add check after moving current directory to root drive
    for Dos style pathes.

git-svn-id: trunk@18245 -
This commit is contained in:
pierre 2011-08-17 11:55:32 +00:00
parent 4c95e9fce5
commit 09e7570e57
1 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,9 +5,11 @@ program test_directoryexists;
uses uses
dos, sysutils; dos, sysutils;
{$I+}
const const
HasErrors : boolean = false; HasErrors : boolean = false;
AllowsTrailingSepartors: boolean = false; AllowTrailingSeparators: boolean = false;
procedure TestDirectoryExists(Const DirName : string; ExpectedResult : boolean); procedure TestDirectoryExists(Const DirName : string; ExpectedResult : boolean);
var var
@ -26,8 +28,7 @@ procedure TestParents(var dir : string);
var var
backslashpos,slashpos,maxpos,i : longint; backslashpos,slashpos,maxpos,i : longint;
begin begin
slashpos:=1; while true do
while (backslashpos<>0) or (slashpos<>0) do
begin begin
backslashpos:=0; backslashpos:=0;
for i:=length(dir) downto 1 do for i:=length(dir) downto 1 do
@ -50,7 +51,7 @@ begin
else else
maxpos:=backslashpos; maxpos:=backslashpos;
dir:=copy(dir,1,maxpos); dir:=copy(dir,1,maxpos);
TestDirectoryExists(dir,true); TestDirectoryExists(dir,AllowTrailingSeparators);
if length(dir)>1 then if length(dir)>1 then
begin begin
dir:=copy(dir,1,maxpos-1); dir:=copy(dir,1,maxpos-1);
@ -63,20 +64,30 @@ begin
end; end;
var var
dir,dir1,dir2 : string; dir,dir1,dir2,StoredDir : string;
P,N,E : shortstring; P,N,E : shortstring;
begin begin
Dos.FSplit(paramstr(0),P,N,E); Dos.FSplit(paramstr(0),P,N,E);
Writeln('Path="',P,'"'); Writeln('Path="',P,'"');
Writeln('Name="',N,'"'); Writeln('Name="',N,'"');
Writeln('Ext="',E,'"'); Writeln('Ext="',E,'"');
Writeln('DirectorySeparator="',DirectorySeparator,'"');
TestDirectoryExists(P,true); TestDirectoryExists(P,true);
if DirectoryExists(P+DirectorySeparator) and if DirectoryExists(P+DirectorySeparator) and
DirectoryExists(P+DirectorySeparator+DirectorySeparator) then DirectoryExists(P+DirectorySeparator+DirectorySeparator) then
AllowsTrailingSepartors:=true; AllowTrailingSeparators:=true;
dir:=P; dir:=P;
TestParents(dir); TestParents(dir);
dir:=P;
if (length(dir)>2) and (dir[2]=':') and (dir[3]=DirectorySeparator) then
begin
GetDir(0,StoredDir);
Writeln('Testing from Root drive');
ChDir(Copy(Dir,1,3));
TestParents(dir);
ChDir(StoredDir);
end;
dir:=P+'_Dummy'; dir:=P+'_Dummy';
TestDirectoryExists(dir,false); TestDirectoryExists(dir,false);
dir1:=P+'_Dummy'+DirectorySeparator; dir1:=P+'_Dummy'+DirectorySeparator;
@ -85,11 +96,11 @@ begin
TestDirectoryExists(dir,true); TestDirectoryExists(dir,true);
TestDirectoryExists(dir1,true); TestDirectoryExists(dir1,true);
{ Check that using two directory separators fails } { Check that using two directory separators fails }
TestDirectoryExists(dir1+DirectorySeparator,AllowsTrailingSepartors); TestDirectoryExists(dir1+DirectorySeparator,AllowTrailingSeparators);
TestDirectoryExists(dir1+'/',AllowsTrailingSepartors); TestDirectoryExists(dir1+'/',AllowTrailingSeparators);
TestDirectoryExists(dir1+'//',AllowsTrailingSepartors); TestDirectoryExists(dir1+'//',AllowTrailingSeparators);
if DirectorySeparator='\' then if DirectorySeparator='\' then
TestDirectoryExists(dir1+'\\',AllowsTrailingSepartors); TestDirectoryExists(dir1+'\\',AllowTrailingSeparators);
dir2:=dir1+'_Dummy2'; dir2:=dir1+'_Dummy2';
TestDirectoryExists(dir2,false); TestDirectoryExists(dir2,false);
mkdir(dir2); mkdir(dir2);