mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-19 16:40:54 +02:00
LCL: fixed range errors
git-svn-id: trunk@10882 -
This commit is contained in:
parent
4eb87534ac
commit
1da43347c6
@ -337,10 +337,10 @@ begin
|
|||||||
p:=length(Result);
|
p:=length(Result);
|
||||||
while (p>0) do begin
|
while (p>0) do begin
|
||||||
case Result[p] of
|
case Result[p] of
|
||||||
PathDelim: exit;
|
PathDelim: exit;
|
||||||
'.': Result:=copy(Result,1, p-1);
|
'.': Result:=copy(Result,1, p-1);
|
||||||
else dec(p);
|
|
||||||
end;
|
end;
|
||||||
|
dec(p);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1116,7 +1116,7 @@ begin
|
|||||||
lWinControl := nil;
|
lWinControl := nil;
|
||||||
end;
|
end;
|
||||||
end else begin
|
end else begin
|
||||||
lWinControl := GetWindowInfo(LParam)^.WinControl;
|
lWinControl := GetWindowInfo(HWND(LParam))^.WinControl;
|
||||||
// buddy controls use 'awincontrol' to designate associated wincontrol
|
// buddy controls use 'awincontrol' to designate associated wincontrol
|
||||||
if lWinControl = nil then
|
if lWinControl = nil then
|
||||||
lWinControl := GetWindowInfo(LParam)^.AWinControl;
|
lWinControl := GetWindowInfo(LParam)^.AWinControl;
|
||||||
|
@ -15,7 +15,8 @@ type
|
|||||||
TTestFileUtil= class(TTestCase)
|
TTestFileUtil= class(TTestCase)
|
||||||
published
|
published
|
||||||
procedure TestFileIsExecutable;
|
procedure TestFileIsExecutable;
|
||||||
end;
|
procedure TestExtractFileNameWithoutExt;
|
||||||
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -32,6 +33,21 @@ begin
|
|||||||
DoTest(ExtractFileDir(ParamStr(0)), false);
|
DoTest(ExtractFileDir(ParamStr(0)), false);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestFileUtil.TestExtractFileNameWithoutExt;
|
||||||
|
var
|
||||||
|
DirName : string;
|
||||||
|
procedure DoTest(const FileName, Expected: string);
|
||||||
|
begin
|
||||||
|
AssertEquals(FileName, Expected, ExtractFileNameWithoutExt(FileName));
|
||||||
|
end;
|
||||||
|
begin
|
||||||
|
DoTest('test.pas', 'test');
|
||||||
|
DoTest('test.pas.bak', 'test');
|
||||||
|
DirName := AppendPathDelim('testdir');
|
||||||
|
DoTest(DirName + 'test.pas', DirName + 'test');
|
||||||
|
DoTest(DirName + 'test.pas.bak', DirName + 'test');
|
||||||
|
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'));
|
||||||
|
Loading…
Reference in New Issue
Block a user