LCL: fixed range errors

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

View File

@ -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;

View File

@ -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;

View File

@ -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'));