mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-19 00:19:26 +02:00
tests: added some file related tests
git-svn-id: trunk@15258 -
This commit is contained in:
parent
5c7e0b9f07
commit
31c6ff80ad
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -3636,6 +3636,7 @@ test/bugs/8450/unit1.lfm svneol=native#text/plain
|
|||||||
test/bugs/8450/unit1.lrs svneol=native#text/plain
|
test/bugs/8450/unit1.lrs svneol=native#text/plain
|
||||||
test/bugs/8450/unit1.pas svneol=native#text/plain
|
test/bugs/8450/unit1.pas svneol=native#text/plain
|
||||||
test/bugs/bug8432.pas svneol=native#text/plain
|
test/bugs/bug8432.pas svneol=native#text/plain
|
||||||
|
test/bugs/testfileproc.pas svneol=native#text/plain
|
||||||
test/bugs/testfileutil.pas svneol=native#text/plain
|
test/bugs/testfileutil.pas svneol=native#text/plain
|
||||||
test/bugtestcase.pas svneol=native#text/plain
|
test/bugtestcase.pas svneol=native#text/plain
|
||||||
test/hello.ahk svneol=native#text/plain
|
test/hello.ahk svneol=native#text/plain
|
||||||
|
54
test/bugs/testfileproc.pas
Normal file
54
test/bugs/testfileproc.pas
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
unit testfileproc;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testglobals,
|
||||||
|
FileProcs;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TTestFileUtil }
|
||||||
|
|
||||||
|
TTestFileProc= class(TTestCase)
|
||||||
|
published
|
||||||
|
procedure TestFileIsExecutable;
|
||||||
|
procedure TestTrimFileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TTestFileProc }
|
||||||
|
|
||||||
|
procedure TTestFileProc.TestFileIsExecutable;
|
||||||
|
procedure DoTest(const AFileName: string; Expected: boolean);
|
||||||
|
begin
|
||||||
|
AssertEquals(AFileName, Expected, FileIsExecutable(AFileName));
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
DoTest(ParamStr(0),true);
|
||||||
|
// a directory is not an executable file
|
||||||
|
DoTest(ExtractFileDir(ParamStr(0)), false);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestFileProc.TestTrimFileName;
|
||||||
|
procedure DoTest(AFileName, Expected: string);
|
||||||
|
begin
|
||||||
|
DoDirSeparators(AFileName);
|
||||||
|
DoDirSeparators(Expected);
|
||||||
|
AssertEquals(AFileName, Expected, TrimFilename(AFileName));
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
{$ifdef windows}
|
||||||
|
DoTest('c:\LazarusDir\..\dir\','c:\dir\');
|
||||||
|
{$endif}
|
||||||
|
DoTest('$(LazarusDir)\..\dir\','$(LazarusDir)\..\dir\');
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
// TODO: Maybe this test case should be moved to another testsuite, e.g. codetools test
|
||||||
|
AddToBugsTestSuite(TTestSuite.Create(TTestFileProc, 'TestFileProc'));
|
||||||
|
end.
|
||||||
|
|
@ -16,6 +16,7 @@ type
|
|||||||
published
|
published
|
||||||
procedure TestFileIsExecutable;
|
procedure TestFileIsExecutable;
|
||||||
procedure TestExtractFileNameWithoutExt;
|
procedure TestExtractFileNameWithoutExt;
|
||||||
|
procedure TestTrimFileName;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@ -48,6 +49,20 @@ begin
|
|||||||
DoTest(DirName + 'test.pas.bak', DirName + 'test');
|
DoTest(DirName + 'test.pas.bak', DirName + 'test');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestFileUtil.TestTrimFileName;
|
||||||
|
procedure DoTest(AFileName, Expected: string);
|
||||||
|
begin
|
||||||
|
DoDirSeparators(AFileName);
|
||||||
|
DoDirSeparators(Expected);
|
||||||
|
AssertEquals(AFileName, Expected, TrimFilename(AFileName));
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
{$ifdef windows}
|
||||||
|
DoTest('c:\LazarusDir\..\dir\','c:\dir\');
|
||||||
|
{$endif}
|
||||||
|
DoTest('$(LazarusDir)\..\dir\','$(LazarusDir)\..\dir\');
|
||||||
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
// Maybe this test case should be moved to another testsuite, e.g. lcl test
|
// Maybe this test case should be moved to another testsuite, e.g. lcl test
|
||||||
AddToBugsTestSuite(TTestSuite.Create(TTestFileUtil, 'TestFileUtil'));
|
AddToBugsTestSuite(TTestSuite.Create(TTestFileUtil, 'TestFileUtil'));
|
||||||
|
@ -21,16 +21,19 @@
|
|||||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
</local>
|
</local>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<RequiredPackages Count="3">
|
<RequiredPackages Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="FCL"/>
|
<PackageName Value="CodeTools"/>
|
||||||
</Item1>
|
</Item1>
|
||||||
<Item2>
|
<Item2>
|
||||||
<PackageName Value="fpcunitconsolerunner"/>
|
<PackageName Value="FCL"/>
|
||||||
</Item2>
|
</Item2>
|
||||||
<Item3>
|
<Item3>
|
||||||
<PackageName Value="LCL"/>
|
<PackageName Value="fpcunitconsolerunner"/>
|
||||||
</Item3>
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item4>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="4">
|
<Units Count="4">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
|
@ -21,18 +21,21 @@
|
|||||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
</local>
|
</local>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<RequiredPackages Count="3">
|
<RequiredPackages Count="4">
|
||||||
<Item1>
|
<Item1>
|
||||||
<PackageName Value="FCL"/>
|
<PackageName Value="CodeTools"/>
|
||||||
</Item1>
|
</Item1>
|
||||||
<Item2>
|
<Item2>
|
||||||
<PackageName Value="FPCUnitTestRunner"/>
|
<PackageName Value="FCL"/>
|
||||||
</Item2>
|
</Item2>
|
||||||
<Item3>
|
<Item3>
|
||||||
<PackageName Value="LCL"/>
|
<PackageName Value="FPCUnitTestRunner"/>
|
||||||
</Item3>
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item4>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="6">
|
<Units Count="7">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="runtestsgui.lpr"/>
|
<Filename Value="runtestsgui.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
@ -63,6 +66,11 @@
|
|||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="testunits"/>
|
<UnitName Value="testunits"/>
|
||||||
</Unit5>
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="bugs\testfileproc.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="testfileproc"/>
|
||||||
|
</Unit6>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
@ -28,7 +28,7 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
TestLpi, BugTestCase,
|
TestLpi, BugTestCase,
|
||||||
bug8432, testfileutil;
|
bug8432, testfileutil, testfileproc;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user