paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 22:16:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: pointer deref with index / tests

Browse Source 
git-svn-id: trunk@44563 -
This commit is contained in:
martin 2014-03-31 03:11:39 +00:00
parent 7473ac1d09
commit 8d1b5eeea4
4 changed files with 69 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/fpdebug/fpdbgdwarf.pas
View File

@ -2242,10 +2242,10 @@ begin
if (f * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
exit;
//if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
// (FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
//then
// exit;
if (f * [svfAddress, svfSize] = [svfAddress, svfSize]) and
(FTypeCastSourceValue.Size = FTypeCastTargetType.Size)
then
exit;
Result := False;
end;

61
components/fpdebug/fppascalparser.pas
View File

@ -487,12 +487,15 @@ type
procedure IncRefLevel;
end;
{ TFpPasParserValueDerefPointer }
{ TFpPasParserValueDerefPointer
Used as address source in typecast
}
TFpPasParserValueDerefPointer = class(TFpPasParserValue)
private
FValue: TFpDbgValue;
FExpression: TFpPascalExpression; // MemReader / AddrSize
FAddressOffset: Int64; // Add to address
FCardinal: QWord; // todo: TFpDbgMemLocation ?
FCardinalRead: Boolean;
protected
@ -502,9 +505,10 @@ type
function GetAddress: TFpDbgMemLocation; override;
function GetSize: Integer; override;
function GetAsCardinal: QWord; override; // reads men
function GetTypeInfo: TFpDbgSymbol; override;
function GetTypeInfo: TFpDbgSymbol; override; // TODO: Cardinal? Why? // TODO: does not handle AOffset
public
constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression);
constructor Create(AValue: TFpDbgValue; AExpression: TFpPascalExpression; AOffset: Int64);
destructor Destroy; override;
end;
@ -679,6 +683,13 @@ end;
function TFpPasParserValueDerefPointer.GetAddress: TFpDbgMemLocation;
begin
Result := FValue.DataAddress;
if FAddressOffset <> 0 then begin
assert(IsTargetAddr(Result ), 'TFpPasParserValueDerefPointer.GetAddress: TargetLoc(Result)');
if IsTargetAddr(Result) then
Result.Address := Result.Address + FAddressOffset
else
Result := InvalidLoc;
end;
end;
function TFpPasParserValueDerefPointer.GetSize: Integer;
@ -733,11 +744,18 @@ end;
constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
AExpression: TFpPascalExpression);
begin
Create(AValue, AExpression, 0);
end;
constructor TFpPasParserValueDerefPointer.Create(AValue: TFpDbgValue;
AExpression: TFpPascalExpression; AOffset: Int64);
begin
inherited Create;
FValue := AValue;
FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserDerefPointerSymbolValue'){$ENDIF};
FExpression := AExpression;
FAddressOffset := AOffset;
end;
destructor TFpPasParserValueDerefPointer.Destroy;
@ -921,8 +939,10 @@ end;
function TFpPascalExpressionPartBracketIndex.DoGetResultValue: TFpDbgValue;
var
TmpVal, TmpVal2, TmpIndex: TFpDbgValue;
TmpVal, TmpVal2, TmpIndex, TmpDeref: TFpDbgValue;
i: Integer;
Offs: Int64;
ti: TFpDbgSymbol;
begin
Result := nil;
assert(Count >= 2, 'TFpPascalExpressionPartBracketIndex.DoGetResultValue: Count >= 2');
@ -945,7 +965,7 @@ begin
TmpVal2 := TmpVal.Member[TmpIndex.AsInteger]
else
if (svfOrdinal in TmpIndex.FieldFlags) and
(TmpIndex.AsCardinal <= high(Integer))
(TmpIndex.AsCardinal <= high(Int64))
then
TmpVal2 := TmpVal.Member[TmpIndex.AsCardinal]
else
@ -954,13 +974,37 @@ begin
TmpVal.ReleaseReference;
exit;
end;
if TmpVal2 <> nil then TmpVal2.AddReference;
end // Kind = skArray
else
if (TmpVal.Kind = skPointer) then begin
//Result := TmpVal.TypeInfo;
SetError('Not implemented');
TmpVal.ReleaseReference;
exit;
if (TmpVal.TypeInfo = nil) or (TmpVal.TypeInfo.TypeInfo = nil) or
(TmpVal.TypeInfo.TypeInfo.Size <= 0)
then begin
SetError('Can not dereference an untyped pointer');
TmpVal.ReleaseReference;
exit;
end;
// TODO: check svfDataAddress / readable ? (see normal pointer deref);
ti := TmpVal.TypeInfo.TypeInfo;
if (svfInteger in TmpIndex.FieldFlags) then
Offs := TmpIndex.AsInteger
else
if (svfOrdinal in TmpIndex.FieldFlags) and (TmpIndex.AsCardinal <= high(Int64))
then
Offs := Int64(TmpIndex.AsCardinal)
else
begin
SetError('Can not calculate Index');
TmpVal.ReleaseReference;
exit;
end;
{$PUSH}{$R-}{$Q-} // TODO: check overflow
Offs := Offs * ti.Size;
{$POP}
TmpDeref := TFpPasParserValueDerefPointer.Create(TmpVal, Expression, Offs);
TmpVal2 := ti.TypeCastValue(TmpDeref);
TmpDeref.ReleaseReference;
end
else
if (TmpVal.Kind = skString) then begin
@ -981,7 +1025,6 @@ begin
TmpVal.ReleaseReference;
exit;
end;
TmpVal2.AddReference;
TmpVal.ReleaseReference;
TmpVal := TmpVal2;
end;

2
components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas
View File

@ -355,6 +355,8 @@ var
// dummy, ensure "pointer" is in debug info
ArrayGlob_DummyPointer: Pointer;
ArrayGlob_DummyPInteger: PInteger;
procedure Test1;
implementation

12
components/lazdebuggerfp/test/testwatches.pas
View File

@ -14,7 +14,7 @@ const
BREAK_LINE_TestWatchesUnitSimple_2 = 570;
BREAK_LINE_TestWatchesUnitSimple_3 = 578;
BREAK_LINE_TestWatchesUnitArray = 840;
BREAK_LINE_TestWatchesUnitArray = 842;
type
@ -662,6 +662,16 @@ if not (i in [2,3]) then // open array / TODO
end; // i
{%endregion Fields }
//TODO
AddSimpleInt('PInteger(Field_DynInt1)[0]', 5511, M_Int);
AddSimpleInt('PInteger(Field_DynInt1)[1]', 5512, M_Int);
AddSimpleInt('PInteger(Field_DynInt1)[2]', 5513, M_Int);
AddSimpleInt('^LongInt(Field_DynInt1)[0]', 5511, M_Int);
AddSimpleInt('^LongInt(Field_DynInt1)[1]', 5512, M_Int);
AddSimpleInt('^LongInt(Field_DynInt1)[2]', 5513, M_Int);
end;
procedure TTestWatches.RunTestWatches(NamePreFix: String; TestExeName, ExtraOpts: String;