mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 10:18:05 +02:00
FpDebug: support DW_TAG_variant_part
This commit is contained in:
martin
Martin
parent
4bc63f4650
commit
2fce58a3de
@ -47,6 +47,7 @@ type
|
||||
skAnsiString,
|
||||
skCurrency,
|
||||
skVariant,
|
||||
skVariantPart, // FpDebug only: a DW_TAG_variant_part
|
||||
skWideString,
|
||||
//--------------------------------------------------------------------------
|
||||
skEnum, // Variable holding an enum / enum type
|
||||
|
||||
@ -393,23 +393,46 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfStruct }
|
||||
|
||||
{ TFpValueDwarfStructBase }
|
||||
|
||||
TFpValueDwarfStructBase = class(TFpValueDwarf)
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfStruct }
|
||||
|
||||
TFpValueDwarfStruct = class(TFpValueDwarfStructBase)
|
||||
private
|
||||
FDataAddressDone: Boolean;
|
||||
protected
|
||||
procedure Reset; override;
|
||||
function GetFieldFlags: TFpValueFieldFlags; override;
|
||||
function GetAsCardinal: QWord; override;
|
||||
procedure SetAsCardinal(AValue: QWord); override;
|
||||
function GetDataSize: TFpDbgValueSize; override;
|
||||
function IsValidTypeCast: Boolean; override;
|
||||
|
||||
function GetMemberByName(const AIndex: String): TFpValue; override;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfVariantPart }
|
||||
|
||||
{ TFpValueDwarfVariantBase }
|
||||
|
||||
TFpValueDwarfVariantBase = class(TFpValueDwarf)
|
||||
protected
|
||||
function GetKind: TDbgSymbolKind; override;
|
||||
function GetMemberCount: Integer; override;
|
||||
function GetMember(AIndex: Int64): TFpValue; override;
|
||||
function GetMemberByName(const AIndex: String): TFpValue; override;
|
||||
//function GetMemberEx(const AIndex: array of Int64): TFpValue; override;
|
||||
function GetParentTypeInfo: TFpSymbol; override;
|
||||
end;
|
||||
|
||||
TFpValueDwarfVariantPart = class(TFpValueDwarfVariantBase)
|
||||
protected
|
||||
function GetKind: TDbgSymbolKind; override;
|
||||
(* GetMemberByName:
|
||||
Direct access to the members of the nested variants
|
||||
Only those accessible by Discr.
|
||||
*)
|
||||
function GetMemberByName(const AIndex: String): TFpValue; override;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfConstAddress }
|
||||
@ -876,6 +899,77 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
function HasAddress: Boolean; override;
|
||||
end;
|
||||
|
||||
(* Variants....
|
||||
- A Variant can be:
|
||||
- single conditional value
|
||||
- list of conditional values (record case...)
|
||||
- Establish the value/type pairing
|
||||
- DW_TAG_variant_part should be invisible / the PrettyPrinter can embedd content to the parent
|
||||
- but users may wish to see "raw mode" all fields
|
||||
|
||||
Neither DW_TAG_variant_part nor DW_TAG_variant are actually data or type.
|
||||
TODO: Maybe create some
|
||||
TFpSymbolDwarf"Control"... ?
|
||||
|
||||
|
||||
TFpSymbolDwarfTypeStructure (TYPE)
|
||||
has many:
|
||||
-> TFpSymbolDwarfDataMember .... (DATA) DW_TAG_member
|
||||
|
||||
|
||||
-> TFpSymbolDwarfDataMemberVariantPart (DATA) DW_TAG_variant_part (
|
||||
has discr OR type
|
||||
- DW_AT_discr = ref to DW_TAG_member
|
||||
.TypeInfo = ???
|
||||
|
||||
has many:
|
||||
-> TFpSymbolDwarfDataMemberVariant (DATA) DW_TAG_variant (DW_AT_discr_value or list)
|
||||
- DW_AT_discr_value LEB128 (signed or unsigned - depends on member ref by dw_at_discr)
|
||||
|
||||
has many
|
||||
-> TFpSymbolDwarfDataMember .... (DATA) DW_TAG_member
|
||||
|
||||
*)
|
||||
|
||||
{ TFpSymbolDwarfDataMemberVariantPart }
|
||||
|
||||
TFpSymbolDwarfDataMemberVariantPart = class(TFpSymbolDwarfDataMember)
|
||||
private
|
||||
FMembers: TRefCntObjList;
|
||||
FHasOrdinal: (hoUnknown, hoYes, hoNo);
|
||||
FOrdinalSym: TFpSymbolDwarf;
|
||||
protected
|
||||
function GetValueObject: TFpValue; override;
|
||||
|
||||
procedure CreateMembers; //override;
|
||||
procedure KindNeeded; override;
|
||||
|
||||
//function GetNestedSymbol(AIndex: Int64): TFpSymbol; override;
|
||||
function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
|
||||
function GetNestedSymbolCount: Integer; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfTypeVariant }
|
||||
|
||||
TFpSymbolDwarfTypeVariant = class(TFpSymbolDwarfDataMember)
|
||||
private
|
||||
FMembers: TRefCntObjList;
|
||||
FLastChildByName: TFpSymbolDwarf;
|
||||
|
||||
procedure CreateMembers;
|
||||
function GetNestedSymbolEx(AIndex: Int64; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
|
||||
function GetNestedSymbolExByName(const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol; override;
|
||||
function GetNestedSymbolCount: Integer; override;
|
||||
|
||||
function GetValueObject: TFpValue; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
function MatchesDiscr(ADiscr: QWord): Boolean;
|
||||
function IsDefaultDiscr: Boolean;
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfTypeStructure }
|
||||
|
||||
TFpSymbolDwarfTypeStructure = class(TFpSymbolDwarfType)
|
||||
@ -884,7 +978,7 @@ DECL = DW_AT_decl_column, DW_AT_decl_file, DW_AT_decl_line
|
||||
FMembers: TRefCntObjList;
|
||||
FLastChildByName: TFpSymbolDwarf;
|
||||
FInheritanceInfo: TDwarfInformationEntry;
|
||||
procedure CreateMembers;
|
||||
procedure CreateMembers; virtual;
|
||||
procedure InitInheritanceInfo; inline;
|
||||
protected
|
||||
function DoGetNestedTypeInfo: TFpSymbolDwarfType; override;
|
||||
@ -1136,12 +1230,14 @@ begin
|
||||
DW_TAG_structure_type,
|
||||
DW_TAG_interface_type,
|
||||
DW_TAG_class_type: Result := TFpSymbolDwarfTypeStructure;
|
||||
DW_TAG_variant: Result := TFpSymbolDwarfTypeVariant;
|
||||
DW_TAG_array_type: Result := TFpSymbolDwarfTypeArray;
|
||||
DW_TAG_subroutine_type: Result := TFpSymbolDwarfTypeSubroutine;
|
||||
// Value types
|
||||
DW_TAG_variable: Result := TFpSymbolDwarfDataVariable;
|
||||
DW_TAG_formal_parameter: Result := TFpSymbolDwarfDataParameter;
|
||||
DW_TAG_member: Result := TFpSymbolDwarfDataMember;
|
||||
DW_TAG_variant_part: Result := TFpSymbolDwarfDataMemberVariantPart;
|
||||
DW_TAG_subprogram: Result := TFpSymbolDwarfDataProc;
|
||||
//DW_TAG_inlined_subroutine, DW_TAG_entry_poin
|
||||
//
|
||||
@ -3057,12 +3153,6 @@ end;
|
||||
|
||||
{ TFpValueDwarfStruct }
|
||||
|
||||
procedure TFpValueDwarfStruct.Reset;
|
||||
begin
|
||||
inherited Reset;
|
||||
FDataAddressDone := False;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfStruct.GetFieldFlags: TFpValueFieldFlags;
|
||||
begin
|
||||
Result := inherited GetFieldFlags;
|
||||
@ -3183,6 +3273,141 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfStruct.GetMemberByName(const AIndex: String): TFpValue;
|
||||
var
|
||||
c, i: Integer;
|
||||
n: String;
|
||||
r: TFpValue;
|
||||
begin
|
||||
c := MemberCount;
|
||||
if c > 0 then begin
|
||||
n := UpperCase(AIndex);
|
||||
for i := c - 1 downto 0 do begin
|
||||
Result := Member[i];
|
||||
if (Result <> nil) then begin
|
||||
if (Result.DbgSymbol <> nil) and
|
||||
(UpperCase(Result.DbgSymbol.Name) = n)
|
||||
then
|
||||
exit;
|
||||
if Result is TFpValueDwarfVariantPart then begin
|
||||
r := Result;
|
||||
Result := Result.MemberByName[AIndex];
|
||||
r.ReleaseReference;
|
||||
if Result <> nil then
|
||||
exit;
|
||||
end;
|
||||
Result.ReleaseReference;
|
||||
end;
|
||||
end;
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := inherited GetMemberByName(AIndex);
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfVariantBase }
|
||||
|
||||
function TFpValueDwarfVariantBase.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skNone;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfVariantBase.GetMemberCount: Integer;
|
||||
begin
|
||||
Result := FDataSymbol.NestedSymbolCount;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfVariantBase.GetMember(AIndex: Int64): TFpValue;
|
||||
begin
|
||||
Result := FDataSymbol.GetNestedValue(AIndex);
|
||||
if Result = nil then
|
||||
exit;
|
||||
|
||||
TFpValueDwarf(Result).FParentTypeSymbol := FParentTypeSymbol;
|
||||
TFpValueDwarf(Result).SetStructureValue(StructureValue);
|
||||
TFpValueDwarf(Result).Context := Context;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfVariantBase.GetMemberByName(const AIndex: String
|
||||
): TFpValue;
|
||||
begin
|
||||
Result := FDataSymbol.GetNestedValueByName(AIndex);
|
||||
if Result = nil then
|
||||
exit;
|
||||
|
||||
TFpValueDwarf(Result).FParentTypeSymbol := FParentTypeSymbol;
|
||||
TFpValueDwarf(Result).SetStructureValue(StructureValue);
|
||||
TFpValueDwarf(Result).Context := Context;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfVariantBase.GetParentTypeInfo: TFpSymbol;
|
||||
begin
|
||||
Result := StructureValue.GetParentTypeInfo;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfVariantPart }
|
||||
|
||||
function TFpValueDwarfVariantPart.GetKind: TDbgSymbolKind;
|
||||
begin
|
||||
Result := skVariantPart;
|
||||
end;
|
||||
|
||||
function TFpValueDwarfVariantPart.GetMemberByName(const AIndex: String
|
||||
): TFpValue;
|
||||
var
|
||||
i: Integer;
|
||||
DiscrMember, MemberGroup: TFpValue;
|
||||
hasDiscr, UseDefault: Boolean;
|
||||
discr: QWord;
|
||||
n: String;
|
||||
begin
|
||||
Result := nil;
|
||||
n := UpperCase(AIndex);
|
||||
DiscrMember := Member[-1];
|
||||
if (DiscrMember <> nil) and
|
||||
(DiscrMember.DbgSymbol<> nil) and
|
||||
(UpperCase(DiscrMember.DbgSymbol.Name) = n)
|
||||
then begin
|
||||
Result := DiscrMember;
|
||||
exit;
|
||||
end;
|
||||
hasDiscr := DiscrMember.FieldFlags * [svfInteger, svfCardinal, svfOrdinal] <> [];
|
||||
if hasDiscr then
|
||||
discr := DiscrMember.AsCardinal;
|
||||
|
||||
for UseDefault := False to True do begin
|
||||
for i := 0 to MemberCount - 1 do begin
|
||||
MemberGroup := Member[i];
|
||||
if MemberGroup is TFpValueDwarfVariantBase then begin
|
||||
if not (
|
||||
( (not UseDefault) and hasDiscr and
|
||||
TFpSymbolDwarfTypeVariant(MemberGroup.DbgSymbol).MatchesDiscr(discr)
|
||||
) or
|
||||
( UseDefault and
|
||||
TFpSymbolDwarfTypeVariant(MemberGroup.DbgSymbol).IsDefaultDiscr
|
||||
)
|
||||
)
|
||||
then
|
||||
continue;
|
||||
Result := MemberGroup.MemberByName[AIndex];
|
||||
if Result <> nil then begin
|
||||
MemberGroup.ReleaseReference;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (MemberGroup.DbgSymbol<> nil) and
|
||||
(UpperCase(MemberGroup.DbgSymbol.Name) = n)
|
||||
then begin
|
||||
Result := MemberGroup;
|
||||
exit;
|
||||
end;
|
||||
MemberGroup.ReleaseReference;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TFpValueDwarfConstAddress }
|
||||
|
||||
procedure TFpValueDwarfConstAddress.Update(const AnAddress: TFpDbgMemLocation);
|
||||
@ -5312,6 +5537,213 @@ begin
|
||||
//(InformationEntry.HasAttrib(DW_AT_data_member_location));
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfDataMemberVariantPart }
|
||||
|
||||
function TFpSymbolDwarfDataMemberVariantPart.GetValueObject: TFpValue;
|
||||
begin
|
||||
Result := TFpValueDwarfVariantPart.Create(nil);
|
||||
TFpValueDwarf(Result).SetDataSymbol(self);
|
||||
end;
|
||||
|
||||
procedure TFpSymbolDwarfDataMemberVariantPart.CreateMembers;
|
||||
var
|
||||
Info: TDwarfInformationEntry;
|
||||
Info2: TDwarfInformationEntry;
|
||||
sym: TFpSymbolDwarf;
|
||||
begin
|
||||
if FMembers <> nil then
|
||||
exit;
|
||||
FMembers := TRefCntObjList.Create;
|
||||
Info := InformationEntry.Clone;
|
||||
Info.GoChild;
|
||||
|
||||
while Info.HasValidScope do begin
|
||||
if (Info.AbbrevTag = DW_TAG_variant) then begin
|
||||
Info2 := Info.Clone;
|
||||
sym := TFpSymbolDwarf.CreateSubClass('', Info2);
|
||||
FMembers.Add(sym);
|
||||
sym.ReleaseReference;
|
||||
Info2.ReleaseReference;
|
||||
end;
|
||||
Info.GoNext;
|
||||
end;
|
||||
|
||||
Info.ReleaseReference;
|
||||
end;
|
||||
|
||||
procedure TFpSymbolDwarfDataMemberVariantPart.KindNeeded;
|
||||
begin
|
||||
SetKind(skVariantPart);
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfDataMemberVariantPart.GetNestedSymbolEx(AIndex: Int64;
|
||||
out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
|
||||
var
|
||||
FwdInfoPtr: Pointer;
|
||||
FwdCompUint: TDwarfCompilationUnit;
|
||||
InfoEntry: TDwarfInformationEntry;
|
||||
begin
|
||||
AnParentTypeSymbol := nil;
|
||||
|
||||
if AIndex = -1 then begin
|
||||
Result := FOrdinalSym;
|
||||
if FHasOrdinal <> hoUnknown then
|
||||
exit;
|
||||
|
||||
FHasOrdinal := hoNo;
|
||||
if InformationEntry.ReadReference(DW_AT_discr, FwdInfoPtr, FwdCompUint) then begin
|
||||
InfoEntry := TDwarfInformationEntry.Create(FwdCompUint, FwdInfoPtr);
|
||||
FOrdinalSym := TFpSymbolDwarf.CreateSubClass('', InfoEntry);
|
||||
Result := FOrdinalSym;
|
||||
ReleaseRefAndNil(InfoEntry);
|
||||
FHasOrdinal := hoYes;
|
||||
end;
|
||||
if (FHasOrdinal = hoNo) and (TypeInfo <> nil) then
|
||||
Result := Self;
|
||||
exit;
|
||||
end;
|
||||
|
||||
CreateMembers;
|
||||
|
||||
Result := TFpSymbol(FMembers[AIndex]);
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfDataMemberVariantPart.GetNestedSymbolCount: Integer;
|
||||
begin
|
||||
CreateMembers;
|
||||
Result := FMembers.Count;
|
||||
end;
|
||||
|
||||
destructor TFpSymbolDwarfDataMemberVariantPart.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FMembers);
|
||||
FOrdinalSym.ReleaseReference;
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfTypeVariant }
|
||||
|
||||
procedure TFpSymbolDwarfTypeVariant.CreateMembers;
|
||||
var
|
||||
Info: TDwarfInformationEntry;
|
||||
Info2: TDwarfInformationEntry;
|
||||
sym: TFpSymbolDwarf;
|
||||
begin
|
||||
// same as TFpSymbolDwarfTypeStructure.CreateMembers;
|
||||
if FMembers <> nil then
|
||||
exit;
|
||||
FMembers := TRefCntObjList.Create;
|
||||
Info := InformationEntry.Clone;
|
||||
Info.GoChild;
|
||||
|
||||
while Info.HasValidScope do begin
|
||||
if (Info.AbbrevTag = DW_TAG_member) or (Info.AbbrevTag = DW_TAG_subprogram) or
|
||||
(Info.AbbrevTag = DW_TAG_variant_part)
|
||||
then begin
|
||||
Info2 := Info.Clone;
|
||||
sym := TFpSymbolDwarf.CreateSubClass('', Info2);
|
||||
FMembers.Add(sym);
|
||||
sym.ReleaseReference;
|
||||
Info2.ReleaseReference;
|
||||
end;
|
||||
Info.GoNext;
|
||||
end;
|
||||
|
||||
Info.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.GetNestedSymbolEx(AIndex: Int64; out
|
||||
AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
|
||||
var
|
||||
i: Int64;
|
||||
ti: TFpSymbolDwarfType;
|
||||
begin
|
||||
CreateMembers;
|
||||
|
||||
AnParentTypeSymbol := nil;
|
||||
Result := TFpSymbol(FMembers[AIndex]);
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.GetNestedSymbolExByName(
|
||||
const AIndex: String; out AnParentTypeSymbol: TFpSymbolDwarfType): TFpSymbol;
|
||||
var
|
||||
i: Integer;
|
||||
Ident: TDwarfInformationEntry;
|
||||
n: String;
|
||||
begin
|
||||
AnParentTypeSymbol := nil;
|
||||
// Todo, maybe create all children?
|
||||
if FLastChildByName <> nil then begin
|
||||
FLastChildByName.ReleaseReference;
|
||||
FLastChildByName := nil;
|
||||
end;
|
||||
Result := nil;
|
||||
|
||||
if FMembers <> nil then begin
|
||||
n := UpperCase(AIndex);
|
||||
i := FMembers.Count - 1;
|
||||
while i >= 0 do begin
|
||||
if UpperCase(TFpSymbol(FMembers[i]).Name) = n then begin
|
||||
Result := TFpSymbol(FMembers[i]);
|
||||
exit;
|
||||
end;
|
||||
dec(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
Ident := InformationEntry.FindNamedChild(AIndex);
|
||||
if Ident <> nil then begin
|
||||
FLastChildByName := TFpSymbolDwarf.CreateSubClass('', Ident);
|
||||
//assert is member ?
|
||||
ReleaseRefAndNil(Ident);
|
||||
Result := FLastChildByName;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.GetNestedSymbolCount: Integer;
|
||||
begin
|
||||
CreateMembers;
|
||||
Result := FMembers.Count;
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.GetValueObject: TFpValue;
|
||||
begin
|
||||
Result := TFpValueDwarfVariantBase.Create(nil);
|
||||
TFpValueDwarf(Result).SetDataSymbol(self);
|
||||
end;
|
||||
|
||||
destructor TFpSymbolDwarfTypeVariant.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
FreeAndNil(FMembers);
|
||||
FLastChildByName.ReleaseReference;
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.MatchesDiscr(ADiscr: QWord): Boolean;
|
||||
var
|
||||
d: QWord;
|
||||
begin
|
||||
// TODO: DW_AT_discr_list;
|
||||
Result := InformationEntry.HasAttrib(DW_AT_discr_value);
|
||||
if not Result then
|
||||
exit;
|
||||
|
||||
Result := InformationEntry.ReadValue(DW_AT_discr_value, d) and
|
||||
(ADiscr = d);
|
||||
end;
|
||||
|
||||
function TFpSymbolDwarfTypeVariant.IsDefaultDiscr: Boolean;
|
||||
var
|
||||
d: array of byte;
|
||||
begin
|
||||
Result := (not InformationEntry.HasAttrib(DW_AT_discr_value)) and
|
||||
( (not InformationEntry.HasAttrib(DW_AT_discr_list)) or
|
||||
(not (InformationEntry.ReadValue(DW_AT_discr_list, d))) or
|
||||
(Length(d)=0)
|
||||
)
|
||||
;
|
||||
end;
|
||||
|
||||
{ TFpSymbolDwarfTypeStructure }
|
||||
|
||||
function TFpSymbolDwarfTypeStructure.GetNestedSymbolExByName(
|
||||
@ -5433,7 +5865,9 @@ begin
|
||||
Info.GoChild;
|
||||
|
||||
while Info.HasValidScope do begin
|
||||
if (Info.AbbrevTag = DW_TAG_member) or (Info.AbbrevTag = DW_TAG_subprogram) then begin
|
||||
if (Info.AbbrevTag = DW_TAG_member) or (Info.AbbrevTag = DW_TAG_subprogram) or
|
||||
(Info.AbbrevTag = DW_TAG_variant_part)
|
||||
then begin
|
||||
Info2 := Info.Clone;
|
||||
sym := TFpSymbolDwarf.CreateSubClass('', Info2);
|
||||
FMembers.Add(sym);
|
||||
|
||||
@ -1200,7 +1200,7 @@ function TFpPascalPrettyPrinter.InternalPrintValue(out APrintedValue: String;
|
||||
APrintedValue := '';
|
||||
for i := 0 to AValue.MemberCount-1 do begin
|
||||
MemberValue := AValue.Member[i];
|
||||
if (MemberValue = nil) or (MemberValue.Kind in [skProcedure, skFunction]) then begin
|
||||
if (MemberValue = nil) or (MemberValue.Kind in [skProcedure, skFunction, skVariantPart]) then begin
|
||||
MemberValue.ReleaseReference;
|
||||
continue;
|
||||
end;
|
||||
|
||||
@ -408,6 +408,95 @@ end;
|
||||
|
||||
function TFpWatchResultConvertor.StructToResData(AnFpValue: TFpValue;
|
||||
AnResData: TLzDbgWatchDataIntf): Boolean;
|
||||
|
||||
procedure AddVariantMembers(VariantPart: TFpValue; ResAnch: TLzDbgWatchDataIntf);
|
||||
var
|
||||
VariantContainer, VMember: TFpValue;
|
||||
i, j: Integer;
|
||||
ResField, ResList: TLzDbgWatchDataIntf;
|
||||
discr: QWord;
|
||||
hasDiscr, FoundDiscr, UseDefault: Boolean;
|
||||
MBVis: TLzDbgFieldVisibility;
|
||||
n: String;
|
||||
begin
|
||||
VariantContainer := VariantPart.Member[-1];
|
||||
if VariantContainer = nil then
|
||||
exit;
|
||||
|
||||
ResList := ResAnch.AddField('', dfvUnknown, [dffVariant]);
|
||||
ResList.CreateArrayValue(datUnknown);
|
||||
|
||||
hasDiscr := (VariantContainer <> nil) and
|
||||
(VariantContainer.FieldFlags * [svfInteger, svfCardinal, svfOrdinal] <> []);
|
||||
if hasDiscr then begin
|
||||
discr := VariantContainer.AsCardinal;
|
||||
|
||||
n := '';
|
||||
MBVis := dfvUnknown;
|
||||
if (VariantContainer.DbgSymbol <> nil) then begin
|
||||
n := VariantContainer.DbgSymbol.Name;
|
||||
case VariantContainer.DbgSymbol.MemberVisibility of
|
||||
svPrivate: MBVis := dfvPrivate;
|
||||
svProtected: MBVis := dfvProtected;
|
||||
svPublic: MBVis := dfvPublic;
|
||||
else MBVis := dfvUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
if n <> '' then begin
|
||||
ResField := ResList.SetNextArrayData;
|
||||
ResField := ResField.CreateVariantValue(n, MBVis);
|
||||
if not DoWritePointerWatchResultData(VariantContainer, ResField, 0) then // addr
|
||||
ResField.CreateError('Unknown');
|
||||
end;
|
||||
end;
|
||||
VariantContainer.ReleaseReference;
|
||||
|
||||
FoundDiscr := False;
|
||||
For UseDefault := (not hasDiscr) to True do begin
|
||||
for i := 0 to VariantPart.MemberCount - 1 do begin
|
||||
VariantContainer := VariantPart.Member[i];
|
||||
if (VariantContainer.DbgSymbol <> nil) and
|
||||
(VariantContainer.DbgSymbol is TFpSymbolDwarfTypeVariant) and
|
||||
( ( (not UseDefault) and
|
||||
(TFpSymbolDwarfTypeVariant(VariantContainer.DbgSymbol).MatchesDiscr(discr))
|
||||
) or
|
||||
( (UseDefault) and
|
||||
(TFpSymbolDwarfTypeVariant(VariantContainer.DbgSymbol).IsDefaultDiscr)
|
||||
)
|
||||
)
|
||||
then begin
|
||||
FoundDiscr := True;
|
||||
for j := 0 to VariantContainer.MemberCount - 1 do begin
|
||||
VMember := VariantContainer.Member[j];
|
||||
n := '';
|
||||
MBVis := dfvUnknown;
|
||||
if (VMember.DbgSymbol <> nil) then begin
|
||||
n := VMember.DbgSymbol.Name;
|
||||
case VariantContainer.DbgSymbol.MemberVisibility of
|
||||
svPrivate: MBVis := dfvPrivate;
|
||||
svProtected: MBVis := dfvProtected;
|
||||
svPublic: MBVis := dfvPublic;
|
||||
else MBVis := dfvUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
// TODO visibility
|
||||
ResField := ResList.SetNextArrayData;
|
||||
ResField := ResField.CreateVariantValue(n, MBVis);
|
||||
if not DoWritePointerWatchResultData(VMember, ResField, 0) then // addr
|
||||
ResField.CreateError('Unknown');
|
||||
VMember.ReleaseReference;
|
||||
end;
|
||||
end;
|
||||
|
||||
VariantContainer.ReleaseReference;
|
||||
end;
|
||||
if FoundDiscr then
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
TAnchestorMap = specialize TFPGMap<PtrUInt, TLzDbgWatchDataIntf>;
|
||||
var
|
||||
@ -517,6 +606,12 @@ begin
|
||||
ResAnch := UnkAnch;
|
||||
end;
|
||||
|
||||
if MemberValue.Kind = skVariantPart then begin
|
||||
AddVariantMembers(MemberValue, ResAnch);
|
||||
MemberValue.ReleaseReference;
|
||||
continue;
|
||||
end;
|
||||
|
||||
sym := MemberValue.DbgSymbol;
|
||||
if sym <> nil then begin
|
||||
MbName := sym.Name;
|
||||
|
||||
@ -774,6 +774,13 @@ StartIdx := t.Count; // tlConst => Only eval the watch. No tests
|
||||
t.Add(AName, p+'UnicodeString2'+e+'[2]', weWideChar('a')) .CharFromIndex(stDwarf2).IgnTypeName(stDwarf3Up);
|
||||
t.Add(AName, p+'UnicodeString5'+e+'[1]', weWideChar(AChr1)) .CharFromIndex(stDwarf2).IgnTypeName(stDwarf3Up);
|
||||
t.Add(AName, p+'UnicodeString5'+e+'[2]', weWideChar('Y')) .CharFromIndex(stDwarf2).IgnTypeName(stDwarf3Up);
|
||||
|
||||
t.Add(AName, p+'Variant_1'+e, weMatch('71237',skVariant))
|
||||
.SkipIf(ALoc in [tlPointerAny])
|
||||
.IgnKind();
|
||||
t.Add(AName, p+'Variant_2'+e, weMatch('True',skVariant))
|
||||
.SkipIf(ALoc in [tlPointerAny])
|
||||
.IgnKind();
|
||||
for i := StartIdx to t.Count-1 do
|
||||
t.Tests[i].SkipIf(ALoc in [tlConst, tlClassConst]);
|
||||
|
||||
|
||||
@ -111,7 +111,7 @@ type
|
||||
TLzDbgStructType = (dstUnknown, dstRecord, dstObject, dstClass, dstInterface, dstInternal);
|
||||
TLzDbgArrayType = (datUnknown, datDynArray, datStatArray);
|
||||
TLzDbgFieldVisibility = (dfvUnknown, dfvPrivate, dfvProtected, dfvPublic, dfvPublished);
|
||||
TLzDbgFieldFlag = (dffClass, dffAbstract, dffVirtual, dffOverwritten, dffConstructor, dffDestructor);
|
||||
TLzDbgFieldFlag = (dffClass, dffAbstract, dffVirtual, dffOverwritten, dffConstructor, dffDestructor, dffVariant);
|
||||
TLzDbgFieldFlags = set of TLzDbgFieldFlag;
|
||||
|
||||
{ TLzDbgWatchDataIntf:
|
||||
@ -150,6 +150,7 @@ type
|
||||
procedure CreateSetValue(const ANames: TStringDynArray); //; const AOrdValues: array of Integer);
|
||||
// // CreateSetValue: "ASetVal" only has "length(ANames)" entries. Any higher value will be ignored / should be zero
|
||||
// procedure CreateSetValue(const ASetVal: TLzDbgSetData; const ANames: TStringDynArray); //; const AOrdValues: array of Integer);
|
||||
function CreateVariantValue(AName: String = ''; AVisibility: TLzDbgFieldVisibility = dfvUnknown): TLzDbgWatchDataIntf;
|
||||
|
||||
//temporary
|
||||
function CreateProcedure(AVal: TDBGPtr; AnIsFunction: Boolean; ALoc, ADesc: String): TLzDbgWatchDataIntf;
|
||||
|
||||
Binary file not shown.
@ -129,6 +129,17 @@
|
||||
pre__UnicodeString4{e} _OP_ TUStrA (CHR1+'B'#0'X'#9'b'#10#13); //@@ _pre3_UnicodeString4{e3};
|
||||
pre__UnicodeString5{e} _OP_ TUStrTA (CHR1+'YcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghijAbcdefghij'); //@@ _pre3_UnicodeString5{e3};
|
||||
|
||||
{$IFnDEF TestType}
|
||||
{$IFnDEF TestConst}
|
||||
pre__Variant_1{e} _O2_ variant _EQ_ (71237); //@@ _pre3_Variant_1{e3};
|
||||
pre__Variant_2{e} _O2_ variant _EQ_ (True); //@@ _pre3_Variant_2{e3};
|
||||
{$ELSE}
|
||||
// not supported
|
||||
pre__Variant_1{e} = (71237); // }}}}
|
||||
pre__Variant_2{e} = (True); // }}}}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
// wide string char...
|
||||
|
||||
// types that may get confused with strings
|
||||
|
||||
@ -407,7 +407,7 @@ const
|
||||
('', 'Private', 'Protected', 'Public', 'Published');
|
||||
var
|
||||
Res, Fld, Fld2: TWatchResultData;
|
||||
i, FldCnt, MethCnt, f, m: Integer;
|
||||
FldCnt, MethCnt, f, m: Integer;
|
||||
FldInfo: TWatchResultDataFieldInfo;
|
||||
AnchType: String;
|
||||
begin
|
||||
@ -431,8 +431,7 @@ begin
|
||||
MethCnt := 0;
|
||||
|
||||
if Res.StructType in [dstClass, dstObject] then begin
|
||||
for i := 1 to Res.FieldCount do begin
|
||||
FldInfo := Res.Fields[i-1];
|
||||
for FldInfo in res do begin
|
||||
if (FldInfo.Field <> nil) and
|
||||
( (FldInfo.Field.ValueKind in [rdkFunction, rdkProcedure, rdkFunctionRef, rdkProcedureRef]) or
|
||||
(ExtractProcResFromMethod(FldInfo.Field) <> nil)
|
||||
@ -444,7 +443,8 @@ begin
|
||||
end;
|
||||
end
|
||||
else
|
||||
FldCnt := Res.FieldCount;
|
||||
for FldInfo in res do
|
||||
inc(FldCnt);
|
||||
|
||||
DataPage.TabVisible := FldCnt > 0;
|
||||
PropertiesPage.TabVisible :=false;
|
||||
@ -456,9 +456,7 @@ begin
|
||||
FGridMethods.RowCount := max(MethCnt+1, 2);
|
||||
f := 1;
|
||||
m := 1;
|
||||
for i := 1 to Res.FieldCount do begin
|
||||
FldInfo := Res.Fields[i-1];
|
||||
|
||||
for FldInfo in res do begin
|
||||
Fld := FldInfo.Field;
|
||||
Fld2 := ExtractProcResFromMethod(Fld);
|
||||
if (MethCnt > 0) and
|
||||
|
||||
@ -1418,20 +1418,18 @@ begin
|
||||
(AWatchValue.ResultData.StructType <> dstInternal)
|
||||
then begin
|
||||
ResData := AWatchValue.ResultData;
|
||||
ChildCount := ResData.FieldCount;
|
||||
AWatch := AWatchValue.Watch;
|
||||
ExistingNode := tvWatches.GetFirstChildNoInit(VNode);
|
||||
if ExistingNode <> nil then
|
||||
tvWatches.NodeControl[ExistingNode].Free;
|
||||
|
||||
AnchClass := ResData.TypeName;
|
||||
for i := 0 to ResData.FieldCount-1 do begin
|
||||
ChildInfo := ResData.Fields[i];
|
||||
for ChildInfo in ResData do begin
|
||||
NewWatch := AWatch.ChildrenByNameAsField[ChildInfo.FieldName, AnchClass];
|
||||
if NewWatch = nil then begin
|
||||
dec(ChildCount);
|
||||
continue;
|
||||
end;
|
||||
inc(ChildCount);
|
||||
|
||||
if AWatch is TCurrentWatch then begin
|
||||
NewWatch.DisplayFormat := wdfDefault;
|
||||
|
||||
@ -710,6 +710,7 @@ type
|
||||
// //procedure CreateEnumValue(ANumValue: QWord; const ANames: TStringDynArray; const AOrdValues: TIntegerDynArray);
|
||||
procedure CreateSetValue(const ANames: TStringDynArray);
|
||||
//procedure CreateSetValue(const ASetVal: TLzDbgSetData; const ANames: TStringDynArray); //; const AOrdValues: array of Integer);
|
||||
function CreateVariantValue(AName: String = ''; AVisibility: TLzDbgFieldVisibility = dfvUnknown): TLzDbgWatchDataIntf;
|
||||
procedure CreateStructure(AStructType: TLzDbgStructType;
|
||||
ADataAddress: TDBGPtr = 0
|
||||
//AOwnFieldCount: Integer = 0; // Fields declared in this structure (no anchestors)
|
||||
@ -3482,6 +3483,13 @@ begin
|
||||
FNewResultData.SetEntryCount(FCurrentIdx + 1);
|
||||
end
|
||||
else
|
||||
if (FNewResultData.ValueKind = rdkVariant) then begin
|
||||
FSubCurrentData.Done;
|
||||
FNewResultData.SetDerefData(FSubCurrentData.FNewResultData);
|
||||
FSubCurrentData.FNewResultData := nil;
|
||||
FreeAndNil(FSubCurrentData);
|
||||
end
|
||||
else
|
||||
if (FNewResultData.ValueKind in [rdkStruct]) then begin
|
||||
WriteFieldsToRes(0, FNewResultData);
|
||||
end;
|
||||
@ -3696,6 +3704,25 @@ begin
|
||||
AfterDataCreated;
|
||||
end;
|
||||
|
||||
function TCurrentResData.CreateVariantValue(AName: String;
|
||||
AVisibility: TLzDbgFieldVisibility): TLzDbgWatchDataIntf;
|
||||
begin
|
||||
BeforeCreateValue;
|
||||
assert((FNewResultData=nil) or (FNewResultData.ValueKind=rdkVariant), 'TCurrentResData.CreateVariantValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkVariant)');
|
||||
if FNewResultData = nil then
|
||||
FNewResultData := TWatchResultDataVariant.Create(AName, AVisibility)
|
||||
else
|
||||
TWatchResultDataVariant(FNewResultData).Create(AName, AVisibility);
|
||||
|
||||
if FSubCurrentData <> nil then
|
||||
FSubCurrentData.FreeResultAndSubDataAndDestroy;
|
||||
// Don't set the FOwnerCurrentData
|
||||
FSubCurrentData := TCurrentResData.Create;
|
||||
FSubCurrentData.FFLags := FSubCurrentData.FFLags + [crfFreeResData, crfFreeErrResData];
|
||||
Result := FSubCurrentData;
|
||||
AfterDataCreated;
|
||||
end;
|
||||
|
||||
procedure TCurrentResData.CreateStructure(AStructType: TLzDbgStructType;
|
||||
ADataAddress: TDBGPtr);
|
||||
begin
|
||||
|
||||
@ -135,10 +135,11 @@ const
|
||||
'', 'private', 'protected', 'public', 'published'
|
||||
);
|
||||
var
|
||||
i: Integer;
|
||||
j: Integer;
|
||||
FldInfo: TWatchResultDataFieldInfo;
|
||||
FldOwner: TWatchResultData;
|
||||
FldOwner, VarField: TWatchResultData;
|
||||
vis, indent, sep, tn: String;
|
||||
InclVisSect: Boolean;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
@ -199,11 +200,10 @@ begin
|
||||
else
|
||||
sep := ' ';
|
||||
|
||||
InclVisSect := (ADispFormat = wdfStructure) and (AResValue.StructType in [dstClass, dstObject]);
|
||||
FldOwner := nil;
|
||||
vis := '';
|
||||
for i := 0 to AResValue.FieldCount - 1 do begin
|
||||
FldInfo := AResValue.Fields[i];
|
||||
|
||||
for FldInfo in AResValue do begin
|
||||
if FldOwner <> FldInfo.Owner then begin
|
||||
FldOwner := FldInfo.Owner;
|
||||
vis := '';
|
||||
@ -217,19 +217,19 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
if (ADispFormat = wdfStructure) and (AResValue.StructType in [dstClass, dstObject]) then begin
|
||||
if vis <> VisibilityNames[FldInfo.FieldVisibility] then begin
|
||||
vis := VisibilityNames[FldInfo.FieldVisibility];
|
||||
if (Length(Result) > 0) then
|
||||
Result := Result + sep;
|
||||
Result := Result + indent + vis;
|
||||
end;
|
||||
if InclVisSect and (vis <> VisibilityNames[FldInfo.FieldVisibility]) then begin
|
||||
vis := VisibilityNames[FldInfo.FieldVisibility];
|
||||
if (Length(Result) > 0) then
|
||||
Result := Result + sep;
|
||||
Result := Result + indent + vis;
|
||||
end;
|
||||
|
||||
if (Length(Result) > 0) then
|
||||
Result := Result + sep;
|
||||
|
||||
Result := Result + indent + FldInfo.FieldName + ': ' +
|
||||
PrintWatchValueEx(FldInfo.Field, wdfDefault, ANestLvl) + ';';
|
||||
|
||||
if Length(Result) > 1000*1000 div Max(1, ANestLvl*4) then begin
|
||||
Result := Result + sep +'...';
|
||||
break;
|
||||
|
||||
@ -7,7 +7,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Types, IdeDebuggerUtils, LazDebuggerIntf,
|
||||
LazDebuggerIntfBaseTypes, LazUTF8, Laz2_XMLCfg, LazLoggerBase, StrUtils;
|
||||
LazDebuggerIntfBaseTypes, LazUTF8, Laz2_XMLCfg, LazLoggerBase;
|
||||
|
||||
type
|
||||
|
||||
@ -17,6 +17,7 @@ type
|
||||
rdkString, rdkWideString, rdkChar,
|
||||
rdkSignedNumVal, rdkUnsignedNumVal, rdkPointerVal, rdkFloatVal,
|
||||
rdkBool, rdkEnum, rdkEnumVal, rdkSet,
|
||||
rdkVariant,
|
||||
rdkPCharOrString,
|
||||
rdkArray,
|
||||
rdkStruct,
|
||||
@ -291,6 +292,25 @@ type
|
||||
VKind = rdkError;
|
||||
end;
|
||||
|
||||
TWatchResultValueVariant = object(TWatchResultValue)
|
||||
protected const
|
||||
VKind = rdkVariant;
|
||||
private
|
||||
FVariantData: TWatchResultData; // This may contain "Value"-Data. Will be stored in NestedStorage
|
||||
FVisibility: TLzDbgFieldVisibility;
|
||||
FName: String;
|
||||
protected
|
||||
property GetDerefData: TWatchResultData read FVariantData;
|
||||
property GetAsString: String read FName;
|
||||
procedure AfterAssign(ATypeOnly: Boolean = False);
|
||||
procedure DoFree;
|
||||
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
||||
const AnEntryTemplate: TWatchResultData;
|
||||
var AnOverrideTemplate: TOverrideTemplateData;
|
||||
AnAsProto: Boolean);
|
||||
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
|
||||
end;
|
||||
|
||||
{ TWatchResultValueArrayBase }
|
||||
|
||||
TWatchResultValueArrayBase = object(TWatchResultValue)
|
||||
@ -587,6 +607,7 @@ type
|
||||
wdEnum, // TWatchResultDataEnum
|
||||
wdEnumVal, // TWatchResultDataEnumVal
|
||||
wdSet, // TWatchResultDataSet
|
||||
wdVar, // TWatchResultDataVariant
|
||||
wdPChrStr, // TWatchResultDataPCharOrString
|
||||
wdArray, // TWatchResultDataArray
|
||||
wdDynA, // TWatchResultDataDynArray
|
||||
@ -611,6 +632,18 @@ type
|
||||
Owner: TWatchResultData; // defined in class
|
||||
end;
|
||||
|
||||
{ TWatchResultDataEnumerator }
|
||||
|
||||
TWatchResultDataEnumerator = class
|
||||
private
|
||||
FSource: TWatchResultData;
|
||||
function GetCurrent: TWatchResultDataFieldInfo; virtual;
|
||||
public
|
||||
constructor Create(ARes: TWatchResultData);
|
||||
function MoveNext: Boolean; virtual;
|
||||
property Current: TWatchResultDataFieldInfo read GetCurrent;
|
||||
end;
|
||||
|
||||
{ TWatchResultData }
|
||||
|
||||
TWatchResultData = class abstract // (TRefCountedObject)
|
||||
@ -670,6 +703,8 @@ type
|
||||
function GetFieldCount: Integer; virtual; abstract;
|
||||
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; virtual; abstract;
|
||||
|
||||
function GetFieldVisibility: TLzDbgFieldVisibility; virtual; abstract;
|
||||
|
||||
public
|
||||
constructor CreateEmpty;
|
||||
class function CreateFromXMLConfig(const AConfig: TXMLConfig; const APath: string): TWatchResultData; overload;
|
||||
@ -685,6 +720,7 @@ type
|
||||
procedure Assign(ASource: TWatchResultData; ATypeOnly: Boolean = False); virtual;
|
||||
function CreateCopy(ATypeOnly: Boolean = False): TWatchResultData;
|
||||
|
||||
function GetEnumerator: TWatchResultDataEnumerator; virtual;
|
||||
public
|
||||
property ValueKind: TWatchResultDataKind read GetValueKind;
|
||||
property TypeName: String read FTypeName;
|
||||
@ -725,6 +761,8 @@ type
|
||||
property DirectFieldCount: Integer read GetDirectFieldCount; // without inherited fields
|
||||
property Fields[AnIndex: Integer]: TWatchResultDataFieldInfo read GetFields;
|
||||
|
||||
// variant
|
||||
property FieldVisibility: TLzDbgFieldVisibility read GetFieldVisibility;
|
||||
end;
|
||||
TWatchResultDataClass = class of TWatchResultData;
|
||||
|
||||
@ -898,6 +936,7 @@ type
|
||||
function GetFieldCount: Integer; override;
|
||||
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; override;
|
||||
|
||||
function GetFieldVisibility: TLzDbgFieldVisibility; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
|
||||
@ -1076,6 +1115,18 @@ type
|
||||
constructor Create(const ANames: TStringDynArray);
|
||||
end;
|
||||
|
||||
{ TWatchResultDataVariant }
|
||||
|
||||
TWatchResultDataVariant = class(specialize TGenericWatchResultData<TWatchResultValueVariant>)
|
||||
private
|
||||
function GetClassID: TWatchResultDataClassID; override;
|
||||
protected
|
||||
function GetFieldVisibility: TLzDbgFieldVisibility; override;
|
||||
public
|
||||
constructor Create(AName: String; AVisibility: TLzDbgFieldVisibility);
|
||||
procedure SetDerefData(ADerefData: TWatchResultData); override;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataArrayBase }
|
||||
|
||||
generic TWatchResultDataArrayBase<_DATA, _TYPE> = class(specialize TGenericWatchResultDataWithType<_DATA, _TYPE>)
|
||||
@ -1163,6 +1214,32 @@ type
|
||||
|
||||
generic TGenericWatchResultDataStruct<_DATA, _TYPE> = class(specialize TGenericWatchResultDataWithType<_DATA, _TYPE>)
|
||||
private type
|
||||
{ TWatchResultDataStructVariantEnumerator }
|
||||
|
||||
TWatchResultDataStructVariantEnumerator = class(TWatchResultDataEnumerator)
|
||||
private
|
||||
FIndex: Integer;
|
||||
protected
|
||||
function GetCurrent: TWatchResultDataFieldInfo; override;
|
||||
public
|
||||
constructor Create(ARes: TWatchResultData);
|
||||
function MoveNext: Boolean; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TWatchResultDataStructEnumerator }
|
||||
|
||||
TWatchResultDataStructEnumerator = class(TWatchResultDataEnumerator)
|
||||
private
|
||||
FIndex: Integer;
|
||||
FSubEnumerator: TWatchResultDataStructVariantEnumerator;
|
||||
FSubOwner: TWatchResultData;
|
||||
protected
|
||||
function GetCurrent: TWatchResultDataFieldInfo; override;
|
||||
public
|
||||
constructor Create(ARes: TWatchResultData);
|
||||
function MoveNext: Boolean; override;
|
||||
end;
|
||||
|
||||
{ TNestedFieldsWatchResultStorage }
|
||||
|
||||
@ -1219,6 +1296,8 @@ type
|
||||
//AOwnFieldCount: Integer = 0; // Fields declared in this structure (no anchestors)
|
||||
//ARecurseFieldCount: Integer = 0 // Fields including anchestors
|
||||
);
|
||||
function GetEnumerator: TWatchResultDataEnumerator; override;
|
||||
|
||||
procedure SetAnchestor(AnAnchestor: TWatchResultData); override;
|
||||
procedure SetFieldCount(ACount: integer); override;
|
||||
procedure SetField(AnIndex: Integer;
|
||||
@ -1346,6 +1425,7 @@ const
|
||||
TWatchResultDataEnum, // wdEnum
|
||||
TWatchResultDataEnumVal, // wdEnumVal
|
||||
TWatchResultDataSet, // wdSet
|
||||
TWatchResultDataVariant, // wdVar
|
||||
TWatchResultDataPCharOrString, // wdPChrStr
|
||||
TWatchResultDataArray, // wdArray,
|
||||
TWatchResultDataDynArray, // wdDynA,
|
||||
@ -1747,6 +1827,43 @@ begin
|
||||
AConfig.SetDeleteValue(APath + 'Value', ''.Join(',', FNames), '');
|
||||
end;
|
||||
|
||||
{ TWatchResultValueVariant }
|
||||
|
||||
procedure TWatchResultValueVariant.AfterAssign(ATypeOnly: Boolean);
|
||||
begin
|
||||
FVariantData := FVariantData.CreateCopy();
|
||||
end;
|
||||
|
||||
procedure TWatchResultValueVariant.DoFree;
|
||||
begin
|
||||
FVariantData.Free;
|
||||
end;
|
||||
|
||||
procedure TWatchResultValueVariant.LoadDataFromXMLConfig(
|
||||
const AConfig: TXMLConfig; const APath: string;
|
||||
const AnEntryTemplate: TWatchResultData;
|
||||
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
|
||||
var
|
||||
p: String;
|
||||
d: TOverrideTemplateData;
|
||||
begin
|
||||
if AnAsProto then
|
||||
exit;
|
||||
p := APath + 'var/';
|
||||
d := nil;
|
||||
if AConfig.HasPath(p, True) then
|
||||
FVariantData := TWatchResultData.CreateFromXMLConfig(AConfig, p, nil,
|
||||
d);
|
||||
assert(d=nil, 'TWatchResultValueVariant.LoadDataFromXMLConfig: d=nil');
|
||||
end;
|
||||
|
||||
procedure TWatchResultValueVariant.SaveDataToXMLConfig(const AConfig: TXMLConfig;
|
||||
const APath: string; AnAsProto: Boolean);
|
||||
begin
|
||||
if FVariantData <> nil then
|
||||
FVariantData.SaveDataToXMLConfig(AConfig, APath + 'var/', AnAsProto);
|
||||
end;
|
||||
|
||||
{ TWatchResultValueArrayBase }
|
||||
|
||||
function TWatchResultValueArrayBase.GetCount: Integer;
|
||||
@ -2226,6 +2343,23 @@ begin
|
||||
Result.Assign(Self);
|
||||
end;
|
||||
|
||||
{ TWatchResultDataEnumerator }
|
||||
|
||||
function TWatchResultDataEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
||||
begin
|
||||
Result := Default(TWatchResultDataFieldInfo);
|
||||
end;
|
||||
|
||||
constructor TWatchResultDataEnumerator.Create(ARes: TWatchResultData);
|
||||
begin
|
||||
FSource := ARes;
|
||||
end;
|
||||
|
||||
function TWatchResultDataEnumerator.MoveNext: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ TWatchResultData }
|
||||
|
||||
function TWatchResultData.GetValueKind: TWatchResultDataKind;
|
||||
@ -2313,6 +2447,11 @@ begin
|
||||
Result.Assign(Self, ATypeOnly);
|
||||
end;
|
||||
|
||||
function TWatchResultData.GetEnumerator: TWatchResultDataEnumerator;
|
||||
begin
|
||||
Result := TWatchResultDataEnumerator.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TWatchResultData.SetSelectedIndex(AnIndex: Integer);
|
||||
begin
|
||||
//
|
||||
@ -2937,6 +3076,11 @@ begin
|
||||
Result := Default(TWatchResultDataFieldInfo);
|
||||
end;
|
||||
|
||||
function TGenericWatchResultData.GetFieldVisibility: TLzDbgFieldVisibility;
|
||||
begin
|
||||
Result := dfvUnknown;
|
||||
end;
|
||||
|
||||
destructor TGenericWatchResultData.Destroy;
|
||||
begin
|
||||
FData.DoFree;
|
||||
@ -3406,6 +3550,31 @@ begin
|
||||
FData.FNames := ANames;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataVariant }
|
||||
|
||||
function TWatchResultDataVariant.GetClassID: TWatchResultDataClassID;
|
||||
begin
|
||||
Result := wdVar;
|
||||
end;
|
||||
|
||||
function TWatchResultDataVariant.GetFieldVisibility: TLzDbgFieldVisibility;
|
||||
begin
|
||||
Result := FData.FVisibility;
|
||||
end;
|
||||
|
||||
constructor TWatchResultDataVariant.Create(AName: String;
|
||||
AVisibility: TLzDbgFieldVisibility);
|
||||
begin
|
||||
inherited Create;
|
||||
FData.FName := AName;
|
||||
FData.FVisibility := AVisibility;
|
||||
end;
|
||||
|
||||
procedure TWatchResultDataVariant.SetDerefData(ADerefData: TWatchResultData);
|
||||
begin
|
||||
FData.FVariantData := ADerefData;
|
||||
end;
|
||||
|
||||
{ TWatchResultDataArrayBase }
|
||||
|
||||
procedure TWatchResultDataArrayBase.SetEntryPrototype(AnEntry: TWatchResultData);
|
||||
@ -3666,6 +3835,71 @@ begin
|
||||
FType.FLowBound := ALowBound;
|
||||
end;
|
||||
|
||||
{ TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator }
|
||||
|
||||
function TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
||||
begin
|
||||
FSource.SetSelectedIndex(FIndex);
|
||||
Result := Default(TWatchResultDataFieldInfo);
|
||||
Result.Field := FSource.SelectedEntry.DerefData;
|
||||
Result.FieldName := FSource.SelectedEntry.AsString;
|
||||
Result.FieldVisibility := FSource.SelectedEntry.FieldVisibility;
|
||||
end;
|
||||
|
||||
constructor TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.Create
|
||||
(ARes: TWatchResultData);
|
||||
begin
|
||||
inherited Create(ARes);
|
||||
FIndex := -1;
|
||||
end;
|
||||
|
||||
function TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.MoveNext: Boolean;
|
||||
begin
|
||||
inc(FIndex);
|
||||
Result := FIndex < FSource.Count;
|
||||
end;
|
||||
|
||||
{ TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator }
|
||||
|
||||
function TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.GetCurrent: TWatchResultDataFieldInfo;
|
||||
begin
|
||||
if FSubEnumerator <> nil then begin
|
||||
Result := FSubEnumerator.Current;
|
||||
Result.Owner := FSubOwner;
|
||||
end
|
||||
else
|
||||
Result := FSource.Fields[FIndex];
|
||||
end;
|
||||
|
||||
constructor TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.Create
|
||||
(ARes: TWatchResultData);
|
||||
begin
|
||||
inherited Create(ARes);
|
||||
FIndex := -1;
|
||||
end;
|
||||
|
||||
function TGenericWatchResultDataStruct.TWatchResultDataStructEnumerator.MoveNext: Boolean;
|
||||
begin
|
||||
if FSubEnumerator <> nil then begin
|
||||
if FSubEnumerator.MoveNext then
|
||||
exit
|
||||
else
|
||||
FreeAndNil(FSubEnumerator);
|
||||
end;
|
||||
|
||||
inc(FIndex);
|
||||
Result := FIndex < FSource.FieldCount;
|
||||
|
||||
if Result and (dffVariant in FSource.Fields[FIndex].FieldFlags) then begin
|
||||
FSubOwner := FSource.Fields[FIndex].Owner;
|
||||
FSubEnumerator := TGenericWatchResultDataStruct.TWatchResultDataStructVariantEnumerator.Create(
|
||||
FSource.Fields[FIndex].Field
|
||||
);
|
||||
if not FSubEnumerator.MoveNext then
|
||||
FreeAndNil(FSubEnumerator);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage }
|
||||
|
||||
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetStoredFieldCount: Integer;
|
||||
@ -4029,6 +4263,11 @@ begin
|
||||
FType.FStructType := AStructType;
|
||||
end;
|
||||
|
||||
function TGenericWatchResultDataStruct.GetEnumerator: TWatchResultDataEnumerator;
|
||||
begin
|
||||
Result := TWatchResultDataStructEnumerator.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TGenericWatchResultDataStruct.SetAnchestor(AnAnchestor: TWatchResultData);
|
||||
begin
|
||||
FType.FAnchestor := AnAnchestor;
|
||||
@ -4150,13 +4389,8 @@ end;
|
||||
|
||||
procedure TWatchResultDataError.TErrorDataStorage.SaveDataToXMLConfig(
|
||||
const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
|
||||
var
|
||||
N: String;
|
||||
begin
|
||||
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
|
||||
N := '';
|
||||
if ANestLvl > 0 then N := 'N'+IntToStr(ANestLvl);
|
||||
|
||||
AConfig.SetDeleteValue(APath+TAG_ALL_ERR, ANestLvl, -1);
|
||||
end;
|
||||
|
||||
|
||||
@ -262,6 +262,7 @@ type
|
||||
procedure TestWatchStuctNested;
|
||||
procedure TestWatchArrayStuct;
|
||||
procedure TestWatchArrayStuctArrayStuct;
|
||||
procedure TestWatchArrayVariant;
|
||||
|
||||
end;
|
||||
|
||||
@ -1297,6 +1298,30 @@ begin
|
||||
ResIntfPtr2.SetTypeName('TMyNum');
|
||||
AssertPtrPointerToSignedNumData('', t.IdeRes, 110, 120, 121, 1, 'TMyPtr', 'TMyNestPtr', 'TMyNum');
|
||||
t.Done;
|
||||
|
||||
|
||||
t.Init;
|
||||
t.ResIntf.CreatePointerValue(110);
|
||||
t.ResIntf.SetTypeName('TMyPtr');
|
||||
ResIntfPtr := t.ResIntf.SetDerefData;
|
||||
ResIntfPtr.CreateNumValue(121, True, 1);
|
||||
ResIntfPtr.SetTypeName('TMyNum');
|
||||
t.ResIntf.CreateError('ouch');
|
||||
AssertErrData('', t.IdeRes, 'ouch');
|
||||
t.Done;
|
||||
|
||||
t.Init;
|
||||
t.ResIntf.CreatePointerValue(110);
|
||||
t.ResIntf.SetTypeName('TMyPtr');
|
||||
ResIntfPtr := t.ResIntf.SetDerefData;
|
||||
ResIntfPtr.CreatePointerValue(120);
|
||||
ResIntfPtr.SetTypeName('TMyNestPtr');
|
||||
ResIntfPtr2 := ResIntfPtr.SetDerefData;
|
||||
ResIntfPtr2.CreateNumValue(121, True, 1);
|
||||
ResIntfPtr2.SetTypeName('TMyNum');
|
||||
t.ResIntf.CreateError('ouch');
|
||||
AssertErrData('', t.IdeRes, 'ouch');
|
||||
t.Done;
|
||||
end;
|
||||
|
||||
procedure TTestIdeDebuggerWatchResult.TestWatchResPCharOrString;
|
||||
@ -2446,6 +2471,105 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestIdeDebuggerWatchResult.TestWatchArrayVariant;
|
||||
var
|
||||
t: TTestWatchResWrapper;
|
||||
x, aVarErr: Integer;
|
||||
EntryIntf, VarIntf: TLzDbgWatchDataIntf;
|
||||
Res: TWatchResultData;
|
||||
aEntryType1, aEntryType2: TTestCreateDataKind;
|
||||
aErr1, aErr2: Boolean;
|
||||
begin
|
||||
for x := 0 to 2 do
|
||||
for aEntryType1 := low(TTestCreateDataKind) to high(TTestCreateDataKind) do
|
||||
for aEntryType2 := low(TTestCreateDataKind) to high(TTestCreateDataKind) do
|
||||
for aErr1 := low(Boolean) to high(Boolean) do
|
||||
for aErr2 := low(Boolean) to high(Boolean) do
|
||||
for aVarErr := -1 to 2 do
|
||||
begin
|
||||
t.Init;
|
||||
t.ResIntf.CreateArrayValue(datUnknown, 5);
|
||||
|
||||
EntryIntf := t.ResIntf.SetNextArrayData;
|
||||
VarIntf := EntryIntf.CreateVariantValue;
|
||||
CreateData(VarIntf, aEntryType1, aErr1, 'T1');
|
||||
if aVarErr = 0 then
|
||||
EntryIntf.CreateError('err-v');
|
||||
|
||||
EntryIntf := t.ResIntf.SetNextArrayData;
|
||||
VarIntf := EntryIntf.CreateVariantValue;
|
||||
CreateData(VarIntf, aEntryType2, aErr2, 'T2');
|
||||
if aVarErr = 1 then
|
||||
EntryIntf.CreateError('err-v');
|
||||
|
||||
EntryIntf := t.ResIntf.SetNextArrayData;
|
||||
VarIntf := EntryIntf.CreateVariantValue;
|
||||
CreateData(VarIntf, cdErrNum, False, 'T3');
|
||||
if aVarErr = 2 then
|
||||
EntryIntf.CreateError('err-v');
|
||||
|
||||
|
||||
Res := t.GetIdeRes;
|
||||
case x of
|
||||
1: Res := SaveLoad(Res);
|
||||
2: Res := Res.CreateCopy;
|
||||
end;
|
||||
if x > 0 then
|
||||
t.Done;
|
||||
|
||||
|
||||
AssertValKind('', Res, rdkArray);
|
||||
AssertArrayData('', Res, datUnknown, 3, 0);
|
||||
|
||||
Res.SetSelectedIndex(0);
|
||||
if aVarErr = 0 then begin
|
||||
AssertErrData('0e', res.SelectedEntry, 'err-v');
|
||||
end
|
||||
else begin
|
||||
AssertValKind('0', Res.SelectedEntry, rdkVariant);
|
||||
AssertData('0', Res.SelectedEntry.DerefData, aEntryType1, aErr1, 'T1');
|
||||
end;
|
||||
|
||||
Res.SetSelectedIndex(1);
|
||||
if aVarErr = 1 then begin
|
||||
AssertErrData('1e', res.SelectedEntry, 'err-v');
|
||||
end
|
||||
else begin
|
||||
AssertValKind('1', Res.SelectedEntry, rdkVariant);
|
||||
AssertData('1', Res.SelectedEntry.DerefData, aEntryType2, aErr2, 'T2');
|
||||
end;
|
||||
|
||||
Res.SetSelectedIndex(2);
|
||||
if aVarErr = 2 then begin
|
||||
AssertErrData('2e', res.SelectedEntry, 'err-v');
|
||||
end
|
||||
else begin
|
||||
AssertValKind('2', Res.SelectedEntry, rdkVariant);
|
||||
AssertData('2', Res.SelectedEntry.DerefData, cdErrNum, False, 'T3');
|
||||
end;
|
||||
|
||||
Res.SetSelectedIndex(0);
|
||||
if aVarErr = 0 then begin
|
||||
AssertErrData('0e', res.SelectedEntry, 'err-v');
|
||||
end
|
||||
else begin
|
||||
AssertValKind('0', Res.SelectedEntry, rdkVariant);
|
||||
AssertData('0', Res.SelectedEntry.DerefData, aEntryType1, aErr1, 'T1');
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
if x > 0 then
|
||||
Res.Free
|
||||
else
|
||||
t.Done;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
Loading…
Reference in New Issue
Block a user