diff --git a/components/fpdebug/fpdbgdwarf.pas b/components/fpdebug/fpdbgdwarf.pas index af4cd37837..c87482f9a3 100644 --- a/components/fpdebug/fpdbgdwarf.pas +++ b/components/fpdebug/fpdbgdwarf.pas @@ -607,6 +607,7 @@ type function GetMemberByName(AIndex: String): TDbgSymbolValue; override; function GetMember(AIndex: Integer): TDbgSymbolValue; override; function GetDbgSymbol: TDbgSymbol; override; + function GetTypeInfo: TDbgSymbol; override; property MemReader: TFpDbgMemReaderBase read FMemReader; public @@ -680,6 +681,7 @@ type TDbgDwarfPointerSymbolValue = class(TDbgDwarfNumericSymbolValue) protected function GetFieldFlags: TDbgSymbolValueFieldFlags; override; + function GetDataAddress: TDbgPtr; override; end; @@ -1681,7 +1683,12 @@ end; function TDbgDwarfPointerSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags; begin Result := inherited GetFieldFlags; - Result := Result + [svfSizeOfPointer] - [svfSize]; // data address + Result := Result + [svfOrdinal, svfSizeOfPointer, svfDataAddress] - [svfSize]; // data address +end; + +function TDbgDwarfPointerSymbolValue.GetDataAddress: TDbgPtr; +begin + Result := GetAsCardinal; end; { TDbgDwarfIntegerSymbolValue } @@ -1819,7 +1826,7 @@ begin tmp := FTypeCastInfo.MemberByName[AIndex]; if (tmp <> nil) then begin - assert(tmp is TDbgDwarfIdentifierMember); + assert(tmp is TDbgDwarfIdentifierMember, 'TDbgDwarfStructTypeCastSymbolValue.GetMemberByName'+DbgSName(tmp)); if FMembers = nil then FMembers := TFpDbgCircularRefCntObjList.Create; FMembers.Add(tmp); @@ -1915,10 +1922,12 @@ begin (FTypeCastSource.Size = FSize) then exit; - //if (FTypeCastSource.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and - // (FSize = AddressSize xxxxxxx) - //then - // exit; + if (FTypeCastSource.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and + not ( (FTypeCastInfo.Kind = skPointer) //or + //(FSize = AddressSize xxxxxxx) + ) + then + exit; Result := False; end; @@ -2043,6 +2052,9 @@ function TDbgDwarfSymbolValue.GetKind: TDbgSymbolKind; begin if FOwner <> nil then Result := FOwner.Kind + else + if HasTypeCastInfo then + Result := FTypeCastInfo.Kind else Result := inherited GetKind; end; @@ -2095,6 +2107,14 @@ begin Result := FOwner; end; +function TDbgDwarfSymbolValue.GetTypeInfo: TDbgSymbol; +begin + if HasTypeCastInfo then + Result := FTypeCastInfo + else + Result := inherited GetTypeInfo; +end; + constructor TDbgDwarfSymbolValue.Create(AMemReader: TFpDbgMemReaderBase); begin FMemReader := AMemReader; @@ -4553,8 +4573,7 @@ begin if IsInternalPointer then Result := NestedTypeInfo.GetTypedValueObject(ATypeCast) else - // TODO: - Result := TDbgDwarfPointerSymbolValue.Create(FCU.FOwner.FMemReader, FCU.FAddressSize); + Result := TDbgDwarfPointerSymbolValue.Create(FCU.FOwner.FMemReader, FCU.FAddressSize); end; { TDbgDwarfTypeIdentifierDeclaration } diff --git a/components/fpdebug/fpdbginfo.pas b/components/fpdebug/fpdbginfo.pas index 6e52ea933f..ce6b163dae 100644 --- a/components/fpdebug/fpdbginfo.pas +++ b/components/fpdebug/fpdbginfo.pas @@ -124,6 +124,7 @@ type end; TDbgSymbolValueFieldFlag = ( + // svfAddress, svfDataAddress this symbol does have an address, but it may still be nil svfAddress, svfSize, svfSizeOfPointer, svfDataAddress, svfDataSize, svfDataSizeOfPointer, svfInteger, svfCardinal, diff --git a/components/fpdebug/fppascalparser.pas b/components/fpdebug/fppascalparser.pas index 14332a03df..298d4f43c1 100644 --- a/components/fpdebug/fppascalparser.pas +++ b/components/fpdebug/fppascalparser.pas @@ -421,6 +421,20 @@ type constructor Create(AValue: QWord; ASigned: Boolean = False); end; + { TPasParserDerefPointerSymbolValue } + + TPasParserDerefPointerSymbolValue = class(TDbgSymbolValue) + private + FValue: TDbgSymbolValue; + protected + function GetFieldFlags: TDbgSymbolValueFieldFlags; override; + function GetAddress: TDbgPtr; override; + function GetSize: Integer; override; + public + constructor Create(AValue: TDbgSymbolValue); + destructor Destroy; override; + end; + { TPasParserAddressOfSymbolValue } TPasParserAddressOfSymbolValue = class(TDbgSymbolValue) @@ -440,6 +454,53 @@ type property PointedToValue: TDbgSymbolValue read GetPointedToValue; end; +{ TPasParserDerefPointerSymbolValue } + +function TPasParserDerefPointerSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags; +var + t: TDbgSymbol; +begin + // MUST *NOT* have ordinal + Result := [svfAddress]; + t := FValue.TypeInfo; + if t <> nil then t := t.TypeInfo; + if t <> nil then + if t.Kind = skPointer then + Result := Result + [svfSizeOfPointer] + else + Result := Result + [svfSize]; +end; + +function TPasParserDerefPointerSymbolValue.GetAddress: TDbgPtr; +begin + Result := FValue.DataAddress; +end; + +function TPasParserDerefPointerSymbolValue.GetSize: Integer; +var + t: TDbgSymbol; +begin + t := FValue.TypeInfo; + if t <> nil then t := t.TypeInfo; + if t <> nil then + Result := t.Size + else + Result := inherited GetSize; +end; + +constructor TPasParserDerefPointerSymbolValue.Create(AValue: TDbgSymbolValue); +begin + inherited Create; + FValue := AValue; + FValue.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserDerefPointerSymbolValue'){$ENDIF}; +end; + +destructor TPasParserDerefPointerSymbolValue.Destroy; +begin + inherited Destroy; + FValue.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(@FValue, 'TPasParserDerefPointerSymbolValue'){$ENDIF}; +end; + { TPasParserAddressOfSymbolValue } function TPasParserAddressOfSymbolValue.GetPointedToValue: TDbgSymbolValue; @@ -1621,7 +1682,7 @@ end; function TFpPascalExpressionPartOperatorDeRef.DoGetResultValue: TDbgSymbolValue; var - tmp: TDbgSymbolValue; + tmp, tmp2: TDbgSymbolValue; begin Result := nil; if Count <> 1 then exit; @@ -1636,8 +1697,15 @@ begin end else if tmp.Kind = skPointer then begin - // TODO - //Result := Result.TypeInfo; + if (svfDataAddress in tmp.FieldFlags) and (tmp.DataAddress <> 0) and + (tmp.TypeInfo <> nil) and (tmp.TypeInfo.TypeInfo <> nil) + then begin + //TODO: maybe introduce a method TypeCastFromAddress, so we can skip the twp2 object + tmp2 := TPasParserDerefPointerSymbolValue.Create(tmp); + Result := tmp.TypeInfo.TypeInfo.TypeCastValue(tmp2); + {$IFDEF WITH_REFCOUNT_DEBUG} if Result <> nil then Result.DbgRenameReference(nil, 'DoGetResultValue'){$ENDIF}; + tmp2.ReleaseReference; + end; end //if tmp.Kind = skArray then // dynarray else diff --git a/components/fpdebug/test/testdwarfsetup1.pas b/components/fpdebug/test/testdwarfsetup1.pas index 9b2086e57b..a7848444e3 100644 --- a/components/fpdebug/test/testdwarfsetup1.pas +++ b/components/fpdebug/test/testdwarfsetup1.pas @@ -203,84 +203,84 @@ Unitdwarfsetup1_lpr_0.AddAddr(DW_AT_high_pc, DW_FORM_addr, $00501510); VarGLOBTESTSETUP1RECORD_1.Tag := DW_TAG_variable; VarGLOBTESTSETUP1RECORD_1.Children := 0; VarGLOBTESTSETUP1RECORD_1.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1RECORD'+#0); - VarGLOBTESTSETUP1RECORD_1.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409000)])); // $03, $00, $90, $40, $00 + VarGLOBTESTSETUP1RECORD_1.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1RECORD)])); // $03, $00, $90, $40, $00 VarGLOBTESTSETUP1RECORD_1.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1RECORD_102); // $90, $07, $00, $00 VarGLOBTESTSETUP1RECORDP_2 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1RECORDP_2.Tag := DW_TAG_variable; VarGLOBTESTSETUP1RECORDP_2.Children := 0; VarGLOBTESTSETUP1RECORDP_2.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1RECORDP'+#0); - VarGLOBTESTSETUP1RECORDP_2.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409010)])); // $03, $10, $90, $40, $00 + VarGLOBTESTSETUP1RECORDP_2.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1RECORDP)])); // $03, $10, $90, $40, $00 VarGLOBTESTSETUP1RECORDP_2.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclPTESTSETUP1RECORD_108); // $EB, $07, $00, $00 VarGLOBTESTSETUP1CLASS_3 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASS_3.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASS_3.Children := 0; VarGLOBTESTSETUP1CLASS_3.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASS'+#0); - VarGLOBTESTSETUP1CLASS_3.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409020)])); // $03, $20, $90, $40, $00 + VarGLOBTESTSETUP1CLASS_3.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASS)])); // $03, $20, $90, $40, $00 VarGLOBTESTSETUP1CLASS_3.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1CLASS_88); // $D3, $06, $00, $00 VarGLOBTESTSETUP1CLASSP_4 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASSP_4.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASSP_4.Children := 0; VarGLOBTESTSETUP1CLASSP_4.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASSP'+#0); - VarGLOBTESTSETUP1CLASSP_4.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409030)])); // $03, $30, $90, $40, $00 + VarGLOBTESTSETUP1CLASSP_4.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASSP)])); // $03, $30, $90, $40, $00 VarGLOBTESTSETUP1CLASSP_4.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclPTESTSETUP1CLASS_111); // $0C, $08, $00, $00 VarGLOBTESTSETUP1CLASSCHILD_5 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASSCHILD_5.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASSCHILD_5.Children := 0; VarGLOBTESTSETUP1CLASSCHILD_5.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASSCHILD'+#0); - VarGLOBTESTSETUP1CLASSCHILD_5.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409040)])); // $03, $40, $90, $40, $00 + VarGLOBTESTSETUP1CLASSCHILD_5.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASSCHILD)])); // $03, $40, $90, $40, $00 VarGLOBTESTSETUP1CLASSCHILD_5.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1CLASSCHILD_114); // $2C, $08, $00, $00 VarGLOBTESTSETUP1CLASSCHILDP_6 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASSCHILDP_6.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASSCHILDP_6.Children := 0; VarGLOBTESTSETUP1CLASSCHILDP_6.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASSCHILDP'+#0); - VarGLOBTESTSETUP1CLASSCHILDP_6.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409050)])); // $03, $50, $90, $40, $00 + VarGLOBTESTSETUP1CLASSCHILDP_6.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASSCHILDP)])); // $03, $50, $90, $40, $00 VarGLOBTESTSETUP1CLASSCHILDP_6.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclPTESTSETUP1CLASSCHILD_121); // $91, $08, $00, $00 VarGLOBTESTSETUP1CLASSCLASS_7 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASSCLASS_7.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASSCLASS_7.Children := 0; VarGLOBTESTSETUP1CLASSCLASS_7.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASSCLASS'+#0); - VarGLOBTESTSETUP1CLASSCLASS_7.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409060)])); // $03, $60, $90, $40, $00 + VarGLOBTESTSETUP1CLASSCLASS_7.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASSCLASS)])); // $03, $60, $90, $40, $00 VarGLOBTESTSETUP1CLASSCLASS_7.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1CLASSCLASS_124); // $B6, $08, $00, $00 VarGLOBTESTSETUP1CLASSCHILDCLASS_8 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1CLASSCHILDCLASS_8.Tag := DW_TAG_variable; VarGLOBTESTSETUP1CLASSCHILDCLASS_8.Children := 0; VarGLOBTESTSETUP1CLASSCHILDCLASS_8.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1CLASSCHILDCLASS'+#0); - VarGLOBTESTSETUP1CLASSCHILDCLASS_8.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409070)])); // $03, $70, $90, $40, $00 + VarGLOBTESTSETUP1CLASSCHILDCLASS_8.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1CLASSCHILDCLASS)])); // $03, $70, $90, $40, $00 VarGLOBTESTSETUP1CLASSCHILDCLASS_8.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1CLASSCHILDCLASS_127); // $DB, $08, $00, $00 VarGLOBTESTSETUP1OBJECT_9 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1OBJECT_9.Tag := DW_TAG_variable; VarGLOBTESTSETUP1OBJECT_9.Children := 0; VarGLOBTESTSETUP1OBJECT_9.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1OBJECT'+#0); - VarGLOBTESTSETUP1OBJECT_9.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00409080)])); // $03, $80, $90, $40, $00 + VarGLOBTESTSETUP1OBJECT_9.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1OBJECT)])); // $03, $80, $90, $40, $00 VarGLOBTESTSETUP1OBJECT_9.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTTESTSETUP1OBJECT_130); // $05, $09, $00, $00 VarGLOBTESTSETUP1OBJECTP_10 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1OBJECTP_10.Tag := DW_TAG_variable; VarGLOBTESTSETUP1OBJECTP_10.Children := 0; VarGLOBTESTSETUP1OBJECTP_10.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1OBJECTP'+#0); - VarGLOBTESTSETUP1OBJECTP_10.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($004090C0)])); // $03, $C0, $90, $40, $00 + VarGLOBTESTSETUP1OBJECTP_10.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1OBJECTP)])); // $03, $C0, $90, $40, $00 VarGLOBTESTSETUP1OBJECTP_10.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclPTESTSETUP1OBJECT_145); // $F6, $09, $00, $00 VarGLOBTESTSETUP1POINTER_11 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1POINTER_11.Tag := DW_TAG_variable; VarGLOBTESTSETUP1POINTER_11.Children := 0; VarGLOBTESTSETUP1POINTER_11.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1POINTER'+#0); - VarGLOBTESTSETUP1POINTER_11.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00000000)])); // $03, $00, $00, $00, $00 + VarGLOBTESTSETUP1POINTER_11.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1POINTER)])); // $03, $00, $00, $00, $00 VarGLOBTESTSETUP1POINTER_11.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclPOINTER_85); // $C0, $06, $00, $00 VarGLOBTESTSETUP1QWORD_12 := Unitdwarfsetup1_lpr_0.GetNewChild; VarGLOBTESTSETUP1QWORD_12.Tag := DW_TAG_variable; VarGLOBTESTSETUP1QWORD_12.Children := 0; VarGLOBTESTSETUP1QWORD_12.Add(DW_AT_name, DW_FORM_string, 'GLOBTESTSETUP1QWORD'+#0); - VarGLOBTESTSETUP1QWORD_12.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB($00000000)])); // $03, $00, $00, $00, $00 + VarGLOBTESTSETUP1QWORD_12.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GLOBTESTSETUP1QWORD)])); // $03, $00, $00, $00, $00 VarGLOBTESTSETUP1QWORD_12.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclQWORD_79); // $8A, $06, $00, $00 Progmain_13 := Unitdwarfsetup1_lpr_0.GetNewChild; diff --git a/components/fpdebug/test/testhelperclasses.pas b/components/fpdebug/test/testhelperclasses.pas index f3ace03384..ca90ea2d4f 100644 --- a/components/fpdebug/test/testhelperclasses.pas +++ b/components/fpdebug/test/testhelperclasses.pas @@ -164,6 +164,7 @@ type function ULEB(ANum: QWord): TBytes; function SLEB(ANum: Int64): TBytes; function AddrB(ANum: Int64): TBytes; +function AddrB(ANum: Pointer): TBytes; function NumS(ANum: Int64; ASize: Integer): TBytes; function NumU(ANum: QWord; ASize: Integer): TBytes; @@ -356,6 +357,11 @@ begin else PInt64(@Result[0])^ := Int64(ANum); end; +function AddrB(ANum: Pointer): TBytes; +begin + Result := AddrB(Int64(ANum)); +end; + function NumS(ANum: Int64; ASize: Integer): TBytes; begin SetLength(Result, ASize); diff --git a/components/fpdebug/test/testtypeinfo.pas b/components/fpdebug/test/testtypeinfo.pas index dff6223af7..51131b42a2 100644 --- a/components/fpdebug/test/testtypeinfo.pas +++ b/components/fpdebug/test/testtypeinfo.pas @@ -62,6 +62,9 @@ begin end; procedure TTestTypInfo.New1; +type + TTestFlag = (ttHasType, ttNotHasType, ttHasSymbol, ttHasValSymbol, ttHasTypeSymbol); + TTestFlags = set of TTestFlag; var CurrentTestName: String; Ctx: TDbgInfoAddressContext; @@ -74,11 +77,32 @@ var Expression.Free; Expression := TTestPascalExpression.Create(Expr, Ctx); end; - procedure StartTest(Expr: String; ExtraName: String = ''); + procedure StartTest(Expr: String; TestFlags: TTestFlags = []; ExtraName: String = ''); + var + i: TTestFlag; begin InitTest(Expr, ExtraName); AssertTrue(CurrentTestName + 'valid', Expression.Valid); AssertTrue(CurrentTestName + 'has ResVal', Expression.ResultValue <> nil); + for i := low(TTestFlags) to high(TTestFlags) do + if i in TestFlags then + case i of + ttHasType: AssertTrue('hastype', Expression.ResultValue.TypeInfo <> nil); + ttNotHasType: AssertTrue('has not type', Expression.ResultValue.TypeInfo = nil); + ttHasSymbol: AssertTrue('hassymbol', Expression.ResultValue.DbgSymbol <> nil); + ttHasValSymbol: AssertTrue('hassymbol', (Expression.ResultValue.DbgSymbol <> nil) and + (Expression.ResultValue.DbgSymbol.SymbolType = stValue)); + ttHasTypeSymbol: AssertTrue('hassymbol', (Expression.ResultValue.DbgSymbol <> nil) and + (Expression.ResultValue.DbgSymbol.SymbolType = stType)); + end; + end; + procedure StartTest(Expr: String; ExpKind: TDbgSymbolKind; TestFlags: TTestFlags = []; ExtraName: String = ''); + var + s: String; + begin + StartTest(Expr, TestFlags, ExtraName); + WriteStr(s, 'Kind exected ', ExpKind, ' but was ', Expression.ResultValue.Kind); + AssertTrue(s, Expression.ResultValue.Kind = ExpKind); end; procedure StartInvalTest(Expr: String; ExpError: String; ExtraName: String = ''); begin @@ -215,11 +239,20 @@ begin AssertTrue('got sym', sym <> nil); sym.ReleaseReference(); - StartTest('Int1'); + // Not existing + StartInvalTest('NotExisting1399', 'xxx'); + + // Not Existing Typecast + StartInvalTest('TNotExisting1399(Int1)', 'xxx'); + + + + StartTest('Int1', skInteger, [ttHasType]); ExpResult(svfInteger, -299); ExpFlags([svfInteger, svfOrdinal, svfAddress]); // svfSize; StartTest('@Int1'); +// TODO: dataAddr ExpResult(svfCardinal, PtrUInt(@ImageLoader.TestStackFrame.Int1)); ExpFlags([svfCardinal, svfOrdinal], [svfAddress]); @@ -306,7 +339,7 @@ begin StartTest('(@Obj1)^.FWord'); ExpResult(svfCardinal, 1019); - ExpFlags([svfCardinal, svfOrdinal, svfAddress]); // svfSize; + ExpFlags([svfCardinal, svfOrdinal, svfAddress]); // svfSize; // StartTest('(@Obj1.FWord)^'); ExpResult(svfCardinal, 1019); @@ -334,13 +367,67 @@ begin ExpFlags([svfInteger, svfOrdinal, svfAddress]); - // Not existing - StartInvalTest('NotExisting1399', 'xxx'); + // pointer + ImageLoader.TestStackFrame.Int1 := -299; + ImageLoader.TestStackFrame.pi := @ImageLoader.TestStackFrame.int1; + GlobTestSetup1Pointer := @ImageLoader.TestStackFrame.int1; + GlobTestSetup1QWord := QWord(@ImageLoader.TestStackFrame.int1); - // Not Existing Typecast - StartInvalTest('TNotExisting1399(Int1)', 'xxx'); + StartTest('pi', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@ImageLoader.TestStackFrame.pi)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + StartTest('GlobTestSetup1Pointer', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@GlobTestSetup1Pointer)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + StartTest('pointer(pi)', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@ImageLoader.TestStackFrame.pi)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + + StartTest('PInt(pi)', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@ImageLoader.TestStackFrame.pi)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + + StartTest('PTestSetup1Class(pi)', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@ImageLoader.TestStackFrame.pi)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + + StartTest('pointer(GlobTestSetup1Pointer)', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@GlobTestSetup1Pointer)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + + StartTest('pint(GlobTestSetup1Pointer)', skPointer, [ttHasType]); + ExpResult(svfOrdinal, QWord(@ImageLoader.TestStackFrame.int1)); + ExpResult(svfAddress, QWord(@GlobTestSetup1Pointer)); + ExpResult(svfDataAddress, QWord(@ImageLoader.TestStackFrame.int1)); + ExpFlags([svfOrdinal, svfAddress, svfDataAddress, svfSizeOfPointer]); + + StartTest('pi^', skInteger, [ttHasType]); + ExpResult(svfInteger, -299); + ExpFlags([svfInteger, svfOrdinal, svfAddress], [svfDataAddress]); // svfSize; + + StartTest('PInt(pi)^', skInteger, [ttHasType]); + ExpResult(svfInteger, -299); + ExpFlags([svfInteger, svfOrdinal, svfAddress], [svfDataAddress]); // svfSize; + + StartTest('PInt(GlobTestSetup1Pointer)^', skInteger, [ttHasType]); + ExpResult(svfInteger, -299); + ExpFlags([svfInteger, svfOrdinal, svfAddress], [svfDataAddress]); // svfSize; + + // TODO Integer(pointer(pi)^) /////////////////////////// finally