mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-03 07:37:29 +01:00
FpDebug: fix searching line<>address map. / add test
This commit is contained in:
parent
da18a60294
commit
dc2c0ee78f
@ -3551,7 +3551,8 @@ function TDWarfLineMap.GetAddressesForLine(ALine: Cardinal; var AResultList: TDB
|
|||||||
NoData: Boolean; AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger;
|
NoData: Boolean; AFindSibling: TGetLineAddrFindSibling; AFoundLine: PInteger;
|
||||||
AMaxSiblingDistance: integer; ACU: TDwarfCompilationUnit): Boolean;
|
AMaxSiblingDistance: integer; ACU: TDwarfCompilationUnit): Boolean;
|
||||||
var
|
var
|
||||||
idx, offset, Addr1, Addr2: TDBGPtr;
|
idx: integer;
|
||||||
|
offset, Addr1, Addr2: TDBGPtr;
|
||||||
LineOffsets: Array of Byte;
|
LineOffsets: Array of Byte;
|
||||||
Addresses: Array of TDBGPtr;
|
Addresses: Array of TDBGPtr;
|
||||||
o: Byte;
|
o: Byte;
|
||||||
@ -3563,7 +3564,7 @@ begin
|
|||||||
offset := ALine mod 256;
|
offset := ALine mod 256;
|
||||||
if idx >= Length(FLineIndexList) then begin
|
if idx >= Length(FLineIndexList) then begin
|
||||||
if AFindSibling = fsBefore then begin
|
if AFindSibling = fsBefore then begin
|
||||||
idx := Length(FLineIndexList);
|
idx := Length(FLineIndexList)-1;
|
||||||
offset := 255;
|
offset := 255;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
@ -3606,7 +3607,15 @@ begin
|
|||||||
fsBefore: begin
|
fsBefore: begin
|
||||||
if i > 0 then begin
|
if i > 0 then begin
|
||||||
dec(i);
|
dec(i);
|
||||||
|
CurOffs := CurOffs - o;
|
||||||
offset := 0; // found line before
|
offset := 0; // found line before
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
// i=0 => will trigger continue for outer loop
|
||||||
|
dec(idx);
|
||||||
|
if idx < 0 then
|
||||||
|
exit;
|
||||||
|
offset := 255; // Must be last entry from block before (if there is a block before)
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
fsNext, fsNextFunc, fsNextFuncLazy: begin
|
fsNext, fsNextFunc, fsNextFuncLazy: begin
|
||||||
@ -3625,7 +3634,19 @@ begin
|
|||||||
break;
|
break;
|
||||||
case AFindSibling of
|
case AFindSibling of
|
||||||
fsNone: exit;
|
fsNone: exit;
|
||||||
else continue;
|
fsBefore: begin
|
||||||
|
if i = 0 then
|
||||||
|
continue;
|
||||||
|
assert(i=l, 'TDWarfLineMap.GetAddressesForLine: i=l');
|
||||||
|
dec(i);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
else begin
|
||||||
|
inc(idx);
|
||||||
|
if idx >= Length(FLineIndexList) then
|
||||||
|
exit;
|
||||||
|
continue;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
until False;
|
until False;
|
||||||
|
|
||||||
|
|||||||
@ -63,7 +63,7 @@
|
|||||||
<PackageName Value="FCL"/>
|
<PackageName Value="FCL"/>
|
||||||
</Item5>
|
</Item5>
|
||||||
</RequiredPackages>
|
</RequiredPackages>
|
||||||
<Units Count="10">
|
<Units Count="11">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="FpTest.lpr"/>
|
<Filename Value="FpTest.lpr"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
@ -113,6 +113,11 @@
|
|||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="TestErrorHandler"/>
|
<UnitName Value="TestErrorHandler"/>
|
||||||
</Unit9>
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="testlinemap.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="TestLineMap"/>
|
||||||
|
</Unit10>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
|
|||||||
@ -5,7 +5,7 @@ program FpTest;
|
|||||||
uses
|
uses
|
||||||
Interfaces, Forms, GuiTestRunner, TestTypeInfo, TestHelperClasses, TestDwarfSetup1,
|
Interfaces, Forms, GuiTestRunner, TestTypeInfo, TestHelperClasses, TestDwarfSetup1,
|
||||||
TestDwarfSetupBasic, TestDwarfVarious, testdwarfsetupArray, TestMemManager, TestPascalParser,
|
TestDwarfSetupBasic, TestDwarfVarious, testdwarfsetupArray, TestMemManager, TestPascalParser,
|
||||||
TestErrorHandler;
|
TestErrorHandler, TestLineMap;
|
||||||
|
|
||||||
{$R *.res}
|
{$R *.res}
|
||||||
|
|
||||||
|
|||||||
181
components/fpdebug/test/testlinemap.pas
Normal file
181
components/fpdebug/test/testlinemap.pas
Normal file
@ -0,0 +1,181 @@
|
|||||||
|
unit TestLineMap;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Math, FpDbgDwarfDataClasses, FpDbgInfo, DbgIntfBaseTypes, fpcunit, testutils,
|
||||||
|
testregistry;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TTestLineMap }
|
||||||
|
|
||||||
|
TTestLineMap = class(TTestCase)
|
||||||
|
private
|
||||||
|
LMap: TDWarfLineMap;
|
||||||
|
|
||||||
|
procedure InitMap(l: array of integer);
|
||||||
|
procedure CheckNotFound(ASearch: Integer; AFindSibling: TGetLineAddrFindSibling; AMaxSiblingDistance: integer = 0);
|
||||||
|
procedure CheckFound(ASearch, AExp: Integer; AFindSibling: TGetLineAddrFindSibling; AMaxSiblingDistance: integer = 0);
|
||||||
|
published
|
||||||
|
procedure TestLineMapFsNone;
|
||||||
|
procedure TestLineMapFsBefore;
|
||||||
|
procedure TestLineMapFsNext;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
procedure TTestLineMap.InitMap(l: array of integer);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
LMap := Default(TDWarfLineMap);
|
||||||
|
LMap.Init;
|
||||||
|
for i := 0 to Length(l) - 1 do
|
||||||
|
LMap.SetAddressForLine(l[i], l[i]);
|
||||||
|
LMap.Compress;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestLineMap.CheckNotFound(ASearch: Integer; AFindSibling: TGetLineAddrFindSibling;
|
||||||
|
AMaxSiblingDistance: integer);
|
||||||
|
var
|
||||||
|
a: TDBGPtrArray;
|
||||||
|
r: Boolean;
|
||||||
|
fl: Integer;
|
||||||
|
begin
|
||||||
|
fl := -1;
|
||||||
|
r := LMap.GetAddressesForLine(ASearch, a, False, AFindSibling, @fl, AMaxSiblingDistance);
|
||||||
|
AssertFalse('not found '+IntToStr(ASearch), r);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestLineMap.CheckFound(ASearch, AExp: Integer; AFindSibling: TGetLineAddrFindSibling;
|
||||||
|
AMaxSiblingDistance: integer);
|
||||||
|
var
|
||||||
|
a: TDBGPtrArray;
|
||||||
|
r: Boolean;
|
||||||
|
fl: Integer;
|
||||||
|
begin
|
||||||
|
fl := -1;
|
||||||
|
r := LMap.GetAddressesForLine(ASearch, a, False, AFindSibling, @fl, AMaxSiblingDistance);
|
||||||
|
AssertTrue('found '+IntToStr(ASearch), r);
|
||||||
|
AssertTrue('found (data) for '+IntToStr(ASearch), Length(a) = 1);
|
||||||
|
AssertEquals('found '+IntToStr(ASearch), AExp, fl);
|
||||||
|
AssertEquals('found (addr) '+IntToStr(ASearch), AExp, a[0]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestLineMap.TestLineMapFsNone;
|
||||||
|
begin
|
||||||
|
InitMap([10]);
|
||||||
|
|
||||||
|
CheckFound(10, 10, fsNone);
|
||||||
|
CheckNotFound( 9, fsNone);
|
||||||
|
CheckNotFound(11, fsNone);
|
||||||
|
|
||||||
|
InitMap([1000]);
|
||||||
|
CheckNotFound(1, fsNone);
|
||||||
|
CheckNotFound(99999, fsNone);
|
||||||
|
|
||||||
|
|
||||||
|
InitMap([10, 20]);
|
||||||
|
|
||||||
|
CheckFound(10, 10, fsNone);
|
||||||
|
CheckFound(20, 20, fsNone);
|
||||||
|
CheckNotFound( 9, fsNone);
|
||||||
|
CheckNotFound(19, fsNone);
|
||||||
|
CheckNotFound(21, fsNone);
|
||||||
|
|
||||||
|
InitMap([10, 2000]);
|
||||||
|
|
||||||
|
CheckFound(10, 10, fsNone);
|
||||||
|
CheckFound(2000, 2000, fsNone);
|
||||||
|
CheckNotFound( 9, fsNone);
|
||||||
|
CheckNotFound(1999, fsNone);
|
||||||
|
CheckNotFound(2001, fsNone);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestLineMap.TestLineMapFsBefore;
|
||||||
|
begin
|
||||||
|
InitMap([10]);
|
||||||
|
|
||||||
|
CheckFound(10, 10, fsBefore);
|
||||||
|
CheckFound(11, 10, fsBefore);
|
||||||
|
CheckFound(19, 10, fsBefore);
|
||||||
|
CheckFound(19, 10, fsBefore, 9);
|
||||||
|
CheckNotFound(19, fsBefore, 8);
|
||||||
|
CheckNotFound( 9, fsBefore);
|
||||||
|
|
||||||
|
InitMap([910, 920]);
|
||||||
|
|
||||||
|
CheckFound(910, 910, fsBefore);
|
||||||
|
CheckFound(911, 910, fsBefore);
|
||||||
|
CheckFound(919, 910, fsBefore);
|
||||||
|
CheckFound(919, 910, fsBefore, 9);
|
||||||
|
CheckNotFound(919, fsBefore, 8);
|
||||||
|
|
||||||
|
CheckFound(920, 920, fsBefore);
|
||||||
|
CheckFound(921, 920, fsBefore);
|
||||||
|
CheckFound(929, 920, fsBefore);
|
||||||
|
CheckFound(929, 920, fsBefore, 9);
|
||||||
|
CheckNotFound(929, fsBefore, 8);
|
||||||
|
|
||||||
|
CheckFound(2920, 920, fsBefore);
|
||||||
|
CheckNotFound(909, fsBefore);
|
||||||
|
CheckNotFound(9, fsBefore);
|
||||||
|
|
||||||
|
InitMap([511]);
|
||||||
|
CheckFound(2920, 511, fsBefore);
|
||||||
|
InitMap([512]);
|
||||||
|
CheckFound(2920, 512, fsBefore);
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestLineMap.TestLineMapFsNext;
|
||||||
|
begin
|
||||||
|
InitMap([10]);
|
||||||
|
|
||||||
|
CheckFound(10, 10, fsNext);
|
||||||
|
CheckFound( 9, 10, fsNext);
|
||||||
|
CheckFound( 1, 10, fsNext);
|
||||||
|
CheckFound( 1, 10, fsNext, 9);
|
||||||
|
CheckNotFound(11, fsNext, 8);
|
||||||
|
CheckNotFound(11, fsNext);
|
||||||
|
|
||||||
|
InitMap([910, 920]);
|
||||||
|
|
||||||
|
CheckFound(910, 910, fsNext);
|
||||||
|
CheckFound(909, 910, fsNext);
|
||||||
|
CheckFound(901, 910, fsNext);
|
||||||
|
CheckFound(901, 910, fsNext, 9);
|
||||||
|
CheckNotFound(901, fsNext, 8);
|
||||||
|
|
||||||
|
CheckFound(920, 920, fsNext);
|
||||||
|
CheckFound(919, 920, fsNext);
|
||||||
|
CheckFound(911, 920, fsNext);
|
||||||
|
CheckFound(911, 920, fsNext, 9);
|
||||||
|
CheckNotFound(918, fsNext, 1);
|
||||||
|
CheckNotFound(911, fsNext, 8);
|
||||||
|
|
||||||
|
CheckFound(1, 910, fsNext);
|
||||||
|
|
||||||
|
CheckNotFound(921, fsNext);
|
||||||
|
CheckNotFound(1921, fsNext);
|
||||||
|
|
||||||
|
InitMap([10, 2000]);
|
||||||
|
CheckFound(11, 2000, fsNext);
|
||||||
|
CheckFound(311, 2000, fsNext);
|
||||||
|
CheckNotFound(11, fsNext, 500);
|
||||||
|
|
||||||
|
InitMap([255]);
|
||||||
|
CheckFound(11, 255, fsNext);
|
||||||
|
InitMap([256]);
|
||||||
|
CheckFound(11, 256, fsNext);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
RegisterTest(TTestLineMap);
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user