paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-25 03:01:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: fixed range errors

Browse Source 
git-svn-id: trunk@10882 -
This commit is contained in:
vincents 2007-04-05 12:40:39 +00:00
parent 4eb87534ac
commit 1da43347c6
3 changed files with 21 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/fileutil.inc
View File

@ -339,8 +339,8 @@ begin
case Result[p] of
PathDelim: exit;
'.': Result:=copy(Result,1, p-1);
else dec(p);
end;
dec(p);
end;
end;

2
lcl/interfaces/win32/win32callback.inc
View File

@ -1116,7 +1116,7 @@ begin
lWinControl := nil;
end;
end else begin
lWinControl := GetWindowInfo(LParam)^.WinControl;
lWinControl := GetWindowInfo(HWND(LParam))^.WinControl;
// buddy controls use 'awincontrol' to designate associated wincontrol
if lWinControl = nil then
lWinControl := GetWindowInfo(LParam)^.AWinControl;

16
test/bugs/testfileutil.pas
View File

@ -15,6 +15,7 @@ type
TTestFileUtil= class(TTestCase)
published
procedure TestFileIsExecutable;
procedure TestExtractFileNameWithoutExt;
end;
implementation
@ -32,6 +33,21 @@ begin
DoTest(ExtractFileDir(ParamStr(0)), false);
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
// Maybe this test case should be moved to another testsuite, e.g. lcl test
AddToBugsTestSuite(TTestSuite.Create(TTestFileUtil, 'TestFileUtil'));