paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-27 16:08:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

test: added TestCreateRelativePath

Browse Source 
git-svn-id: trunk@28993 -
This commit is contained in:
mattias 2011-01-13 15:06:21 +00:00
parent e372929332
commit ca536d0252
2 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
test/bugs/testfileproc.pas
View File

@ -12,10 +12,13 @@ type
{ TTestFileUtil } { TTestFileUtil }
{ TTestFileProc }
TTestFileProc= class(TTestCase) TTestFileProc= class(TTestCase)
published published
procedure TestFileIsExecutable; procedure TestFileIsExecutable;
procedure TestTrimFileName; procedure TestTrimFileName;
procedure TestCreateRelativePath;
end; end;
implementation implementation
@ -47,6 +50,40 @@ begin
DoTest('$(LazarusDir)\..\dir\','$(LazarusDir)\..\dir\'); DoTest('$(LazarusDir)\..\dir\','$(LazarusDir)\..\dir\');
end; end;
procedure TTestFileProc.TestCreateRelativePath;
procedure DoTest(Filename, BaseDirectory, Expected: string;
UsePointDirectory: boolean = false);
begin
DoDirSeparators(Filename);
DoDirSeparators(BaseDirectory);
DoDirSeparators(Expected);
AssertEquals('CreateRelativePath(File='+Filename+',Base='+BaseDirectory+')',
Expected,
CreateRelativePath(Filename,BaseDirectory,UsePointDirectory));
end;
begin
DoTest('/a','/a','');
DoTest('/a','/a/','');
DoTest('/a/b','/a/b','');
DoTest('/a/b','/a/b/','');
DoTest('/a','/a/','');
DoTest('/a','','/a');
DoTest('/a/b','/a','b');
DoTest('/a/b','/a/','b');
DoTest('/a/b','/a//','b');
DoTest('/a','/a/b','../');
DoTest('/a','/a/b/','../');
DoTest('/a','/a/b//','../');
DoTest('/a/','/a/b','../');
DoTest('/a','/a/b/c','../../');
DoTest('/a','/a/b//c','../../');
DoTest('/a','/a//b/c','../../');
DoTest('/a','/a//b/c/','../../');
DoTest('/a','/b','/a');
end;
initialization initialization
// TODO: Maybe this test case should be moved to another testsuite, e.g. codetools test // TODO: Maybe this test case should be moved to another testsuite, e.g. codetools test
AddToBugsTestSuite(TTestSuite.Create(TTestFileProc, 'TestFileProc')); AddToBugsTestSuite(TTestSuite.Create(TTestFileProc, 'TestFileProc'));

2
test/runtests.lpr
View File

@ -69,7 +69,7 @@ end;
procedure TLazTestRunner.WriteCustomHelp; procedure TLazTestRunner.WriteCustomHelp;
begin begin
writeln(' --compiler=<ppcxxx> use ppcxxx to build test projects'); writeln(' --compiler=<ppcxxx> use ppcxxx to build test projects');
writeln(' --pcp=<primarty-config-path> pass primarty-config-path to lazbuild'); writeln(' --pcp=<primary-config-path> pass primary-config-path to lazbuild');
writeln(' --submitter=SubmitterName name of sumbitter of the test results'); writeln(' --submitter=SubmitterName name of sumbitter of the test results');
writeln(' --machine=MachineName name of the machine the test runs on'); writeln(' --machine=MachineName name of the machine the test runs on');
end; end;