From 8d1b5eeea416c21c76d467b8216b6138d5088e97 Mon Sep 17 00:00:00 2001 From: martin Date: Mon, 31 Mar 2014 03:11:39 +0000 Subject: [PATCH] FpDebug: pointer deref with index / tests git-svn-id: trunk@44563 - --- components/fpdebug/fpdbgdwarf.pas | 8 +-- components/fpdebug/fppascalparser.pas | 61 ++++++++++++++++--- .../test/TestApps/TestWatchesUnitArray.pas | 2 + components/lazdebuggerfp/test/testwatches.pas | 12 +++- 4 files changed, 69 insertions(+), 14 deletions(-) diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index 1c85e94f03..f13c0f34f2 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -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; diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 8aefc86183..e2c15bd762 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -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; diff --git a/components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas b/components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas index c27fb7a59e..02a31a0d30 100644 --- a/components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas +++ b/components/lazdebuggerfp/test/TestApps/TestWatchesUnitArray.pas @@ -355,6 +355,8 @@ var // dummy, ensure "pointer" is in debug info ArrayGlob_DummyPointer: Pointer; + ArrayGlob_DummyPInteger: PInteger; + procedure Test1; implementation diff --git a/components/lazdebuggerfp/test/testwatches.pas b/components/lazdebuggerfp/test/testwatches.pas index ef652fa3e5..a95f6f2d31 100644 --- a/components/lazdebuggerfp/test/testwatches.pas +++ b/components/lazdebuggerfp/test/testwatches.pas @@ -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;