FPDebug: Value handling / size field

git-svn-id: trunk@43945 -
This commit is contained in:
martin 2014-02-07 23:40:17 +00:00
parent 2a4cc692f8
commit 2cc1500342
4 changed files with 150 additions and 52 deletions

View File

@ -635,6 +635,7 @@ type
function IsValidTypeCast: Boolean; override; function IsValidTypeCast: Boolean; override;
function GetAsCardinal: QWord; override; function GetAsCardinal: QWord; override;
function GetAsInteger: Int64; override; function GetAsInteger: Int64; override;
function GetSize: Integer; override;
public public
constructor Create(AOwner: TDbgDwarfIdentifier; ASize: Integer); constructor Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
end; end;
@ -698,6 +699,8 @@ type
function GetFieldFlags: TDbgSymbolValueFieldFlags; override; function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetAsCardinal: QWord; override; function GetAsCardinal: QWord; override;
function GetDataAddress: TDbgPtr; override; function GetDataAddress: TDbgPtr; override;
function GetDataSize: Integer; override;
function GetSize: Integer; override;
end; end;
{ TDbgDwarfStructTypeCastSymbolValue } { TDbgDwarfStructTypeCastSymbolValue }
@ -711,6 +714,8 @@ type
function GetFieldFlags: TDbgSymbolValueFieldFlags; override; function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
function GetKind: TDbgSymbolKind; override; function GetKind: TDbgSymbolKind; override;
function GetAsCardinal: QWord; override; function GetAsCardinal: QWord; override;
function GetSize: Integer; override;
function GetDataSize: Integer; override;
function GetDataAddress: TDbgPtr; override; function GetDataAddress: TDbgPtr; override;
function GetDwarfDataAddress(out AnAddress: TDbgPtr; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean; reintroduce; function GetDwarfDataAddress(out AnAddress: TDbgPtr; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean; reintroduce;
function IsValidTypeCast: Boolean; override; function IsValidTypeCast: Boolean; override;
@ -1060,6 +1065,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
protected protected
procedure KindNeeded; override; procedure KindNeeded; override;
procedure TypeInfoNeeded; override; // nil or inherited procedure TypeInfoNeeded; override; // nil or inherited
procedure SizeNeeded; override;
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override; function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
function GetMember(AIndex: Integer): TDbgSymbol; override; function GetMember(AIndex: Integer): TDbgSymbol; override;
@ -1730,7 +1736,11 @@ end;
function TDbgDwarfStructSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags; function TDbgDwarfStructSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin begin
Result := inherited GetFieldFlags; 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 //TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
if Kind in [skClass] then begin if Kind in [skClass] then begin
Result := Result + [svfDataAddress, svfSizeOfPointer]; // svfDataSize Result := Result + [svfDataAddress, svfSizeOfPointer]; // svfDataSize
@ -1763,12 +1773,32 @@ begin
Result := inherited GetDataAddress; Result := inherited GetDataAddress;
end; 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 } { TDbgDwarfStructSymbolValue }
function TDbgDwarfStructTypeCastSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags; function TDbgDwarfStructTypeCastSymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin begin
Result := inherited GetFieldFlags; 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 //TODO: svfDataAddress should depend on (hidden) Pointer or Ref in the TypeInfo
if Kind in [skClass] then if Kind in [skClass] then
@ -1788,6 +1818,22 @@ begin
Result := QWord(DataAddress); Result := QWord(DataAddress);
end; 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; function TDbgDwarfStructTypeCastSymbolValue.GetDataAddress: TDbgPtr;
var var
fields: TDbgSymbolValueFieldFlags; fields: TDbgSymbolValueFieldFlags;
@ -1848,9 +1894,7 @@ begin
if not Result then if not Result then
exit; exit;
DebugLnEnter(['>>> TDbgDwarfStructSymbolValue.GetDataAddress ', IntToHex(AnAddress,8)]);
Result := FTypeCastInfo.GetDataAddress(AnAddress, ATargetType); Result := FTypeCastInfo.GetDataAddress(AnAddress, ATargetType);
DebugLnExit(['<<< TDbgDwarfStructSymbolValue.GetDataAddress ']);
end; end;
function TDbgDwarfStructTypeCastSymbolValue.IsValidTypeCast: Boolean; function TDbgDwarfStructTypeCastSymbolValue.IsValidTypeCast: Boolean;
@ -2019,7 +2063,7 @@ begin
exit exit
else else
if (FTypeCastSource.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) and if (FTypeCastSource.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) and
(FTypeCastSource.Size = FSize) (FTypeCastSource.Size = FSize) and (FSize > 0)
then then
exit; exit;
if (FTypeCastSource.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and if (FTypeCastSource.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer]) and
@ -2068,6 +2112,11 @@ begin
FIntValue := Result; FIntValue := Result;
end; end;
function TDbgDwarfNumericSymbolValue.GetSize: Integer;
begin
Result := FSize;
end;
constructor TDbgDwarfNumericSymbolValue.Create(AOwner: TDbgDwarfIdentifier; ASize: Integer); constructor TDbgDwarfNumericSymbolValue.Create(AOwner: TDbgDwarfIdentifier; ASize: Integer);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
@ -4632,7 +4681,6 @@ begin
Result := FCU.FOwner.MemReader <> nil; Result := FCU.FOwner.MemReader <> nil;
if not Result then if not Result then
exit; exit;
DebugLnEnter(['>>> POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
//TODO: zero fill / sign extend //TODO: zero fill / sign extend
case FCU.FAddressSize of case FCU.FAddressSize of
4: begin 4: begin
@ -4648,7 +4696,6 @@ DebugLnEnter(['>>> POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
end; end;
if Result then if Result then
Result := inherited GetDataAddress(AnAddress, ATargetType); Result := inherited GetDataAddress(AnAddress, ATargetType);
DebugLnExit(['<<< POINTER TDbgDwarfTypeIdentifierPointer.GetDataAddress ']);
end; end;
function TDbgDwarfTypeIdentifierPointer.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; function TDbgDwarfTypeIdentifierPointer.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
@ -4742,9 +4789,7 @@ begin
exit; exit;
Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress'); Assert((TypeInfo is TDbgDwarfIdentifier) and (TypeInfo.SymbolType = stType), 'TDbgDwarfValueIdentifier.GetDataAddress');
AnAddress := Address; AnAddress := Address;
DebugLnEnter(['>>> TDbgDwarfValueIdentifier.GetDataAddress ', IntToHex(AnAddress,8)]);
Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType); Result := TDbgDwarfTypeIdentifier(TypeInfo).GetDataAddress(AnAddress, ATargetType);
DebugLnExit(['<<< TDbgDwarfValueIdentifier.GetDataAddress ']);
end; end;
procedure TDbgDwarfValueIdentifier.KindNeeded; procedure TDbgDwarfValueIdentifier.KindNeeded;
@ -4967,24 +5012,20 @@ procedure TDbgDwarfIdentifierMember.InitLocationParser(const ALocationParser: TD
var var
BaseAddr: TDbgPtr; BaseAddr: TDbgPtr;
begin begin
DebugLnEnter(['>>> TDbgDwarfIdentifierMember.InitLocationParser ',Self.Name]);
inherited InitLocationParser(ALocationParser, AnObjectDataAddress); inherited InitLocationParser(ALocationParser, AnObjectDataAddress);
if (StructureValueInfo <> nil) and (ParentTypeInfo <> nil) then begin if (StructureValueInfo <> nil) and (ParentTypeInfo <> nil) then begin
DebugLn(['TDbgDwarfIdentifierMember.InitLocationParser AAA']);
Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), ''); Assert((ParentTypeInfo is TDbgDwarfIdentifier) and (ParentTypeInfo.SymbolType = stType), '');
if StructureValueInfo is TDbgDwarfValueIdentifier then begin if StructureValueInfo is TDbgDwarfValueIdentifier then begin
if TDbgDwarfValueIdentifier(StructureValueInfo).GetDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin if TDbgDwarfValueIdentifier(StructureValueInfo).GetDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
ALocationParser.FStack.Push(BaseAddr, lseValue); ALocationParser.FStack.Push(BaseAddr, lseValue);
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser GOOD ', BaseAddr,' ',IntToHex(BaseAddr,8)]);
exit exit
end; end;
end; end;
if StructureValueInfo is TDbgDwarfStructTypeCastSymbolValue then begin if StructureValueInfo is TDbgDwarfStructTypeCastSymbolValue then begin
if TDbgDwarfStructTypeCastSymbolValue(StructureValueInfo).GetDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin if TDbgDwarfStructTypeCastSymbolValue(StructureValueInfo).GetDwarfDataAddress(BaseAddr, TDbgDwarfTypeIdentifier(ParentTypeInfo)) then begin
ALocationParser.FStack.Push(BaseAddr, lseValue); ALocationParser.FStack.Push(BaseAddr, lseValue);
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser GOOD ', BaseAddr,' ',IntToHex(BaseAddr,8)]);
exit exit
end; end;
end; end;
@ -4992,20 +5033,16 @@ DebugLn(['TDbgDwarfIdentifierMember.InitLocationParser AAA']);
end; end;
//TODO: error //TODO: error
debugln(['TDbgDwarfIdentifierMember.InitLocationParser FAILED']);
DebugLnExit(['<<< TDbgDwarfIdentifierMember.InitLocationParser ']);
end; end;
procedure TDbgDwarfIdentifierMember.AddressNeeded; procedure TDbgDwarfIdentifierMember.AddressNeeded;
var var
t: TDbgPtr; t: TDbgPtr;
begin begin
DebugLnEnter(['>>> TDbgDwarfIdentifierMember.AddressNeeded ']);
if LocationFromTag(DW_AT_data_member_location, t) then if LocationFromTag(DW_AT_data_member_location, t) then
SetAddress(t) SetAddress(t)
else else
SetAddress(0); SetAddress(0);
DebugLnExit(['<<< ',t]);
end; end;
function TDbgDwarfIdentifierMember.HasAddress: Boolean; function TDbgDwarfIdentifierMember.HasAddress: Boolean;
@ -5087,19 +5124,15 @@ begin
exit; exit;
end; end;
DebugLnEnter(['>>> STRUCT TDbgDwarfIdentifierStructure.GetDataAddress ']); try
InitInheritanceInfo; InitInheritanceInfo;
DebugLn([DbgSName(FInheritanceInfo)]);
//TODO: may be a constant // offset //TODO: may be a constant // offset
Result := LocationFromTag(DW_AT_data_member_location, t, AnAddress, FInheritanceInfo); Result := LocationFromTag(DW_AT_data_member_location, t, AnAddress, FInheritanceInfo);
if not Result then if not Result then
exit; exit;
debugln(['TDbgDwarfIdentifierStructure.GetDataAddress ', IntToHex(AnAddress,8), ' new ',IntToHex(t,8) ]);
AnAddress := t; AnAddress := t;
Result := inherited GetDataAddress(AnAddress, ATargetType); Result := inherited GetDataAddress(AnAddress, ATargetType);
finally DebugLnExit(['>>> STRUCT TDbgDwarfIdentifierStructure.GetDataAddress ']);end;
end; end;
function TDbgDwarfIdentifierStructure.GetMember(AIndex: Integer): TDbgSymbol; function TDbgDwarfIdentifierStructure.GetMember(AIndex: Integer): TDbgSymbol;
@ -5199,6 +5232,16 @@ begin
ti.ReleaseReference; ti.ReleaseReference;
end; 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; function TDbgDwarfIdentifierStructure.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
begin begin
if ATypeCast then if ATypeCast then
@ -5513,7 +5556,6 @@ function TDbgDwarfIdentifier.GetDataAddress(var AnAddress: TDbgPtr;
var var
ti: TDbgDwarfTypeIdentifier; ti: TDbgDwarfTypeIdentifier;
begin begin
debugln(['TDbgDwarfIdentifier.GetDataAddress ',DbgSName(Self), ' targ ',DbgSName(ATargetType)]);
if ATargetType = Self then begin if ATargetType = Self then begin
Result := True; Result := True;
end end

View File

@ -150,7 +150,7 @@ type
function GetAsWideString: WideString; virtual; function GetAsWideString: WideString; virtual;
function GetAddress: TDbgPtr; virtual; function GetAddress: TDbgPtr; virtual;
function GetSize: Integer; virtual; function GetSize: Integer; virtual; // returns -1, if not available
function GetDataAddress: TDbgPtr; virtual; function GetDataAddress: TDbgPtr; virtual;
function GetDataSize: Integer; virtual; function GetDataSize: Integer; virtual;
@ -526,7 +526,7 @@ end;
function TDbgSymbolValue.GetSize: Integer; function TDbgSymbolValue.GetSize: Integer;
begin begin
Result := 0; Result := -1;
end; end;
function TDbgSymbolValue.GetAsBool: Boolean; function TDbgSymbolValue.GetAsBool: Boolean;

View File

@ -571,7 +571,7 @@ end;
function TPasParserSymbolValueCastToPointer.GetFieldFlags: TDbgSymbolValueFieldFlags; function TPasParserSymbolValueCastToPointer.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin begin
if svfCardinal in FValue.FieldFlags then if svfCardinal in FValue.FieldFlags then
Result := [svfOrdinal, svfCardinal, svfDataAddress] Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress]
else else
Result := []; Result := [];
end; end;
@ -768,7 +768,7 @@ end;
function TPasParserSymbolValueAddressOf.GetFieldFlags: TDbgSymbolValueFieldFlags; function TPasParserSymbolValueAddressOf.GetFieldFlags: TDbgSymbolValueFieldFlags;
begin begin
Result := [svfOrdinal, svfCardinal, svfDataAddress]; Result := [svfOrdinal, svfCardinal, svfSizeOfPointer, svfDataAddress];
end; end;
function TPasParserSymbolValueAddressOf.GetAsInteger: Int64; function TPasParserSymbolValueAddressOf.GetAsInteger: Int64;

View File

@ -18,13 +18,13 @@ type
protected protected
FDwarfInfo: TDbgDwarf; FDwarfInfo: TDbgDwarf;
published published
Procedure New1; Procedure TestExpressions;
procedure X; procedure TestCompareUtf8BothCase;
end; end;
implementation implementation
procedure TTestTypInfo.X; procedure TTestTypInfo.TestCompareUtf8BothCase;
var var
s1, s2,s3: String; s1, s2,s3: String;
begin begin
@ -41,7 +41,7 @@ begin
AssertFalse( CompareUtf8BothCase(@s2[1],@s3[1],@s1[1]) ); AssertFalse( CompareUtf8BothCase(@s2[1],@s3[1],@s1[1]) );
end; end;
procedure TTestTypInfo.New1; procedure TTestTypInfo.TestExpressions;
type type
TTestFlag = (ttHasType, ttNotHasType, ttHasSymbol, ttHasValSymbol, ttHasTypeSymbol); TTestFlag = (ttHasType, ttNotHasType, ttHasSymbol, ttHasValSymbol, ttHasTypeSymbol);
TTestFlags = set of TTestFlag; TTestFlags = set of TTestFlag;
@ -50,6 +50,26 @@ var
Ctx: TDbgInfoAddressContext; Ctx: TDbgInfoAddressContext;
Expression: TFpPascalExpression; 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 = ''); procedure InitTest(Expr: String; ExtraName: String = '');
begin begin
if ExtraName <> '' then ExtraName := ' (' + ExtraName + ')'; if ExtraName <> '' then ExtraName := ' (' + ExtraName + ')';
@ -88,7 +108,40 @@ var
WriteStr(s, CurrentTestName, 'typeinfo.Kind exected ', ExpKind, ' but was ', Expression.ResultValue.TypeInfo.Kind); WriteStr(s, CurrentTestName, 'typeinfo.Kind exected ', ExpKind, ' but was ', Expression.ResultValue.TypeInfo.Kind);
AssertTrue(s, Expression.ResultValue.TypeInfo.Kind = ExpKind); AssertTrue(s, Expression.ResultValue.TypeInfo.Kind = ExpKind);
end; 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; end;
procedure StartInvalTest(Expr: String; ExpError: String; ExtraName: String = ''); procedure StartInvalTest(Expr: String; ExpError: String; ExtraName: String = '');
begin begin
InitTest(Expr, ExtraName); InitTest(Expr, ExtraName);
@ -98,25 +151,6 @@ var
//ExpError //ExpError
end; 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 ExpResult(Field: TDbgSymbolValueFieldFlag; ExpValue: QWord);
procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord); procedure AssertEqualsQW(const AMessage: string; Expected, Actual: QWord);
begin begin
@ -238,8 +272,14 @@ begin
StartInvalTest('^longint(@99)', 'xxx'); StartInvalTest('^longint(@99)', 'xxx');
StartInvalTest('PInt(@99)', 'xxx'); StartInvalTest('PInt(@99)', 'xxx');
StartInvalTest('@Int1^', '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? // TODO: maybe treat numbers as integer?
StartTest('244', skCardinal, []); StartTest('244', skCardinal, []);
@ -250,7 +290,7 @@ begin
ImageLoader.TestStackFrame.pint1 := @ImageLoader.TestStackFrame.Int1; ImageLoader.TestStackFrame.pint1 := @ImageLoader.TestStackFrame.Int1;
ImageLoader.GlobTestSetup1.VarQWord := PtrInt(@ImageLoader.TestStackFrame.pint1); ImageLoader.GlobTestSetup1.VarQWord := PtrInt(@ImageLoader.TestStackFrame.pint1);
ImageLoader.GlobTestSetup1.VarPointer := @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 case i of
0: s := 'Int1'; 0: s := 'Int1';
1: s := 'longint(Int1)'; 1: s := 'longint(Int1)';
@ -270,6 +310,11 @@ begin
15: s := '^^longint(GlobTestSetup1QWord)^^'; 15: s := '^^longint(GlobTestSetup1QWord)^^';
16: s := '^^^longint(@GlobTestSetup1QWord)^^^'; 16: s := '^^^longint(@GlobTestSetup1QWord)^^^';
17: s := '^^^longint('+IntToStr((PtrUInt(@ImageLoader.GlobTestSetup1.VarPointer)))+')^^^'; 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; end;
StartTest(s, skInteger, [ttHasType]); StartTest(s, skInteger, [ttHasType]);
@ -277,6 +322,10 @@ begin
ExpResult(svfInteger, -299); ExpResult(svfInteger, -299);
ExpResult(svfOrdinal, QWord(-299)); ExpResult(svfOrdinal, QWord(-299));
ExpResult(svfAddress, TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.Int1))); 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; end;
for i := 0 to 19 do begin for i := 0 to 19 do begin
@ -355,9 +404,9 @@ begin
Obj1.FWord := 1019; Obj1.FWord := 1019;
Obj1.FWordL := QWord($9aa99aa97bb7b77b); // Make sure there is data, if other fields read to much 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 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); 14: ImageLoader.GlobTestSetup1.VarPointer := Pointer(ImageLoader.TestStackFrame.Obj1);
end; end;
// Different ways to access an object // Different ways to access an object
@ -392,6 +441,7 @@ begin
20: s := '(@PObj1)^^'; 20: s := '(@PObj1)^^';
21: s := 'VParamTestSetup1Class'; 21: s := 'VParamTestSetup1Class';
22: s := 'VParamTestSetup1ClassP^'; 22: s := 'VParamTestSetup1ClassP^';
23: s := '^TTestSetup1Class(GlobTestSetup1Pointer)^';
end; end;
FieldsExp := [svfMembers, svfOrdinal, svfAddress, svfDataAddress]; // svfSize dataSize; FieldsExp := [svfMembers, svfOrdinal, svfAddress, svfDataAddress]; // svfSize dataSize;
AddrExp := TDbgPtr(@ImageLoader.TestStackFrame.Obj1); AddrExp := TDbgPtr(@ImageLoader.TestStackFrame.Obj1);
@ -408,6 +458,10 @@ begin
ExpResult(svfAddress, AddrExp); ExpResult(svfAddress, AddrExp);
ExpResult(svfDataAddress, TDbgPtr(PtrUInt(ImageLoader.TestStackFrame.Obj1))); ExpResult(svfDataAddress, TDbgPtr(PtrUInt(ImageLoader.TestStackFrame.Obj1)));
ExpResult(svfOrdinal, 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 // Check result for @object
@ -522,6 +576,7 @@ begin
// svfSize; // svfSize;
ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]); ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]);
ExpResult(svfAddress, TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.Rec1))); ExpResult(svfAddress, TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.Rec1)));
ExpResult(svfSize, SizeOf(ImageLoader.TestStackFrame.Rec1));
StartTest(s+'.FWord', skCardinal, [ttHasType]); StartTest(s+'.FWord', skCardinal, [ttHasType]);
@ -586,6 +641,7 @@ begin
StartTest(s, skObject, [ttHasType]); StartTest(s, skObject, [ttHasType]);
ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]); ExpFlags([svfMembers, svfAddress], [svfOrdinal, svfCardinal, svfInteger, svfDataAddress]);
ExpResult(svfAddress, AddrExp); ExpResult(svfAddress, AddrExp);
ExpResult(svfSize, SizeOf(ImageLoader.TestStackFrame.OldObj1));
case i of case i of
2,4: AddrExp := TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.OldObj1.FWord)); 2,4: AddrExp := TDbgPtr(PtrUInt(@ImageLoader.TestStackFrame.OldObj1.FWord));