mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 03:39:21 +02:00
FPDebug: Value handling / size field
git-svn-id: trunk@43945 -
This commit is contained in:
martin
parent
2a4cc692f8
commit
2cc1500342
@ -635,6 +635,7 @@ type
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
function GetAsCardinal: QWord; override;
|
||||
function GetAsInteger: Int64; override;
|
||||
function GetSize: Integer; override;
|
||||
public
|
||||
constructor Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
|
||||
end;
|
||||
@ -698,6 +699,8 @@ type
|
||||
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
|
||||
function GetAsCardinal: QWord; override;
|
||||
function GetDataAddress: TDbgPtr; override;
|
||||
function GetDataSize: Integer; override;
|
||||
function GetSize: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfStructTypeCastSymbolValue }
|
||||
@ -711,6 +714,8 @@ type
|
||||
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
|
||||
function GetKind: TDbgSymbolKind; override;
|
||||
function GetAsCardinal: QWord; override;
|
||||
function GetSize: Integer; override;
|
||||
function GetDataSize: Integer; override;
|
||||
function GetDataAddress: TDbgPtr; override;
|
||||
function GetDwarfDataAddress(out AnAddress: TDbgPtr; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean; reintroduce;
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
@ -1060,6 +1065,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
procedure TypeInfoNeeded; override; // nil or inherited
|
||||
procedure SizeNeeded; override;
|
||||
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
|
||||
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
@ -1730,7 +1736,11 @@ end;
|
||||
function TDbgDwarfStructSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
Result := inherited GetFieldFlags;
|
||||
Result := Result + [svfMembers]; // svfDataSize
|
||||
Result := Result + [svfMembers];
|
||||
if kind = skClass then // todo detect hidden pointer
|
||||
Result := Result + [svfDataSize]
|
||||
else
|
||||
Result := Result + [svfSize];
|
||||
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
|
||||
if Kind in [skClass] then begin
|
||||
Result := Result + [svfDataAddress, svfSizeOfPointer]; // svfDataSize
|
||||
@ -1763,12 +1773,32 @@ begin
|
||||
Result := inherited GetDataAddress;
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructSymbolValue.GetDataSize: Integer;
|
||||
begin
|
||||
if (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then
|
||||
Result := FValueSymbol.TypeInfo.Size
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructSymbolValue.GetSize: Integer;
|
||||
begin
|
||||
if (Kind <> skClass) and (FValueSymbol <> nil) and (FValueSymbol.TypeInfo <> nil) then
|
||||
Result := FValueSymbol.TypeInfo.Size
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfStructSymbolValue }
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
Result := inherited GetFieldFlags;
|
||||
Result := Result + [svfMembers]; // svfDataSize
|
||||
Result := Result + [svfMembers];
|
||||
if kind = skClass then // todo detect hidden pointer
|
||||
Result := Result + [svfDataSize]
|
||||
else
|
||||
Result := Result + [svfSize];
|
||||
|
||||
//TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
|
||||
if Kind in [skClass] then
|
||||
@ -1788,6 +1818,22 @@ begin
|
||||
Result := QWord(DataAddress);
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.GetSize: Integer;
|
||||
begin
|
||||
if (Kind <> skClass) and (FTypeCastInfo <> nil) then
|
||||
Result := FTypeCastInfo.Size
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.GetDataSize: Integer;
|
||||
begin
|
||||
if FTypeCastInfo <> nil then
|
||||
Result := FTypeCastInfo.Size
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.GetDataAddress: TDbgPtr;
|
||||
var
|
||||
fields: TDbgSymbolValueFieldFlags;
|
||||
@ -1848,9 +1894,7 @@ begin
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
DebugLnEnter(['>>> TDbgDwarfStructSymbolValue.GetDataAddress ', IntToHex(AnAddress,8)]);
|
||||
Result := FTypeCastInfo.GetDataAddress(AnAddress, ATargetType);
|
||||
DebugLnExit(['<<< TDbgDwarfStructSymbolValue.GetDataAddress ']);
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.IsValidTypeCast: Boolean;
|
||||
@ -2019,7 +2063,7 @@ begin
|
||||
exit
|
||||
else
|
||||
if (FTypeCastSource.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
||||
(FTypeCastSource.Size = FSize)
|
||||
(FTypeCastSource.Size = FSize) and (FSize > 0)
|
||||
then
|
||||
exit;
|
||||
if (FTypeCastSource.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and
|
||||
@ -2068,6 +2112,11 @@ begin
|
||||
FIntValue := Result;
|
||||
end;
|
||||
|
||||
function TDbgDwarfNumericSymbolValue.GetSize: Integer;
|
||||
begin
|
||||
Result := FSize;
|
||||
end;
|
||||
|
||||
constructor TDbgDwarfNumericSymbolValue.Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
@ -4632,7 +4681,6 @@ begin
|
||||
Result := FCU.FOwner.MemReader <> nil;
|
||||
if not Result then
|
||||
exit;
|
||||
DebugLnEnter(['>>> POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
|
||||
//TODO: zero fill / sign extend
|
||||
case FCU.FAddressSize of
|
||||
4: begin
|
||||
@ -4648,7 +4696,6 @@ DebugLnEnter(['>>> POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
|
||||
end;
|
||||
if Result then
|
||||
Result := inherited GetDataAddress(AnAddress, ATargetType);
|
||||
DebugLnExit(['<<< POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
|
||||
end;
|
||||
|
||||
function TDbgDwarfTypeIdentifierPointer.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
|
||||
@ -4742,9 +4789,7 @@ begin
|
||||
exit;
|
||||
Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress');
|
||||
AnAddress := Address;
|
||||
DebugLnEnter(['>>> TDbgDwarfValueIdentifier.GetDataAddress ', IntToHex(AnAddress,8)]);
|
||||
Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType);
|
||||
DebugLnExit(['<<< TDbgDwarfValueIdentifier.GetDataAddress ']);
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfValueIdentifier.KindNeeded;
|
||||
@ -4967,24 +5012,20 @@ procedure TDbgDwarfIdentifierMember.InitLocationParser(const ALocationParser: TD
|
||||
var
|
||||
BaseAddr: TDbgPtr;
|
||||
begin
|
||||
DebugLnEnter(['>>> TDbgDwarfIdentifierMember.InitLocationParser ',Self.Name]);
|
||||
inherited InitLocationParser(ALocationParser, AnObjectDataAddress);
|
||||
|
||||
if (StructureValueInfo <> nil) and (ParentTypeInfo <> nil) then begin
|
||||
DebugLn(['TDbgDwarfIdentifierMember.InitLocationParser AAA']);
|
||||
Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), '');
|
||||
|
||||
if StructureValueInfo is TDbgDwarfValueIdentifier then begin
|
||||
if TDbgDwarfValueIdentifier(StructureValueInfo).GetDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
|
||||
ALocationParser.FStack.Push(BaseAddr, lseValue);
|
||||
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser GOOD ', BaseAddr,' ',IntToHex(BaseAddr,8)]);
|
||||
exit
|
||||
end;
|
||||
end;
|
||||
if StructureValueInfo is TDbgDwarfStructTypeCastSymbolValue then begin
|
||||
if TDbgDwarfStructTypeCastSymbolValue(StructureValueInfo).GetDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
|
||||
ALocationParser.FStack.Push(BaseAddr, lseValue);
|
||||
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser GOOD ', BaseAddr,' ',IntToHex(BaseAddr,8)]);
|
||||
exit
|
||||
end;
|
||||
end;
|
||||
@ -4992,20 +5033,16 @@ DebugLn(['TDbgDwarfIdentifierMember.InitLocationParser AAA']);
|
||||
end;
|
||||
|
||||
//TODO: error
|
||||
debugln(['TDbgDwarfIdentifierMember.InitLocationParser FAILED']);
|
||||
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser ']);
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierMember.AddressNeeded;
|
||||
var
|
||||
t: TDbgPtr;
|
||||
begin
|
||||
DebugLnEnter(['>>> TDbgDwarfIdentifierMember.AddressNeeded ']);
|
||||
if LocationFromTag(DW_AT_data_member_location, t) then
|
||||
SetAddress(t)
|
||||
else
|
||||
SetAddress(0);
|
||||
DebugLnExit(['<<< ',t]);
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierMember.HasAddress: Boolean;
|
||||
@ -5087,19 +5124,15 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
DebugLnEnter(['>>> STRUCT TDbgDwarfIdentifierStructure.GetDataAddress ']); try
|
||||
InitInheritanceInfo;
|
||||
DebugLn([DbgSName(FInheritanceInfo)]);
|
||||
|
||||
//TODO: may be a constant // offset
|
||||
Result := LocationFromTag(DW_AT_data_member_location, t, AnAddress, FInheritanceInfo);
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
debugln(['TDbgDwarfIdentifierStructure.GetDataAddress ', IntToHex(AnAddress,8), ' new ',IntToHex(t,8) ]);
|
||||
AnAddress := t;
|
||||
Result := inherited GetDataAddress(AnAddress, ATargetType);
|
||||
finally DebugLnExit(['>>> STRUCT TDbgDwarfIdentifierStructure.GetDataAddress ']);end;
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetMember(AIndex: Integer): TDbgSymbol;
|
||||
@ -5199,6 +5232,16 @@ begin
|
||||
ti.ReleaseReference;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierStructure.SizeNeeded;
|
||||
var
|
||||
ByteSize: Integer;
|
||||
begin
|
||||
if FInformationEntry.ReadValue(DW_AT_byte_size, ByteSize) then
|
||||
SetSize(ByteSize)
|
||||
else
|
||||
SetSize(0);
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierStructure.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
|
||||
begin
|
||||
if ATypeCast then
|
||||
@ -5513,7 +5556,6 @@ function TDbgDwarfIdentifier.GetDataAddress(var AnAddress: TDbgPtr;
|
||||
var
|
||||
ti: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
debugln(['TDbgDwarfIdentifier.GetDataAddress ',DbgSName(Self), ' targ ',DbgSName(ATargetType)]);
|
||||
if ATargetType = Self then begin
|
||||
Result := True;
|
||||
end
|
||||
|
||||
@ -150,7 +150,7 @@ type
|
||||
function GetAsWideString: WideString; virtual;
|
||||
|
||||
function GetAddress: TDbgPtr; virtual;
|
||||
function GetSize: Integer; virtual;
|
||||
function GetSize: Integer; virtual; // returns -1, if not available
|
||||
function GetDataAddress: TDbgPtr; virtual;
|
||||
function GetDataSize: Integer; virtual;
|
||||
|
||||
@ -526,7 +526,7 @@ end;
|
||||
|
||||
function TDbgSymbolValue.GetSize: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetAsBool: Boolean;
|
||||
|
||||
@ -571,7 +571,7 @@ end;
|
||||
function TPasParserSymbolValueCastToPointer.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
if svfCardinal in FValue.FieldFlags then
|
||||
Result := [svfOrdinal, svfCardinal, svfDataAddress]
|
||||
Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress]
|
||||
else
|
||||
Result := [];
|
||||
end;
|
||||
@ -768,7 +768,7 @@ end;
|
||||
|
||||
function TPasParserSymbolValueAddressOf.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
Result := [svfOrdinal, svfCardinal, svfDataAddress];
|
||||
Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress];
|
||||
end;
|
||||
|
||||
function TPasParserSymbolValueAddressOf.GetAsInteger: Int64;
|
||||
|
||||
@ -18,13 +18,13 @@ type
|
||||
protected
|
||||
FDwarfInfo: TDbgDwarf;
|
||||
published
|
||||
Procedure New1;
|
||||
procedure X;
|
||||
Procedure TestExpressions;
|
||||
procedure TestCompareUtf8BothCase;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TTestTypInfo.X;
|
||||
procedure TTestTypInfo.TestCompareUtf8BothCase;
|
||||
var
|
||||
s1, s2,s3: String;
|
||||
begin
|
||||
@ -41,7 +41,7 @@ begin
|
||||
AssertFalse( CompareUtf8BothCase(@s2[1],@s3[1],@s1[1]) );
|
||||
end;
|
||||
|
||||
procedure TTestTypInfo.New1;
|
||||
procedure TTestTypInfo.TestExpressions;
|
||||
type
|
||||
TTestFlag = (ttHasType, ttNotHasType, ttHasSymbol, ttHasValSymbol, ttHasTypeSymbol);
|
||||
TTestFlags = set of TTestFlag;
|
||||
@ -50,6 +50,26 @@ var
|
||||
Ctx: TDbgInfoAddressContext;
|
||||
Expression: TFpPascalExpression;
|
||||
|
||||
procedure ExpFlags(ExpFlags: TDbgSymbolValueFieldFlags; ExpNotFlags: TDbgSymbolValueFieldFlags = []);
|
||||
var
|
||||
i: TDbgSymbolValueFieldFlag;
|
||||
s: string;
|
||||
f: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
AssertTrue(CurrentTestName + 'has ResVal', Expression.ResultValue <> nil);
|
||||
f := Expression.ResultValue.FieldFlags;
|
||||
For i := low(TDbgSymbolValueFieldFlag) to High(TDbgSymbolValueFieldFlag) do
|
||||
if i in ExpFlags then begin
|
||||
WriteStr(s, i);
|
||||
AssertTrue(CurrentTestName + 'Has flag' + s, i in f);
|
||||
end;
|
||||
For i := low(TDbgSymbolValueFieldFlag) to High(TDbgSymbolValueFieldFlag) do
|
||||
if i in ExpNotFlags then begin
|
||||
WriteStr(s, i);
|
||||
AssertTrue(CurrentTestName + 'Has NOT flag' + s, not (i in f));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitTest(Expr: String; ExtraName: String = '');
|
||||
begin
|
||||
if ExtraName <> '' then ExtraName := ' (' + ExtraName + ')';
|
||||
@ -88,7 +108,40 @@ var
|
||||
WriteStr(s, CurrentTestName, 'typeinfo.Kind exected ', ExpKind, ' but was ', Expression.ResultValue.TypeInfo.Kind);
|
||||
AssertTrue(s, Expression.ResultValue.TypeInfo.Kind = ExpKind);
|
||||
end;
|
||||
// some general assumptions
|
||||
s := CurrentTestName;
|
||||
WriteStr(CurrentTestName, s, ' Expecting for kind:', ExpKind);
|
||||
case ExpKind of
|
||||
skInstance: ;
|
||||
skUnit: ;
|
||||
skRecord: ExpFlags([svfMembers], [svfOrdinal, svfInteger, svfCardinal, svfDataAddress, svfDataSize]);
|
||||
skObject: ExpFlags([svfMembers], [svfOrdinal, svfInteger, svfCardinal, svfDataAddress, svfDataSize]);
|
||||
// skClass does NOT have svfSize (maybe svfSizeOfPointer ?);
|
||||
skClass: ExpFlags([svfOrdinal, svfMembers, svfDataAddress, svfDataSize], [svfSize, svfInteger, svfCardinal]);
|
||||
skInterface: ;
|
||||
skProcedure: ;
|
||||
skFunction: ;
|
||||
skArray: ;
|
||||
// skPointer: svfOrdinal, svfCardinal, svfDataAddress are all the same value
|
||||
skPointer: ExpFlags([svfOrdinal, svfCardinal, svfDataAddress, svfSizeOfPointer], [svfMembers]);
|
||||
skInteger: ExpFlags([svfOrdinal, svfInteger], [svfDataAddress, svfDataSize, svfMembers]);
|
||||
skCardinal: ExpFlags([svfOrdinal, svfCardinal], [svfDataAddress, svfDataSize, svfMembers]);
|
||||
skBoolean: ;
|
||||
skChar: ;
|
||||
skFloat: ;
|
||||
skString: ;
|
||||
skAnsiString: ;
|
||||
skCurrency: ;
|
||||
skVariant: ;
|
||||
skWideString: ;
|
||||
skEnum: ;
|
||||
skEnumValue: ;
|
||||
skSet: ;
|
||||
skRegister: ;
|
||||
end;
|
||||
CurrentTestName := s;
|
||||
end;
|
||||
|
||||
procedure StartInvalTest(Expr: String; ExpError: String; ExtraName: String = '');
|
||||
begin
|
||||
InitTest(Expr, ExtraName);
|
||||
@ -98,25 +151,6 @@ var
|
||||
//ExpError
|
||||
end;
|
||||
|
||||
procedure ExpFlags(ExpFlags: TDbgSymbolValueFieldFlags; ExpNotFlags: TDbgSymbolValueFieldFlags = []);
|
||||
var
|
||||
i: TDbgSymbolValueFieldFlag;
|
||||
s: string;
|
||||
f: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
AssertTrue(CurrentTestName + 'has ResVal', Expression.ResultValue <> nil);
|
||||
f := Expression.ResultValue.FieldFlags;
|
||||
For i := low(TDbgSymbolValueFieldFlag) to High(TDbgSymbolValueFieldFlag) do
|
||||
if i in ExpFlags then begin
|
||||
WriteStr(s, i);
|
||||
AssertTrue(CurrentTestName + 'Has flag' + s, i in f);
|
||||
end;
|
||||
For i := low(TDbgSymbolValueFieldFlag) to High(TDbgSymbolValueFieldFlag) do
|
||||
if i in ExpNotFlags then begin
|
||||
WriteStr(s, i);
|
||||
AssertTrue(CurrentTestName + 'Has NOT flag' + s, not (i in f));
|
||||
end;
|
||||
end;
|
||||
procedure ExpResult(Field: TDbgSymbolValueFieldFlag; ExpValue: QWord);
|
||||
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
|
||||
begin
|
||||
@ -238,8 +272,14 @@ begin
|
||||
StartInvalTest('^longint(@99)', 'xxx');
|
||||
StartInvalTest('PInt(@99)', 'xxx');
|
||||
StartInvalTest('@Int1^', 'xxx');
|
||||
StartInvalTest('^(longint(Int1))', 'xxx'); // no ( allowed between ^ and type
|
||||
|
||||
|
||||
StartTest('LongInt', [ttHasSymbol, ttNotHasType]);
|
||||
StartTest('^LongInt', [ttHasSymbol, ttNotHasType]);
|
||||
StartTest('TObject', [ttHasSymbol, ttNotHasType]);
|
||||
StartTest('^TObject', [ttHasSymbol, ttNotHasType]);
|
||||
|
||||
|
||||
// TODO: maybe treat numbers as integer?
|
||||
StartTest('244', skCardinal, []);
|
||||
@ -250,7 +290,7 @@ begin
|
||||
ImageLoader.TestStackFrame.pint1 := @ImageLoader.TestStackFrame.Int1;
|
||||
ImageLoader.GlobTestSetup1.VarQWord := PtrInt(@ImageLoader.TestStackFrame.pint1);
|
||||
ImageLoader.GlobTestSetup1.VarPointer := @ImageLoader.TestStackFrame.pint1;
|
||||
for i := 0 to 17 do begin
|
||||
for i := 0 to 22 do begin
|
||||
case i of
|
||||
0: s := 'Int1';
|
||||
1: s := 'longint(Int1)';
|
||||
@ -270,6 +310,11 @@ begin
|
||||
15: s := '^^longint(GlobTestSetup1QWord)^^';
|
||||
16: s := '^^^longint(@GlobTestSetup1QWord)^^^';
|
||||
17: s := '^^^longint('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^^^';
|
||||
18: s := '(^^^longint('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^^)^';
|
||||
19: s := '(^^^longint('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^)^^';
|
||||
20: s := '((^^^longint('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^)^)^';
|
||||
21: s := '^^PInt('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^^^';
|
||||
22: s := '(^^PInt('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^^)^';
|
||||
end;
|
||||
|
||||
StartTest(s, skInteger, [ttHasType]);
|
||||
@ -277,6 +322,10 @@ begin
|
||||
ExpResult(svfInteger, -299);
|
||||
ExpResult(svfOrdinal, QWord(-299));
|
||||
ExpResult(svfAddress, TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.Int1)));
|
||||
case i of
|
||||
0,1,3..7,10..22: ExpResult(svfSize, 4); // integer
|
||||
2,8: ExpResult(svfSize, 8); // int64
|
||||
end;
|
||||
end;
|
||||
|
||||
for i := 0 to 19 do begin
|
||||
@ -355,9 +404,9 @@ begin
|
||||
Obj1.FWord := 1019;
|
||||
Obj1.FWordL := QWord($9aa99aa97bb7b77b); // Make sure there is data, if other fields read to much
|
||||
|
||||
for i := 0 to 22 do begin
|
||||
for i := 0 to 23 do begin
|
||||
case i of
|
||||
11..13: ImageLoader.GlobTestSetup1.VarPointer := @ImageLoader.TestStackFrame.Obj1;
|
||||
11..13, 23: ImageLoader.GlobTestSetup1.VarPointer := @ImageLoader.TestStackFrame.Obj1;
|
||||
14: ImageLoader.GlobTestSetup1.VarPointer := Pointer(ImageLoader.TestStackFrame.Obj1);
|
||||
end;
|
||||
// Different ways to access an object
|
||||
@ -392,6 +441,7 @@ begin
|
||||
20: s := '(@PObj1)^^';
|
||||
21: s := 'VParamTestSetup1Class';
|
||||
22: s := 'VParamTestSetup1ClassP^';
|
||||
23: s := '^TTestSetup1Class(GlobTestSetup1Pointer)^';
|
||||
end;
|
||||
FieldsExp := [svfMembers, svfOrdinal, svfAddress, svfDataAddress]; // svfSize dataSize;
|
||||
AddrExp := TDbgPtr(@ImageLoader.TestStackFrame.Obj1);
|
||||
@ -408,6 +458,10 @@ begin
|
||||
ExpResult(svfAddress, AddrExp);
|
||||
ExpResult(svfDataAddress, TDbgPtr(PtrUInt(ImageLoader.TestStackFrame.Obj1)));
|
||||
ExpResult(svfOrdinal, PtrUInt (ImageLoader.TestStackFrame.Obj1));
|
||||
case i of
|
||||
5,6: ExpResult(svfDataSize, TObject.InstanceSize);
|
||||
else ExpResult(svfDataSize, ImageLoader.TestStackFrame.Obj1.InstanceSize);
|
||||
end;
|
||||
|
||||
|
||||
// Check result for @object
|
||||
@ -522,6 +576,7 @@ begin
|
||||
// svfSize;
|
||||
ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]);
|
||||
ExpResult(svfAddress, TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.Rec1)));
|
||||
ExpResult(svfSize, SizeOf(ImageLoader.TestStackFrame.Rec1));
|
||||
|
||||
|
||||
StartTest(s+'.FWord', skCardinal, [ttHasType]);
|
||||
@ -586,6 +641,7 @@ begin
|
||||
StartTest(s, skObject, [ttHasType]);
|
||||
ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]);
|
||||
ExpResult(svfAddress, AddrExp);
|
||||
ExpResult(svfSize, SizeOf(ImageLoader.TestStackFrame.OldObj1));
|
||||
|
||||
case i of
|
||||
2,4: AddrExp := TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.OldObj1.FWord));
|
||||
|
||||
Loading…
Reference in New Issue
Block a user