mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-02 01:59:29 +01:00
FPDebug: Value handling / array
git-svn-id: trunk@43996 -
This commit is contained in:
martin
parent
8c42dd719a
commit
b585ed6d46
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -1283,8 +1283,10 @@ components/fpdebug/test/dwarfviewer/dwarfviewer.lpr svneol=native#text/pascal
|
||||
components/fpdebug/test/dwarfviewer/unit1.lfm svneol=native#text/pascal
|
||||
components/fpdebug/test/dwarfviewer/unit1.pas svneol=native#text/pascal
|
||||
components/fpdebug/test/testdata/dwarfsetup1.lpr svneol=native#text/pascal
|
||||
components/fpdebug/test/testdata/dwarfsetuparray.lpr svneol=native#text/pascal
|
||||
components/fpdebug/test/testdata/dwarfsetupbasic.lpr svneol=native#text/plain
|
||||
components/fpdebug/test/testdwarfsetup1.pas svneol=native#text/pascal
|
||||
components/fpdebug/test/testdwarfsetuparray.pas svneol=native#text/pascal
|
||||
components/fpdebug/test/testdwarfsetupbasic.pas svneol=native#text/pascal
|
||||
components/fpdebug/test/testdwarfvarious.pas svneol=native#text/pascal
|
||||
components/fpdebug/test/testhelperclasses.pas svneol=native#text/pascal
|
||||
|
||||
@ -598,6 +598,7 @@ type
|
||||
function MemReader: TFpDbgMemReaderBase; inline;
|
||||
function AddressSize: Byte; inline;
|
||||
protected
|
||||
function GetDwarfDataAddress(out AnAddress: TDbgPtr; ATargetType: TDbgDwarfTypeIdentifier = nil): Boolean; reintroduce;
|
||||
procedure Reset; virtual;
|
||||
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
|
||||
function HasTypeCastInfo: Boolean;
|
||||
@ -785,7 +786,6 @@ type
|
||||
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;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
@ -794,6 +794,33 @@ type
|
||||
function GetMemberCount: Integer; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfSymbolValueConstAddress }
|
||||
|
||||
TDbgDwarfSymbolValueConstAddress = class(TDbgSymbolValueConstAddress)
|
||||
protected
|
||||
procedure Update(AnAddress: TDbgPtr);
|
||||
end;
|
||||
|
||||
{ TDbgDwarfArraySymbolValue }
|
||||
|
||||
TDbgDwarfArraySymbolValue = class(TDbgDwarfSymbolValue)
|
||||
private
|
||||
FResVal: TDbgSymbolValue;
|
||||
FAddrObj: TDbgDwarfSymbolValueConstAddress;
|
||||
protected
|
||||
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
|
||||
function GetKind: TDbgSymbolKind; override;
|
||||
function GetMember(AIndex: Integer): TDbgSymbolValue; override;
|
||||
function GetMemberEx(AIndex: array of Int64): TDbgSymbolValue; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
function GetMemberCountEx(AIndex: array of Int64): Integer; override;
|
||||
function GetIndexType(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetIndexTypeCount: Integer; override;
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfIdentifier }
|
||||
|
||||
TDbgDwarfIdentifier = class(TDbgSymbolForwarder)
|
||||
@ -1166,14 +1193,22 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
TDbgDwarfIdentifierArray = class(TDbgDwarfTypeIdentifier)
|
||||
private
|
||||
FMembers: TFpDbgCircularRefCntObjList;
|
||||
FRowMajor: Boolean;
|
||||
FStrideInBits: Int64;
|
||||
FDwarfArrayReadFlags: set of (didtStrideRead, didtOrdering);
|
||||
procedure CreateMembers;
|
||||
procedure ReadStride;
|
||||
procedure ReadOrdering;
|
||||
protected
|
||||
procedure KindNeeded; override;
|
||||
function GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue; override;
|
||||
|
||||
function GetFlags: TDbgSymbolFlags; override;
|
||||
// GetMember: returns the TYPE/range of each index. NOT the data
|
||||
function GetMember(AIndex: Integer): TDbgSymbol; override;
|
||||
function GetMemberByName({%H-}AIndex: String): TDbgSymbol; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
function GetMemberAddress(AValObject: TObject; AIndex: Array of Int64): TDbgPtr;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
@ -1779,6 +1814,127 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfSymbolValueConstAddress }
|
||||
|
||||
procedure TDbgDwarfSymbolValueConstAddress.Update(AnAddress: TDbgPtr);
|
||||
begin
|
||||
Address := AnAddress;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfArraySymbolValue }
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
Result := inherited GetFieldFlags;
|
||||
Result := Result + [svfMembers];
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skArray;
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetMember(AIndex: Integer): TDbgSymbolValue;
|
||||
begin
|
||||
Result := GetMemberEx([AIndex]);
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetMemberEx(AIndex: array of Int64): TDbgSymbolValue;
|
||||
var
|
||||
Addr: TDbgPtr;
|
||||
begin
|
||||
Result := nil;
|
||||
assert((FOwner is TDbgDwarfIdentifierArray) and (FOwner.Kind = skArray));
|
||||
Addr := TDbgDwarfIdentifierArray(FOwner).GetMemberAddress(Self, AIndex);
|
||||
if Addr = 0 then exit;
|
||||
|
||||
if (FAddrObj = nil) or (FAddrObj.RefCount > 1) then begin
|
||||
FAddrObj.ReleaseReference;
|
||||
FAddrObj := TDbgDwarfSymbolValueConstAddress.Create(Addr);
|
||||
end
|
||||
else begin
|
||||
FAddrObj.Update(Addr);
|
||||
FAddrObj.AddReference;
|
||||
end;
|
||||
|
||||
if (FResVal = nil) or (FResVal.RefCount > 1) then begin
|
||||
FResVal.ReleaseReference;
|
||||
FResVal := FOwner.TypeInfo.TypeCastValue(FAddrObj);
|
||||
end
|
||||
else begin
|
||||
TDbgDwarfSymbolValue(FResVal).SetTypeCastInfo(TDbgDwarfTypeIdentifier(FOwner), FAddrObj);
|
||||
end;
|
||||
|
||||
FAddrObj.ReleaseReference;
|
||||
Result := FResVal;
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetMemberCount: Integer;
|
||||
var
|
||||
t: TDbgSymbol;
|
||||
begin
|
||||
Result := 0;
|
||||
t := TypeInfo;
|
||||
if t.MemberCount < 1 then
|
||||
exit;
|
||||
t := t.Member[0];
|
||||
if not t.HasBounds then
|
||||
exit;
|
||||
Result := t.OrdHighBound - t.OrdLowBound + 1;
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetMemberCountEx(AIndex: array of Int64): Integer;
|
||||
var
|
||||
t: TDbgSymbol;
|
||||
begin
|
||||
Result := 0;
|
||||
t := TypeInfo;
|
||||
if length(AIndex) >= t.MemberCount then
|
||||
exit;
|
||||
t := t.Member[length(AIndex)];
|
||||
if not t.HasBounds then
|
||||
exit;
|
||||
Result := t.OrdHighBound - t.OrdLowBound + 1;
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetIndexType(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
Result := TypeInfo.Member[AIndex];
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.GetIndexTypeCount: Integer;
|
||||
begin
|
||||
Result := TypeInfo.MemberCount;
|
||||
end;
|
||||
|
||||
function TDbgDwarfArraySymbolValue.IsValidTypeCast: Boolean;
|
||||
begin
|
||||
Result := HasTypeCastInfo;
|
||||
If not Result then
|
||||
exit;
|
||||
|
||||
// TODO ordinal
|
||||
|
||||
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize, svfSizeOfPointer] = [svfAddress]) then
|
||||
exit
|
||||
else
|
||||
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSize] = [svfAddress, svfSize]) and
|
||||
(FTypeCastSourceValue.Size = FOwner.FCU.FAddressSize)
|
||||
then
|
||||
exit
|
||||
else
|
||||
if (FTypeCastSourceValue.FieldFlags * [svfAddress, svfSizeOfPointer] = [svfAddress, svfSizeOfPointer])
|
||||
then
|
||||
exit;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfArraySymbolValue.Destroy;
|
||||
begin
|
||||
FResVal.ReleaseReference;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TDbgDwarfSymbolValueConstNumber }
|
||||
|
||||
procedure TDbgDwarfSymbolValueConstNumber.Update(AValue: QWord; ASigned: Boolean);
|
||||
@ -2264,43 +2420,6 @@ begin
|
||||
Result := inherited GetDataAddress;
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.GetDwarfDataAddress(out AnAddress: TDbgPtr;
|
||||
ATargetType: TDbgDwarfTypeIdentifier): Boolean;
|
||||
var
|
||||
fields: TDbgSymbolValueFieldFlags;
|
||||
t: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
Result := HasTypeCastInfo;
|
||||
if not Result then
|
||||
exit;
|
||||
fields := FTypeCastSourceValue.FieldFlags;
|
||||
AnAddress := 0;
|
||||
if svfOrdinal in fields then begin
|
||||
AnAddress := FTypeCastSourceValue.AsCardinal;
|
||||
// MUST store, and provide address of it // for now, skip the pointer
|
||||
t := FTypeCastTargetType;
|
||||
if t is TDbgDwarfTypeIdentifierDeclaration then t := t.NestedTypeInfo;
|
||||
if (t<> nil) and (t is TDbgDwarfTypeIdentifierPointer) then t := t.NestedTypeInfo;
|
||||
if (t<> nil) then begin
|
||||
Result := t.GetDataAddress(AnAddress, ATargetType);
|
||||
Result := AnAddress <> 0;
|
||||
exit;
|
||||
end;
|
||||
Result := False;
|
||||
exit;
|
||||
|
||||
end
|
||||
else
|
||||
if svfAddress in fields then
|
||||
AnAddress := FTypeCastSourceValue.Address;
|
||||
|
||||
Result := AnAddress <> 0;
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
Result := FTypeCastTargetType.GetDataAddress(AnAddress, ATargetType);
|
||||
end;
|
||||
|
||||
function TDbgDwarfStructTypeCastSymbolValue.IsValidTypeCast: Boolean;
|
||||
var
|
||||
f: TDbgSymbolValueFieldFlags;
|
||||
@ -2529,6 +2648,54 @@ begin
|
||||
Result := FOwner.FCU.FAddressSize;
|
||||
end;
|
||||
|
||||
function TDbgDwarfSymbolValue.GetDwarfDataAddress(out AnAddress: TDbgPtr;
|
||||
ATargetType: TDbgDwarfTypeIdentifier): Boolean;
|
||||
var
|
||||
fields: TDbgSymbolValueFieldFlags;
|
||||
t: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
if FValueSymbol <> nil then begin
|
||||
Assert(FValueSymbol is TDbgDwarfValueIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress FValueSymbol');
|
||||
Assert(TypeInfo is TDbgDwarfTypeIdentifier, 'TDbgDwarfSymbolValue.GetDwarfDataAddress TypeInfo');
|
||||
Assert(not HasTypeCastInfo, 'TDbgDwarfSymbolValue.GetDwarfDataAddress not HasTypeCastInfo');
|
||||
Result := FValueSymbol.GetDataAddress(AnAddress, TDbgDwarfTypeIdentifier(FOwner));
|
||||
end
|
||||
|
||||
else
|
||||
begin
|
||||
// try typecast
|
||||
Result := HasTypeCastInfo;
|
||||
if not Result then
|
||||
exit;
|
||||
fields := FTypeCastSourceValue.FieldFlags;
|
||||
AnAddress := 0;
|
||||
if svfOrdinal in fields then begin
|
||||
AnAddress := FTypeCastSourceValue.AsCardinal;
|
||||
// MUST store, and provide address of it // for now, skip the pointer
|
||||
t := FTypeCastTargetType;
|
||||
if t is TDbgDwarfTypeIdentifierDeclaration then t := t.NestedTypeInfo;
|
||||
if (t<> nil) and (t is TDbgDwarfTypeIdentifierPointer) then t := t.NestedTypeInfo;
|
||||
if (t<> nil) then begin
|
||||
Result := t.GetDataAddress(AnAddress, ATargetType);
|
||||
Result := AnAddress <> 0;
|
||||
exit;
|
||||
end;
|
||||
Result := False;
|
||||
exit;
|
||||
|
||||
end
|
||||
else
|
||||
if svfAddress in fields then
|
||||
AnAddress := FTypeCastSourceValue.Address;
|
||||
|
||||
Result := AnAddress <> 0;
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
Result := FTypeCastTargetType.GetDataAddress(AnAddress, ATargetType);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfSymbolValue.Reset;
|
||||
begin
|
||||
//
|
||||
@ -5446,11 +5613,45 @@ begin
|
||||
Info.ReleaseReference;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierArray.ReadStride;
|
||||
var
|
||||
t: TDbgDwarfTypeIdentifier;
|
||||
begin
|
||||
if didtStrideRead in FDwarfArrayReadFlags then
|
||||
exit;
|
||||
Include(FDwarfArrayReadFlags, didtStrideRead);
|
||||
if not FInformationEntry.ReadValue(DW_AT_bit_stride, FStrideInBits) then begin
|
||||
t := NestedTypeInfo;
|
||||
if t = nil then
|
||||
FStrideInBits := 0
|
||||
else
|
||||
FStrideInBits := t.Size * 8;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierArray.ReadOrdering;
|
||||
var
|
||||
AVal: Integer;
|
||||
begin
|
||||
if didtOrdering in FDwarfArrayReadFlags then
|
||||
exit;
|
||||
Include(FDwarfArrayReadFlags, didtOrdering);
|
||||
if FInformationEntry.ReadValue(DW_AT_ordering, AVal) then
|
||||
FRowMajor := AVal = DW_ORD_row_major
|
||||
else
|
||||
FRowMajor := True; // default (at least in pas)
|
||||
end;
|
||||
|
||||
procedure TDbgDwarfIdentifierArray.KindNeeded;
|
||||
begin
|
||||
SetKind(skArray); // Todo: static/dynamic?
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierArray.GetTypedValueObject(ATypeCast: Boolean): TDbgDwarfSymbolValue;
|
||||
begin
|
||||
Result := TDbgDwarfArraySymbolValue.Create(Self);
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierArray.GetFlags: TDbgSymbolFlags;
|
||||
function IsDynSubRange(m: TDbgDwarfIdentifier): Boolean;
|
||||
begin
|
||||
@ -5497,6 +5698,75 @@ begin
|
||||
Result := FMembers.Count;
|
||||
end;
|
||||
|
||||
function TDbgDwarfIdentifierArray.GetMemberAddress(AValObject: TObject;
|
||||
AIndex: array of Int64): TDbgPtr;
|
||||
var
|
||||
Offs, Factor: QWord;
|
||||
i: Integer;
|
||||
bsize: Integer;
|
||||
m: TDbgDwarfIdentifier;
|
||||
begin
|
||||
assert((AValObject is TDbgDwarfValueIdentifier) or (AValObject is TDbgDwarfArraySymbolValue), 'TDbgDwarfIdentifierArray.GetMemberAddress AValObject');
|
||||
ReadOrdering;
|
||||
ReadStride;
|
||||
Result := 0;
|
||||
if (FStrideInBits <= 0) or (FStrideInBits mod 8 <> 0) then
|
||||
exit;
|
||||
|
||||
CreateMembers;
|
||||
if Length(AIndex) > FMembers.Count then
|
||||
exit;
|
||||
|
||||
// TODO: reduce index by low-ord
|
||||
if AValObject is TDbgDwarfValueIdentifier then begin
|
||||
if not TDbgDwarfValueIdentifier(AValObject).GetDataAddress(Result, Self) then begin
|
||||
Result := 0;
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if AValObject is TDbgDwarfArraySymbolValue then begin
|
||||
if not TDbgDwarfArraySymbolValue(AValObject).GetDwarfDataAddress(Result, Self) then begin
|
||||
Result := 0;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Offs := 0;
|
||||
Factor := 1;
|
||||
|
||||
bsize := FStrideInBits div 8;
|
||||
if FRowMajor then begin
|
||||
for i := Length(AIndex) - 1 downto 0 do begin
|
||||
Offs := Offs + AIndex[i] * bsize * Factor;
|
||||
if i > 0 then begin
|
||||
m := TDbgDwarfIdentifier(FMembers[i]);
|
||||
if not m.HasBounds then begin
|
||||
Result := 0;
|
||||
exit;
|
||||
end;
|
||||
// TODO range check
|
||||
Factor := Factor * (m.OrdHighBound - m.OrdLowBound + 1);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
for i := 0 to Length(AIndex) - 1 do begin
|
||||
Offs := Offs + AIndex[i] * bsize * Factor;
|
||||
if i < Length(AIndex) - 1 then begin
|
||||
m := TDbgDwarfIdentifier(FMembers[i]);
|
||||
if not m.HasBounds then begin
|
||||
Result := 0;
|
||||
exit;
|
||||
end;
|
||||
Factor := Factor * (m.OrdHighBound - m.OrdLowBound + 1);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := Result + Offs;
|
||||
end;
|
||||
|
||||
destructor TDbgDwarfIdentifierArray.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
@ -128,7 +128,7 @@ const
|
||||
DW_AT_prototyped = $27 ; // flag
|
||||
DW_AT_return_addr = $2a ; // block, loclistptr
|
||||
DW_AT_start_scope = $2c ; // constant
|
||||
DW_AT_bit_stride = $2e ; // constant
|
||||
DW_AT_bit_stride = $2e ; // constant // Dwarf 2 refers to it as DW_AT_stride_size
|
||||
DW_AT_upper_bound = $2f ; // block, constant, reference
|
||||
DW_AT_abstract_origin = $31 ; // reference
|
||||
DW_AT_accessibility = $32 ; // constant
|
||||
|
||||
@ -159,6 +159,11 @@ type
|
||||
function GetMember(AIndex: Integer): TDbgSymbolValue; virtual;
|
||||
function GetMemberByName(AIndex: String): TDbgSymbolValue; virtual;
|
||||
function GetMemberCount: Integer; virtual;
|
||||
function GetIndexType(AIndex: Integer): TDbgSymbol; virtual;
|
||||
function GetIndexTypeCount: Integer; virtual;
|
||||
function GetMemberCountEx(AIndex: array of Int64): Integer; virtual;
|
||||
function GetMemberEx(AIndex: Array of Int64): TDbgSymbolValue; virtual;
|
||||
|
||||
function GetDbgSymbol: TDbgSymbol; virtual;
|
||||
function GetTypeInfo: TDbgSymbol; virtual;
|
||||
public
|
||||
@ -183,9 +188,16 @@ type
|
||||
property DataSize: Integer read GetDataSize; // Sive of Data, if avail (e.g. String, TObject, ..., BUT NOT record)
|
||||
// memdump
|
||||
public
|
||||
// base class? Or Member inncludes member from base
|
||||
// base class? Or Member includes member from base
|
||||
(* Member:
|
||||
For TypeInfo (skType) it excludes BaseClass For Value (skValue): ???
|
||||
* skClass, skStructure:
|
||||
stType: it excludes BaseClass (TODO: decide?)
|
||||
stValue: ???
|
||||
* skSet
|
||||
stType: all members
|
||||
stValue: only members set in value (Only impremented for DbgSymbolValue)
|
||||
* skArray: (differs from TDbgSymbol)
|
||||
The values. The type of each Index-dimension is avail via IndexType
|
||||
NOTE: Values returned by Member/MemberByName are volatile.
|
||||
They maybe released or changed when Member is called again.
|
||||
To keep a returned Value a reference can be added (AddReference)
|
||||
@ -193,6 +205,11 @@ type
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
property Member[AIndex: Integer]: TDbgSymbolValue read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbolValue read GetMemberByName; // Includes inheritance
|
||||
// For Arrays (TODO pointers) only, the values stored in the array
|
||||
property MemberCountEx[AIndex: Array of Int64]: Integer read GetMemberCountEx;
|
||||
property MemberEx[AIndex: Array of Int64]: TDbgSymbolValue read GetMemberEx;
|
||||
property IndexTypeCount: Integer read GetIndexTypeCount;
|
||||
property IndexType[AIndex: Integer]: TDbgSymbol read GetIndexType;
|
||||
|
||||
(* DbgSymbol: The TDbgSymbol from which this value came, maybe nil.
|
||||
Maybe a stType, then there is no Value *)
|
||||
@ -217,6 +234,20 @@ type
|
||||
constructor Create(AValue: QWord; ASigned: Boolean = True);
|
||||
end;
|
||||
|
||||
{ TDbgSymbolValueConstAddress }
|
||||
|
||||
TDbgSymbolValueConstAddress = class(TDbgSymbolValue)
|
||||
private
|
||||
FAddress: TDbgPtr;
|
||||
protected
|
||||
property Address: QWord read FAddress write FAddress;
|
||||
//function GetKind: TDbgSymbolKind; override; // no kind
|
||||
function GetFieldFlags: TDbgSymbolValueFieldFlags; override;
|
||||
function GetAddress: TDbgPtr; override;
|
||||
public
|
||||
constructor Create(AnAddress: TDbgPtr);
|
||||
end;
|
||||
|
||||
{ TDbgSymbol }
|
||||
|
||||
TDbgSymbol = class(TDbgSymbolBase)
|
||||
@ -304,8 +335,18 @@ type
|
||||
property MemberVisibility: TDbgSymbolMemberVisibility read GetMemberVisibility;
|
||||
property MemberCount: Integer read GetMemberCount;
|
||||
(* Member:
|
||||
For TypeInfo (skType) it excludes BaseClass
|
||||
For Value (skValue): ???
|
||||
* skClass, skStructure:
|
||||
stType: it excludes BaseClass (TODO: decide?)
|
||||
stValue: ???
|
||||
* skSet
|
||||
stType: all members
|
||||
stValue: only members set in value (Only impremented for DbgSymbolValue)
|
||||
* skArray:
|
||||
The type of each Index-dimension
|
||||
The count is the amount of dimensions
|
||||
NOTE: Values returned by Member/MemberByName are volatile.
|
||||
They maybe released or changed when Member is called again.
|
||||
To keep a returned Value a reference can be added (AddReference)
|
||||
*)
|
||||
property Member[AIndex: Integer]: TDbgSymbol read GetMember;
|
||||
property MemberByName[AIndex: String]: TDbgSymbol read GetMemberByName; // Includes inheritance
|
||||
@ -399,6 +440,24 @@ begin
|
||||
WriteStr(Result, ADbgSymbolKind);
|
||||
end;
|
||||
|
||||
{ TDbgSymbolValueConstAddress }
|
||||
|
||||
function TDbgSymbolValueConstAddress.GetFieldFlags: TDbgSymbolValueFieldFlags;
|
||||
begin
|
||||
Result := [svfAddress, svfSizeOfPointer]
|
||||
end;
|
||||
|
||||
function TDbgSymbolValueConstAddress.GetAddress: TDbgPtr;
|
||||
begin
|
||||
Result := FAddress;
|
||||
end;
|
||||
|
||||
constructor TDbgSymbolValueConstAddress.Create(AnAddress: TDbgPtr);
|
||||
begin
|
||||
inherited Create;
|
||||
FAddress := AnAddress;
|
||||
end;
|
||||
|
||||
{ TFpDbgCircularRefCountedObject }
|
||||
|
||||
procedure TFpDbgCircularRefCountedObject.DoPlainReferenceAdded;
|
||||
@ -512,6 +571,26 @@ begin
|
||||
Result := [];
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetIndexType(AIndex: Integer): TDbgSymbol;
|
||||
begin
|
||||
Result := nil;;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetIndexTypeCount: Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetMemberEx(AIndex: array of Int64): TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetMemberCountEx(AIndex: array of Int64): Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TDbgSymbolValue.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skNone;
|
||||
|
||||
@ -247,7 +247,7 @@ type
|
||||
// array[1]
|
||||
protected
|
||||
procedure Init; override;
|
||||
//function DoGetResultType: TDbgSymbol; override;
|
||||
function DoGetResultValue: TDbgSymbolValue; override;
|
||||
function IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean; override;
|
||||
function HandleNextPartInBracket(APart: TFpPascalExpressionPart): TFpPascalExpressionPart; override;
|
||||
function MaybeHandlePrevPart(APrevPart: TFpPascalExpressionPart;
|
||||
@ -905,39 +905,38 @@ begin
|
||||
inherited Init;
|
||||
end;
|
||||
|
||||
//function TFpPascalExpressionPartBracketIndex.DoGetResultType: TDbgSymbol;
|
||||
//var
|
||||
// tmp: TDbgSymbol;
|
||||
//begin
|
||||
// Result := nil;
|
||||
// if Count <> 2 then exit;
|
||||
//
|
||||
// tmp := Items[0].ResultType;
|
||||
// if tmp = nil then exit;
|
||||
//
|
||||
// if (tmp.Kind = skArray) then begin
|
||||
// // TODO: check type of index
|
||||
// if tmp.MemberCount < 1 then exit; // TODO error
|
||||
// if tmp.MemberCount = 1 then begin
|
||||
// Result := tmp.TypeInfo;
|
||||
// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
// exit;
|
||||
// end;
|
||||
//
|
||||
// Result := TPasParserSymbolArrayDeIndex.Create(tmp);
|
||||
// end
|
||||
// else
|
||||
// if (tmp.Kind = skPointer) then begin
|
||||
// Result := tmp.TypeInfo;
|
||||
// Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
// exit;
|
||||
// end
|
||||
// else
|
||||
// if (tmp.Kind = skString) then begin
|
||||
// //TODO
|
||||
// exit;
|
||||
// end;
|
||||
//end;
|
||||
function TFpPascalExpressionPartBracketIndex.DoGetResultValue: TDbgSymbolValue;
|
||||
var
|
||||
tmp, tmp2: TDbgSymbolValue;
|
||||
begin
|
||||
Result := nil;
|
||||
if Count <> 2 then exit;
|
||||
|
||||
tmp := Items[0].ResultValue;
|
||||
if tmp = nil then exit;
|
||||
|
||||
if (tmp.Kind = skArray) then begin
|
||||
tmp2 := Items[1].ResultValue;
|
||||
if not (svfOrdinal in tmp2.FieldFlags) then
|
||||
exit;
|
||||
Result := tmp.Member[tmp2.AsCardinal]; // todo negative ?
|
||||
if Result <> nil then
|
||||
Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultValue'){$ENDIF};
|
||||
exit;
|
||||
//Result := TPasParserSymbolArrayDeIndex.Create(tmp);
|
||||
end
|
||||
else
|
||||
if (tmp.Kind = skPointer) then begin
|
||||
//Result := tmp.TypeInfo;
|
||||
//Result.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(nil, 'DoGetResultType'){$ENDIF};
|
||||
exit;
|
||||
end
|
||||
else
|
||||
if (tmp.Kind = skString) then begin
|
||||
//TODO
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpPascalExpressionPartBracketIndex.IsValidAfterPart(APrevPart: TFpPascalExpressionPart): Boolean;
|
||||
begin
|
||||
|
||||
@ -87,7 +87,7 @@
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="B:\lazarus_latest\debugger\fpgdbmidebugger.pp"/>
|
||||
<Filename Value="..\..\..\..\debugger\fpgdbmidebugger.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FpGdbmiDebugger"/>
|
||||
</Unit2>
|
||||
|
||||
23
components/fpdebug/test/testdata/dwarfsetuparray.lpr
vendored
Normal file
23
components/fpdebug/test/testdata/dwarfsetuparray.lpr
vendored
Normal file
@ -0,0 +1,23 @@
|
||||
program DwarfSetupArray;
|
||||
{$mode objfpc}{$H+}
|
||||
{$IF FPC_FULLVERSION>=20701}
|
||||
{$OPTIMIZATION NOREMOVEEMPTYPROCS}
|
||||
{$OPTIMIZATION NOORDERFIELDS}
|
||||
{$ENDIF}
|
||||
{$OPTIMIZATION OFF}
|
||||
{$A1}
|
||||
|
||||
type
|
||||
TDynIntArray = Array of integer;
|
||||
TStatIntArray1 = Array [0..10] of integer;
|
||||
TStatIntArray2 = Array [5..10] of integer;
|
||||
|
||||
var // Globals
|
||||
VarDynIntArray: TDynIntArray;
|
||||
VarStatIntArray1: TStatIntArray1;
|
||||
VarStatIntArray2: TStatIntArray2;
|
||||
|
||||
begin
|
||||
VarStatIntArray1[1]:=0;
|
||||
end.
|
||||
|
||||
267
components/fpdebug/test/testdwarfsetuparray.pas
Normal file
267
components/fpdebug/test/testdwarfsetuparray.pas
Normal file
@ -0,0 +1,267 @@
|
||||
unit TestDwarfSetupArray;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$IF FPC_FULLVERSION>=20701}
|
||||
{$OPTIMIZATION NOREMOVEEMPTYPROCS}
|
||||
{$OPTIMIZATION NOORDERFIELDS}
|
||||
{$ENDIF}
|
||||
{$OPTIMIZATION OFF}
|
||||
{$A1}
|
||||
|
||||
(*
|
||||
Data generated from testdata\dwarfsetupbasic.lpr
|
||||
*)
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
FpDbgDwarfConst,
|
||||
TestHelperClasses;
|
||||
|
||||
const
|
||||
TTestSetupArrayProcMainAddr = $00400000;
|
||||
|
||||
type
|
||||
|
||||
{%region Types defined in the DWARF }
|
||||
TDynIntArray = Array of integer;
|
||||
TStatIntArray1 = Array [0..10] of integer;
|
||||
TStatIntArray2 = Array [5..10] of integer;
|
||||
{%endregion Types defined in the DWARF }
|
||||
|
||||
type
|
||||
{ TTestDwarfSetupBasic }
|
||||
|
||||
{ TTestLoaderSetupArray }
|
||||
|
||||
TTestLoaderSetupArray = class(TTestDummyImageLoader)
|
||||
public
|
||||
constructor Create; override;
|
||||
procedure PoissonTestFrame;
|
||||
public
|
||||
SectionDbgInfo: TTestDummySectionInfoEntries;
|
||||
|
||||
Unitdwarfsetuparray_lpr_0, VarVARDYNINTARRAY_1, VarVARSTATINTARRAY1_2, VarVARSTATINTARRAY2_3, Progmain_4, ProgPDWARFSETUPARRAY_init_implicit_5, ProgPDWARFSETUPARRAY_finalize_implicit_6, TypeDeclTDYNINTARRAY_7, TypePtr_8, TypeTDYNINTARRAY_9, Type_10, Type_11, TypeDeclTSTATINTARRAY1_12, TypeTSTATINTARRAY1_13, Type_14, Type_15, TypeDeclTSTATINTARRAY2_16, TypeTSTATINTARRAY2_17, Type_18, Type_19, TypeDeclLONGINT_20, TypeLONGINT_21, Type_22, TypeDeclSHORTINT_23, TypeSHORTINT_24, Type_25
|
||||
: TTestDwarfInfoEntry;
|
||||
|
||||
// global vars
|
||||
GlobalVar: record
|
||||
PAD_Before: QWord; // padding will be filled with bad data
|
||||
|
||||
VarDynIntArray: TDynIntArray;
|
||||
VarStatIntArray1: TStatIntArray1;
|
||||
VarStatIntArray2: TStatIntArray2;
|
||||
|
||||
PAD_After: QWord;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestLoaderSetupArray }
|
||||
|
||||
constructor TTestLoaderSetupArray.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
PoissonTestFrame;
|
||||
|
||||
SectionDbgInfo := TestImgReader.TestSection['.debug_info'] as TTestDummySectionInfoEntries;
|
||||
Unitdwarfsetuparray_lpr_0 := SectionDbgInfo.GetFirstInfoEntryObj;
|
||||
|
||||
// Generated with fpc 2.6.2 32 bit win
|
||||
|
||||
Unitdwarfsetuparray_lpr_0.Tag := DW_TAG_compile_unit;
|
||||
Unitdwarfsetuparray_lpr_0.Children := 1;
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_name, DW_FORM_string, 'dwarfsetuparray.lpr'+#0);
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_producer, DW_FORM_string, 'Free Pascal 2.6.2 2013/02/16'+#0);
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_comp_dir, DW_FORM_string, 'B:/lazarus_latest/components/fpdebug/test/testdata/'+#0);
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_language, DW_FORM_data1, [$09]);
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_identifier_case, DW_FORM_data1, [$03]);
|
||||
Unitdwarfsetuparray_lpr_0.Add(DW_AT_stmt_list, DW_FORM_data4, [$00, $00, $00, $00]);
|
||||
Unitdwarfsetuparray_lpr_0.AddAddr(DW_AT_low_pc, DW_FORM_addr, $00400000);
|
||||
Unitdwarfsetuparray_lpr_0.AddAddr(DW_AT_high_pc, DW_FORM_addr, $004FFFFF);
|
||||
|
||||
VarVARDYNINTARRAY_1 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
VarVARDYNINTARRAY_1.Tag := DW_TAG_variable;
|
||||
VarVARDYNINTARRAY_1.Children := 0;
|
||||
VarVARDYNINTARRAY_1.Add(DW_AT_name, DW_FORM_string, 'VARDYNINTARRAY'+#0);
|
||||
VarVARDYNINTARRAY_1.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GlobalVar.VarDYNINTARRAY)])); // $03, $00, $00, $00, $00
|
||||
VarVARDYNINTARRAY_1.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTDYNINTARRAY_7); // $41, $01, $00, $00
|
||||
|
||||
VarVARSTATINTARRAY1_2 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
VarVARSTATINTARRAY1_2.Tag := DW_TAG_variable;
|
||||
VarVARSTATINTARRAY1_2.Children := 0;
|
||||
VarVARSTATINTARRAY1_2.Add(DW_AT_name, DW_FORM_string, 'VARSTATINTARRAY1'+#0);
|
||||
VarVARSTATINTARRAY1_2.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GlobalVar.VarSTATINTARRAY1)])); // $03, $00, $90, $40, $00
|
||||
VarVARSTATINTARRAY1_2.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTSTATINTARRAY1_12); // $77, $01, $00, $00
|
||||
|
||||
VarVARSTATINTARRAY2_3 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
VarVARSTATINTARRAY2_3.Tag := DW_TAG_variable;
|
||||
VarVARSTATINTARRAY2_3.Children := 0;
|
||||
VarVARSTATINTARRAY2_3.Add(DW_AT_name, DW_FORM_string, 'VARSTATINTARRAY2'+#0);
|
||||
VarVARSTATINTARRAY2_3.Add(DW_AT_location, DW_FORM_block1, BytesLen1([DW_OP_addr, AddrB(@GlobalVar.VarSTATINTARRAY2)])); // $03, $00, $00, $00, $00
|
||||
VarVARSTATINTARRAY2_3.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTSTATINTARRAY2_16); // $AE, $01, $00, $00
|
||||
|
||||
Progmain_4 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Progmain_4.Tag := DW_TAG_subprogram;
|
||||
Progmain_4.Children := 0;
|
||||
Progmain_4.Add(DW_AT_name, DW_FORM_string, 'main'+#0);
|
||||
Progmain_4.Add(DW_AT_prototyped, DW_FORM_flag, [$01]);
|
||||
Progmain_4.Add(DW_AT_calling_convention, DW_FORM_data1, [$41]);
|
||||
Progmain_4.Add(DW_AT_external, DW_FORM_flag, [$01]);
|
||||
Progmain_4.AddAddr(DW_AT_low_pc, DW_FORM_addr, $00400000);
|
||||
Progmain_4.AddAddr(DW_AT_high_pc, DW_FORM_addr, $00400FFF);
|
||||
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Tag := DW_TAG_subprogram;
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Children := 0;
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Add(DW_AT_name, DW_FORM_string, 'P$DWARFSETUPARRAY_init_implicit'+#0);
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Add(DW_AT_prototyped, DW_FORM_flag, [$01]);
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Add(DW_AT_calling_convention, DW_FORM_data1, [$41]);
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.Add(DW_AT_external, DW_FORM_flag, [$01]);
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.AddAddr(DW_AT_low_pc, DW_FORM_addr, $00401000);
|
||||
ProgPDWARFSETUPARRAY_init_implicit_5.AddAddr(DW_AT_high_pc, DW_FORM_addr, $00401FFF);
|
||||
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Tag := DW_TAG_subprogram;
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Children := 0;
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Add(DW_AT_name, DW_FORM_string, 'P$DWARFSETUPARRAY_finalize_implicit'+#0);
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Add(DW_AT_prototyped, DW_FORM_flag, [$01]);
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Add(DW_AT_calling_convention, DW_FORM_data1, [$41]);
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.Add(DW_AT_external, DW_FORM_flag, [$01]);
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.AddAddr(DW_AT_low_pc, DW_FORM_addr, $00402000);
|
||||
ProgPDWARFSETUPARRAY_finalize_implicit_6.AddAddr(DW_AT_high_pc, DW_FORM_addr, $00402FFF);
|
||||
|
||||
TypeDeclTDYNINTARRAY_7 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeDeclTDYNINTARRAY_7.Tag := DW_TAG_typedef;
|
||||
TypeDeclTDYNINTARRAY_7.Children := 0;
|
||||
TypeDeclTDYNINTARRAY_7.Add(DW_AT_name, DW_FORM_string, 'TDYNINTARRAY'+#0);
|
||||
TypeDeclTDYNINTARRAY_7.AddRef(DW_AT_type, DW_FORM_ref4, @TypePtr_8); // $53, $01, $00, $00
|
||||
|
||||
TypePtr_8 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypePtr_8.Tag := DW_TAG_pointer_type;
|
||||
TypePtr_8.Children := 0;
|
||||
TypePtr_8.AddRef(DW_AT_type, DW_FORM_ref4, @TypeTDYNINTARRAY_9); // $58, $01, $00, $00
|
||||
|
||||
TypeTDYNINTARRAY_9 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeTDYNINTARRAY_9.Tag := DW_TAG_array_type;
|
||||
TypeTDYNINTARRAY_9.Children := 1;
|
||||
TypeTDYNINTARRAY_9.Add(DW_AT_name, DW_FORM_string, 'TDYNINTARRAY'+#0);
|
||||
TypeTDYNINTARRAY_9.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclLONGINT_20); // $E5, $01, $00, $00
|
||||
|
||||
Type_10 := TypeTDYNINTARRAY_9.GetNewChild;
|
||||
Type_10.Tag := DW_TAG_subrange_type;
|
||||
Type_10.Children := 0;
|
||||
Type_10.AddSLEB(DW_AT_lower_bound, DW_FORM_sdata, 0);
|
||||
Type_10.AddULEB(DW_AT_byte_stride, DW_FORM_udata, 4);
|
||||
Type_10.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclLONGINT_20); // $E5, $01, $00, $00
|
||||
|
||||
Type_11 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Type_11.Tag := DW_TAG_reference_type;
|
||||
Type_11.Children := 0;
|
||||
Type_11.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTDYNINTARRAY_7); // $41, $01, $00, $00
|
||||
|
||||
TypeDeclTSTATINTARRAY1_12 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeDeclTSTATINTARRAY1_12.Tag := DW_TAG_typedef;
|
||||
TypeDeclTSTATINTARRAY1_12.Children := 0;
|
||||
TypeDeclTSTATINTARRAY1_12.Add(DW_AT_name, DW_FORM_string, 'TSTATINTARRAY1'+#0);
|
||||
TypeDeclTSTATINTARRAY1_12.AddRef(DW_AT_type, DW_FORM_ref4, @TypeTSTATINTARRAY1_13); // $8B, $01, $00, $00
|
||||
|
||||
TypeTSTATINTARRAY1_13 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeTSTATINTARRAY1_13.Tag := DW_TAG_array_type;
|
||||
TypeTSTATINTARRAY1_13.Children := 1;
|
||||
TypeTSTATINTARRAY1_13.Add(DW_AT_name, DW_FORM_string, 'TSTATINTARRAY1'+#0);
|
||||
TypeTSTATINTARRAY1_13.AddULEB(DW_AT_byte_size, DW_FORM_udata, 44);
|
||||
TypeTSTATINTARRAY1_13.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclLONGINT_20); // $E5, $01, $00, $00
|
||||
|
||||
Type_14 := TypeTSTATINTARRAY1_13.GetNewChild;
|
||||
Type_14.Tag := DW_TAG_subrange_type;
|
||||
Type_14.Children := 0;
|
||||
Type_14.AddSLEB(DW_AT_lower_bound, DW_FORM_sdata, 0);
|
||||
Type_14.AddSLEB(DW_AT_upper_bound, DW_FORM_sdata, 10);
|
||||
Type_14.AddULEB(DW_AT_byte_stride, DW_FORM_udata, 4);
|
||||
Type_14.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclSHORTINT_23); // $02, $02, $00, $00
|
||||
|
||||
Type_15 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Type_15.Tag := DW_TAG_reference_type;
|
||||
Type_15.Children := 0;
|
||||
Type_15.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTSTATINTARRAY1_12); // $77, $01, $00, $00
|
||||
|
||||
TypeDeclTSTATINTARRAY2_16 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeDeclTSTATINTARRAY2_16.Tag := DW_TAG_typedef;
|
||||
TypeDeclTSTATINTARRAY2_16.Children := 0;
|
||||
TypeDeclTSTATINTARRAY2_16.Add(DW_AT_name, DW_FORM_string, 'TSTATINTARRAY2'+#0);
|
||||
TypeDeclTSTATINTARRAY2_16.AddRef(DW_AT_type, DW_FORM_ref4, @TypeTSTATINTARRAY2_17); // $C2, $01, $00, $00
|
||||
|
||||
TypeTSTATINTARRAY2_17 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeTSTATINTARRAY2_17.Tag := DW_TAG_array_type;
|
||||
TypeTSTATINTARRAY2_17.Children := 1;
|
||||
TypeTSTATINTARRAY2_17.Add(DW_AT_name, DW_FORM_string, 'TSTATINTARRAY2'+#0);
|
||||
TypeTSTATINTARRAY2_17.AddULEB(DW_AT_byte_size, DW_FORM_udata, 24);
|
||||
TypeTSTATINTARRAY2_17.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclLONGINT_20); // $E5, $01, $00, $00
|
||||
|
||||
Type_18 := TypeTSTATINTARRAY2_17.GetNewChild;
|
||||
Type_18.Tag := DW_TAG_subrange_type;
|
||||
Type_18.Children := 0;
|
||||
Type_18.AddSLEB(DW_AT_lower_bound, DW_FORM_sdata, 5);
|
||||
Type_18.AddSLEB(DW_AT_upper_bound, DW_FORM_sdata, 10);
|
||||
Type_18.AddULEB(DW_AT_byte_stride, DW_FORM_udata, 4);
|
||||
Type_18.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclSHORTINT_23); // $02, $02, $00, $00
|
||||
|
||||
Type_19 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Type_19.Tag := DW_TAG_reference_type;
|
||||
Type_19.Children := 0;
|
||||
Type_19.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclTSTATINTARRAY2_16); // $AE, $01, $00, $00
|
||||
|
||||
TypeDeclLONGINT_20 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeDeclLONGINT_20.Tag := DW_TAG_typedef;
|
||||
TypeDeclLONGINT_20.Children := 0;
|
||||
TypeDeclLONGINT_20.Add(DW_AT_name, DW_FORM_string, 'LONGINT'+#0);
|
||||
TypeDeclLONGINT_20.AddRef(DW_AT_type, DW_FORM_ref4, @TypeLONGINT_21); // $F2, $01, $00, $00
|
||||
|
||||
TypeLONGINT_21 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeLONGINT_21.Tag := DW_TAG_base_type;
|
||||
TypeLONGINT_21.Children := 0;
|
||||
TypeLONGINT_21.Add(DW_AT_name, DW_FORM_string, 'LONGINT'+#0);
|
||||
TypeLONGINT_21.Add(DW_AT_encoding, DW_FORM_data1, [$05]);
|
||||
TypeLONGINT_21.Add(DW_AT_byte_size, DW_FORM_data1, [$04]);
|
||||
|
||||
Type_22 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Type_22.Tag := DW_TAG_reference_type;
|
||||
Type_22.Children := 0;
|
||||
Type_22.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclLONGINT_20); // $E5, $01, $00, $00
|
||||
|
||||
TypeDeclSHORTINT_23 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeDeclSHORTINT_23.Tag := DW_TAG_typedef;
|
||||
TypeDeclSHORTINT_23.Children := 0;
|
||||
TypeDeclSHORTINT_23.Add(DW_AT_name, DW_FORM_string, 'SHORTINT'+#0);
|
||||
TypeDeclSHORTINT_23.AddRef(DW_AT_type, DW_FORM_ref4, @TypeSHORTINT_24); // $10, $02, $00, $00
|
||||
|
||||
TypeSHORTINT_24 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
TypeSHORTINT_24.Tag := DW_TAG_base_type;
|
||||
TypeSHORTINT_24.Children := 0;
|
||||
TypeSHORTINT_24.Add(DW_AT_name, DW_FORM_string, 'SHORTINT'+#0);
|
||||
TypeSHORTINT_24.Add(DW_AT_encoding, DW_FORM_data1, [$05]);
|
||||
TypeSHORTINT_24.Add(DW_AT_byte_size, DW_FORM_data1, [$01]);
|
||||
|
||||
Type_25 := Unitdwarfsetuparray_lpr_0.GetNewChild;
|
||||
Type_25.Tag := DW_TAG_reference_type;
|
||||
Type_25.Children := 0;
|
||||
Type_25.AddRef(DW_AT_type, DW_FORM_ref4, @TypeDeclSHORTINT_23); // $02, $02, $00, $00
|
||||
|
||||
//
|
||||
SectionDbgInfo.CreateSectionData;
|
||||
SectionDbgInfo.AbbrevSection.CreateSectionData;
|
||||
end;
|
||||
|
||||
procedure TTestLoaderSetupArray.PoissonTestFrame;
|
||||
begin
|
||||
// do not poison managed types
|
||||
// Ensure any out of bound reads get bad data
|
||||
// FillByte(GlobalVar, SizeOf(GlobalVar), $D5);
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
FpPascalParser, FpDbgDwarf, FpDbgInfo, LazLoggerBase, LazUTF8, sysutils, fpcunit,
|
||||
testregistry, TestHelperClasses, TestDwarfSetup1, TestDwarfSetupBasic;
|
||||
testregistry, TestHelperClasses, TestDwarfSetup1, TestDwarfSetupBasic, TestDwarfSetupArray;
|
||||
|
||||
|
||||
type
|
||||
@ -58,6 +58,7 @@ type
|
||||
Procedure TestExpressionInt;
|
||||
Procedure TestExpressionBool;
|
||||
Procedure TestExpressionEnumAndSet;
|
||||
Procedure TestExpressionArray;
|
||||
Procedure TestExpressionStructures;
|
||||
end;
|
||||
|
||||
@ -441,6 +442,38 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestTypeInfo.TestExpressionArray;
|
||||
var
|
||||
sym: TDbgSymbol;
|
||||
ImgLoader: TTestLoaderSetupArray;
|
||||
TmpResVal: TDbgSymbolValue;
|
||||
i: Integer;
|
||||
s: String;
|
||||
begin
|
||||
InitDwarf(TTestLoaderSetupArray);
|
||||
ImgLoader := TTestLoaderSetupArray(FImageLoader);
|
||||
//FMemReader.RegisterValues[5] := TDbgPtr(@ImgLoader.TestStackFrame.EndPoint);
|
||||
|
||||
FCurrentContext := FDwarfInfo.FindContext(TTestSetupArrayProcMainAddr);
|
||||
AssertTrue('got ctx', FCurrentContext <> nil);
|
||||
|
||||
sym := FCurrentContext.FindSymbol('VarDynIntArray');
|
||||
AssertTrue('got sym', sym <> nil);
|
||||
sym.ReleaseReference();
|
||||
|
||||
StartTest('VarDynIntArray', skArray, [ttHasType]);
|
||||
StartTest('VarStatIntArray1', skArray, [ttHasType]);
|
||||
|
||||
StartInvalTest('VarDynIntArray[0]', 'xxx');
|
||||
|
||||
SetLength(ImgLoader.GlobalVar.VarDynIntArray,33);
|
||||
StartTest('VarDynIntArray[0]', skInteger, [ttHasType]);
|
||||
StartTest('VarDynIntArray[1]', skInteger, [ttHasType]);
|
||||
|
||||
StartTest('VarStatIntArray1[0]', skInteger, [ttHasType]);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestTypeInfo.TestExpressionStructures;
|
||||
var
|
||||
sym: TDbgSymbol;
|
||||
@ -1250,7 +1283,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
RegisterTest(TTestTypeInfo);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user