paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 08:58:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: new result type for ConvertValue

Browse Source
This commit is contained in:
Martin 2022-08-03 13:03:40 +02:00
parent cbb17d6aeb
commit 2d0c2ea8ba
14 changed files with 548 additions and 210 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas
View File

@ -1101,7 +1101,6 @@ var
WatchResConv: TFpLazDbgWatchResultConvertor;
ResData: TLzDbgWatchDataIntf;
i: Integer;
ValConfig: TFpDbgConverterConfig;
begin
Result := False;
AResText := '';
@ -1179,9 +1178,10 @@ begin
WatchResConv.ExtraDepth := defExtraDepth in FWatchValue.EvaluateFlags;
WatchResConv.FirstIndexOffs := FWatchValue.FirstIndexOffs;
if not (defSkipValConv in AnEvalFlags) then begin
ValConfig := TFpDbgConverterConfig(FWatchValue.GetFpDbgConverter);
if ValConfig <> nil then
WatchResConv.ValConfig := ValConfig
if (FWatchValue.GetFpDbgConverter <> nil) and
(FWatchValue.GetFpDbgConverter.GetBackendSpecificObject is TFpDbgConverterConfig)
then
WatchResConv.ValConfig := TFpDbgConverterConfig(FWatchValue.GetFpDbgConverter.GetBackendSpecificObject)
else
WatchResConv.ValConvList := ValueConverterConfigList;
WatchResConv.Debugger := FDebugger;

3
components/lazdebuggers/lazdebuggerfp/fpdebuggerresultdata.pas
View File

@ -160,8 +160,7 @@ begin
dec(FCurMaxArrayConv);
end;
AnResData.CreateStructure(dstInternal);
AnResFld := AnResData.AddField('', dfvUnknown, []);
AnResFld := AnResData.CreateValueHandleResult(CurConv);
if (CurConv <> nil) then begin
FInNonConvert := True;

20
components/lazdebuggers/lazdebuggerfp/fpdebugvalueconvertors.pas
View File

@ -8,7 +8,7 @@ uses
Classes, SysUtils, fgl, FpDbgInfo, FpdMemoryTools, FpDbgCallContextInfo,
FpPascalBuilder, FpErrorMessages, FpDbgClasses, FpDbgUtil,
DbgIntfBaseTypes, lazCollections, LazClasses, LCLProc, StrUtils,
FpDebugDebuggerBase, LazDebuggerIntfBaseTypes;
FpDebugDebuggerBase, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
type
TDbgSymbolKinds = set of TDbgSymbolKind;
@ -20,9 +20,11 @@ type
- Any setting that the IDE may need to store, should be published
*)
TFpDbgValueConverter = class(TRefCountedObject)
TFpDbgValueConverter = class(TRefCountedObject, TLazDbgValueConverterIntf)
private
FLastErrror: TFpError;
protected
function GetObject: TObject;
public
class function GetName: String; virtual; abstract;
class function GetSupportedKinds: TDbgSymbolKinds; virtual;
@ -46,12 +48,14 @@ type
{ TFpDbgConverterConfig }
TFpDbgConverterConfig = class(TFreeNotifyingObject)
TFpDbgConverterConfig = class(TFreeNotifyingObject, TLazDbgValueConvertSelectorIntf)
private
FConverter: TFpDbgValueConverter;
FMatchKinds: TDbgSymbolKinds;
FMatchTypeNames: TStrings;
procedure SetConverter(AValue: TFpDbgValueConverter);
protected
function GetBackendSpecificObject: TObject;
public
constructor Create(AConverter: TFpDbgValueConverter);
destructor Destroy; override;
@ -158,6 +162,11 @@ begin
FLastErrror := AnError;
end;
function TFpDbgValueConverter.GetObject: TObject;
begin
Result := Self;
end;
class function TFpDbgValueConverter.GetSupportedKinds: TDbgSymbolKinds;
begin
Result := [low(TDbgSymbolKinds)..high(TDbgSymbolKinds)];
@ -179,6 +188,11 @@ begin
FConverter.AddReference;
end;
function TFpDbgConverterConfig.GetBackendSpecificObject: TObject;
begin
Result := Self;
end;
function TFpDbgConverterConfig.CreateCopy: TFpDbgConverterConfig;
begin
Result := TFpDbgConverterConfigClass(ClassType).Create(nil);

6
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.lpk
View File

@ -35,7 +35,11 @@ See LCL license for details."/>
</Item>
<Item>
<Filename Value="lazdebuggerintfbasetypes.pas"/>
<UnitName Value="lazdebuggerintfbasetypes"/>
<UnitName Value="LazDebuggerIntfBaseTypes"/>
</Item>
<Item>
<Filename Value="lazdebuggervalueconverter.pas"/>
<UnitName Value="LazDebuggerValueConverter"/>
</Item>
</Files>
<RequiredPkgs>

7
components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas
View File

@ -21,7 +21,7 @@ unit LazDebuggerIntf;
interface
uses
Classes, SysUtils, Types, LazDebuggerIntfBaseTypes;
Classes, SysUtils, Types, LazDebuggerValueConverter, LazDebuggerIntfBaseTypes;
type
TDBGState = LazDebuggerIntfBaseTypes.TDBGState deprecated 'Use LazDebuggerIntfBaseTypes.TDBGState';
@ -167,6 +167,9 @@ type
//AOwnFieldCount: Integer = 0; // Fields declared in this structure (no anchestors)
//ARecurseFieldCount: Integer = 0 // Fields including anchestors
);
// returns the intf for the converted result
// Use SetDerefData to get the interface for the NON-converted result
function CreateValueHandleResult(AValueHandler: TLazDbgValueConverterIntf): TLzDbgWatchDataIntf;
procedure CreateError(AVal: String);
// For all Values
@ -239,7 +242,7 @@ type
function GetDisplayFormat: TWatchDisplayFormat;
function GetEvaluateFlags: TWatcheEvaluateFlags;
function GetFpDbgConverter: TObject;
function GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
function GetExpression: String;
function GetFirstIndexOffs: Int64;
function GetRepeatCount: Integer;

3
components/lazdebuggers/lazdebuggerintf/lazdebuggerintfpackage.pas
View File

@ -8,7 +8,8 @@ unit lazdebuggerintfpackage;
interface
uses
LazDebuggerIntf, LazDebuggerTemplate, LazDebuggerIntfBaseTypes;
LazDebuggerIntf, LazDebuggerTemplate, LazDebuggerIntfBaseTypes,
LazDebuggerValueConverter;
implementation

29
components/lazdebuggers/lazdebuggerintf/lazdebuggervalueconverter.pas Normal file
View File

@ -0,0 +1,29 @@
unit LazDebuggerValueConverter;
{$mode objfpc}{$H+}
{$INTERFACES CORBA}
interface
uses
Classes, SysUtils;
type
TLazDbgValueConverterIntf = interface
procedure AddReference;
procedure ReleaseReference;
function GetObject: TObject;
end;
TLazDbgValueConvertSelectorIntf = interface
procedure AddFreeNotification(ANotification: TNotifyEvent);
procedure RemoveFreeNotification(ANotification: TNotifyEvent);
function GetBackendSpecificObject: TObject;
end;
implementation
end.

3
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -1376,8 +1376,7 @@ begin
WatchVal := TstWatch.Values[Thread, Stack];
Context.WatchRes := WatchVal.ResultData;
if (Context.WatchRes <> nil) and
(Context.WatchRes.ValueKind = rdkStruct) and
(Context.WatchRes.StructType = dstInternal) and
(Context.WatchRes.ValueKind = rdkConvertRes) and
(Context.WatchRes.FieldCount > 0)
then
Context.WatchRes := Context.WatchRes.Fields[0].Field;

4
debugger/inspectdlg.pas
View File

@ -1226,8 +1226,7 @@ begin
else begin
// resultdata
if (FCurrentResData.ValueKind = rdkStruct) and
(FCurrentResData.StructType = dstInternal)
if (FCurrentResData.ValueKind = rdkConvertRes)
then begin
if (FCurrentResData.FieldCount > 0) then
//if (FCurrentResData.FieldCount = 1) then
@ -1275,6 +1274,7 @@ begin
rdkSet: InspectResDataSet;
rdkArray: InspectResDataArray;
rdkStruct: InspectResDataStruct;
// rdkConvertRes: InspectResDataStruct;
else begin
Clear;
StatusBar1.SimpleText:=Format(lisInspectUnavailableError, [ShortenedExpression, FHumanReadable]);

4
debugger/watchesdlg.pp
View File

@ -1290,7 +1290,7 @@ begin
HasChildren := ( (TypInfo <> nil) and (TypInfo.Fields <> nil) and (TypInfo.Fields.Count > 0) ) or
( (WatchValue.ResultData <> nil) and
( ( (WatchValue.ResultData.FieldCount > 0) and (WatchValue.ResultData.StructType <> dstInternal) )
( ( (WatchValue.ResultData.FieldCount > 0) and (WatchValue.ResultData.ValueKind <> rdkConvertRes) )
or
//( (WatchValue.ResultData.ValueKind = rdkArray) and (WatchValue.ResultData.ArrayLength > 0) )
(WatchValue.ResultData.ArrayLength > 0)
@ -1436,7 +1436,7 @@ begin
ChildCount := 0;
if (AWatchValue.ResultData <> nil) and (AWatchValue.ResultData.FieldCount > 0) and
(AWatchValue.ResultData.StructType <> dstInternal)
(AWatchValue.ResultData.ValueKind <> rdkConvertRes)
then begin
ResData := AWatchValue.ResultData;
AWatch := AWatchValue.Watch;

34
ide/packages/idedebugger/debugger.pp
View File

@ -43,8 +43,8 @@ uses
Laz2_XMLCfg, LazFileUtils, LazStringUtils, LazUtilities, LazLoggerBase,
LazClasses, Maps, LazMethodList,
// DebuggerIntf
DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfDebuggerBase,
LazDebuggerIntf, LazDebuggerIntfBaseTypes, IdeDebuggerBase,
DbgIntfBaseTypes, DbgIntfMiscClasses, DbgIntfDebuggerBase, LazDebuggerIntf,
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, IdeDebuggerBase,
IdeDebuggerWatchResult, IdeDebuggerOpts, IdeDebuggerFpDbgValueConv;
const
@ -726,6 +726,7 @@ type
//AOwnFieldCount: Integer = 0; // Fields declared in this structure (no anchestors)
//ARecurseFieldCount: Integer = 0 // Fields including anchestors
);
function CreateValueHandleResult(AValueHandler: TLazDbgValueConverterIntf): TLzDbgWatchDataIntf;
procedure CreateError(AVal: String); virtual;
@ -761,7 +762,7 @@ type
procedure AddNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
procedure RemoveNotification(AnEventType: TWatcheEvaluateEvent; AnEvent: TNotifyEvent);
function ResData: TLzDbgWatchDataIntf;
function GetFpDbgConverter: TObject;
function GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
private
FOnValidityChanged: TNotifyEvent;
FSnapShot: TIdeWatchValue;
@ -3501,7 +3502,7 @@ begin
FreeAndNil(FSubCurrentData);
end
else
if (FNewResultData.ValueKind in [rdkStruct]) then begin
if (FNewResultData.ValueKind in [rdkStruct, rdkConvertRes]) then begin
WriteFieldsToRes(0, FNewResultData);
end;
end;
@ -3755,6 +3756,22 @@ begin
AfterDataCreated;
end;
function TCurrentResData.CreateValueHandleResult(
AValueHandler: TLazDbgValueConverterIntf): TLzDbgWatchDataIntf;
begin
BeforeCreateValue;
assert((FNewResultData=nil) or (FNewResultData.ValueKind=rdkConvertRes), 'TCurrentResData.CreateVariantValue: (FNewResultData=nil) or (FNewResultData.ValueKind=rdkConvertRes)');
if FNewResultData = nil then
FNewResultData := TWatchResultDataConverted.Create(AValueHandler)
else
TWatchResultDataConverted(FNewResultData).Create(AValueHandler);
FCurrentIdx := 0;
AfterDataCreated;
Result := AddField('', dfvUnknown, []);
end;
function TCurrentResData.CreateArrayValue(AnArrayType: TLzDbgArrayType;
ATotalCount: Integer; ALowIdx: Integer): TLzDbgWatchDataIntf;
begin
@ -3830,6 +3847,11 @@ end;
function TCurrentResData.SetDerefData: TLzDbgWatchDataIntf;
begin
if (FNewResultData<> nil) and (FNewResultData.ValueKind = rdkConvertRes) then begin
Result := AddField('', dfvUnknown, []);
exit;
end;
assert((FNewResultData<>nil) and (FNewResultData is TWatchResultDataPointer), 'TCurrentResData.SetDerefData: (FNewResultData<>nil) and (FNewResultData is TWatchResultDataPointer)');
if FSubCurrentData = nil then
FSubCurrentData := CreateSubCurrentResData;
@ -3885,7 +3907,7 @@ var
NewField: TCurrentResData;
begin
Result := nil;
assert((FNewResultData<>nil) and (FNewResultData.ValueKind in [rdkStruct]), 'TCurrentResData.AddField: (FNewResultData<>nil) and (FNewResultData.ValueKind in [rdkStruct])');
assert((FNewResultData<>nil) and (FNewResultData.ValueKind in [rdkStruct, rdkConvertRes]), 'TCurrentResData.AddField: (FNewResultData<>nil) and (FNewResultData.ValueKind in [rdkStruct])');
if FCurrentFields = nil then begin
FCurrentFields := TCurrentResDataList.Create(True);
@ -3975,7 +3997,7 @@ begin
Result := FCurrentResData;
end;
function TCurrentWatchValue.GetFpDbgConverter: TObject;
function TCurrentWatchValue.GetFpDbgConverter: TLazDbgValueConvertSelectorIntf;
begin
Result := FFpDbgConverter;
end;

15
ide/packages/idedebugger/idedebuggerbase.pas
View File

@ -256,17 +256,10 @@ begin
exit;
end;
if (Result.ValueKind = rdkStruct) and (Result.StructType = dstInternal) and
(Result.FieldCount > 0)
then begin
if (Result.FieldCount = 1) or
( (Result.Fields[0].Field <> nil) and ((Result.Fields[0].Field.ValueKind <> rdkError)) )
then
Result := Result.Fields[0].Field
else
if (Result.FieldCount > 1) then
Result := Result.Fields[1].Field;
end;
if (Result.ValueKind = rdkConvertRes) and (Result.FieldCount > 0) and
(Result.Fields[0].Field.ValueKind <> rdkError)
then
Result := Result.Fields[0].Field;
case FResultDataContent of
rdcJSon:

62
ide/packages/idedebugger/idedebuggerwatchresprinter.pas
View File

@ -19,6 +19,7 @@ type
function PrintNumber(ANumValue: TWatchResultData; AnIsPointer: Boolean; ADispFormat: TWatchDisplayFormat): String;
function PrintArray(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
function PrintStruct(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
function PrintConverted(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
function PrintProc(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
function PrintWatchValueEx(AResValue: TWatchResultData; ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
@ -142,36 +143,6 @@ var
begin
Result := '';
if (AResValue.ValueKind = rdkStruct) and
(AResValue.StructType = dstInternal)
then begin
if AResValue.FieldCount = 0 then
exit('Error: No result');
if (AResValue.FieldCount = 1) or
( (AResValue.Fields[0].Field <> nil) and
((AResValue.Fields[0].Field.ValueKind <> rdkError))
)
then begin
Result := PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl);
exit;
end;
if (AResValue.FieldCount > 1) then begin
Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl);
if (AResValue.Fields[0].Field = nil) or
(AResValue.Fields[0].Field.ValueKind <> rdkError) or
(AResValue.Fields[0].Field.AsString <> '')
then
Result := Result + ' { '
+ PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl)
+ ' }';
exit;
end;
exit('Error: No result');
end;
if (AResValue.StructType in [dstClass, dstInterface])
then begin
tn := AResValue.TypeName;
@ -253,6 +224,36 @@ begin
Result := tn + Result;
end;
function TWatchResultPrinter.PrintConverted(AResValue: TWatchResultData;
ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
begin
if AResValue.FieldCount = 0 then
exit('Error: No result');
if (AResValue.FieldCount = 1) or
( (AResValue.Fields[0].Field <> nil) and
((AResValue.Fields[0].Field.ValueKind <> rdkError))
)
then begin
Result := PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl);
exit;
end;
if (AResValue.FieldCount > 1) then begin
Result := PrintWatchValueEx(AResValue.Fields[1].Field, ADispFormat, ANestLvl);
if (AResValue.Fields[0].Field = nil) or
(AResValue.Fields[0].Field.ValueKind <> rdkError) or
(AResValue.Fields[0].Field.AsString <> '')
then
Result := Result + ' { '
+ PrintWatchValueEx(AResValue.Fields[0].Field, ADispFormat, ANestLvl)
+ ' }';
exit;
end;
Result := 'Error: No result';
end;
function TWatchResultPrinter.PrintProc(AResValue: TWatchResultData;
ADispFormat: TWatchDisplayFormat; ANestLvl: Integer): String;
var
@ -448,6 +449,7 @@ begin
end;
rdkArray: Result := PrintArray(AResValue, ADispFormat, ANestLvl);
rdkStruct: Result := PrintStruct(AResValue, ADispFormat, ANestLvl);
rdkConvertRes: Result := PrintConverted(AResValue, ADispFormat, ANestLvl);
rdkFunction,
rdkProcedure,
rdkFunctionRef,

560
ide/packages/idedebugger/idedebuggerwatchresult.pas
View File

@ -7,7 +7,8 @@ interface
uses
Classes, SysUtils, Types, IdeDebuggerUtils, LazDebuggerIntf,
LazDebuggerIntfBaseTypes, LazUTF8, Laz2_XMLCfg, LazLoggerBase;
LazDebuggerIntfBaseTypes, LazDebuggerValueConverter, LazUTF8, Laz2_XMLCfg,
LazLoggerBase;
type
@ -21,6 +22,7 @@ type
rdkPCharOrString,
rdkArray,
rdkStruct,
rdkConvertRes,
rdkFunction, rdkProcedure,
rdkFunctionRef, rdkProcedureRef
);
@ -461,14 +463,38 @@ type
property GetDataAddress: TDBGPtr read FDataAddress;
end;
{ TWatchResultValueConverted }
TWatchResultValueConverted = object(TWatchResultValue)
protected const
VKind = rdkConvertRes;
end;
{ TWatchResultTypeStructBase }
TWatchResultTypeStructBase = object(TWatchResultValue)
private
FFieldData: packed array of TWatchResultTypeStructFieldInfo;
public
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);
function GetFieldCount: Integer; inline;
function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline;
procedure AfterAssign(ATypeOnly: Boolean = False);
procedure CopyFieldsProtoFrom(const ASource: TWatchResultTypeStructBase); inline;
procedure DoFree;
end;
{ TWatchResultTypeStruct }
TWatchResultTypeStruct = object(TWatchResultValue)
TWatchResultTypeStruct = object(TWatchResultTypeStructBase)
private
FStructType: TLzDbgStructType;
// FStructFlags: TLzDbgStructFlags; // dsfDummyAnchestor
FFieldData: packed array of TWatchResultTypeStructFieldInfo;
FAnchestor: TWatchResultData;
public
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
@ -479,10 +505,17 @@ type
property GetStructType: TLzDbgStructType read FStructType;
// property GetStructFlags: TLzDbgStructFlags read FStructFlags;
property GetAnchestor: TWatchResultData read FAnchestor;
function GetFieldCount: Integer; inline;
function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline;
procedure AfterAssign(ATypeOnly: Boolean = False);
procedure CopyFieldsProtoFrom(const ASource: TWatchResultTypeStruct); inline;
procedure DoFree;
end;
{ TWatchResultTypeConverted }
TWatchResultTypeConverted = object(TWatchResultTypeStructBase)
private
FHandler: TLazDbgValueConverterIntf;
public
procedure AfterAssign(ATypeOnly: Boolean = False);
procedure DoFree;
end;
@ -623,6 +656,7 @@ type
wdStatA, // TWatchResultDataStatArray
wdStruct, // TWatchResultDataStruct
wdStructRef, // TWatchResultDataRefStruct
wdConverted, // TWatchResultDataConverted
wdFunc, // TWatchResultDataFunc,
wdProc, // TWatchResultDataProc,
wdFuncRef, // TWatchResultDataFuncRef,
@ -664,6 +698,7 @@ type
// FDataFlags: TWatchResultDataFlags;
// Addr: TDbgPtr;
// MemDump
function GetBackendValueHandler: TLazDbgValueConverterIntf;
function GetClassID: TWatchResultDataClassID; virtual; //abstract;
protected
class function GetStorageClass: TWatchResultStorageClass; virtual; abstract;
@ -756,6 +791,7 @@ type
property NestedType: TWatchResultData read GetNestedType; // NESTED TYPE FOR NESTED STORAGE
property ElementName[AnIndex: Integer]: String read GetElementName;
property BackendValueHandler: TLazDbgValueConverterIntf read GetBackendValueHandler;
// Array
property ArrayType: TLzDbgArrayType read GetArrayType;
@ -1266,7 +1302,6 @@ type
TNestedFieldsWatchResultStorage = class(TGenericWatchResultStorage)
private
FAnchestorStorage: TWatchResultStorage;
FFieldsStorage: array of TWatchResultStorage;
FOverrideTempl: array of TOverrideTemplateData;
function GetStoredFieldCount: Integer;
@ -1293,7 +1328,6 @@ type
PNestedFieldsWatchResultStorage = ^TNestedFieldsWatchResultStorage;
private
FCurrentAnchestor: TWatchResultData;
FCurrentFields: array of TWatchResultData;
protected
class function GetStorageClass: TWatchResultStorageClass; override;
@ -1311,15 +1345,9 @@ type
var AnOverrideTemplate: TOverrideTemplateData); override;
procedure ClearData; override;
function GetFields(AnIndex: Integer): TWatchResultDataFieldInfo; override;
function GetAnchestor: TWatchResultData; override;
public
constructor Create(AStructType: TLzDbgStructType
//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;
AFieldName: String;
@ -1335,18 +1363,71 @@ type
procedure SetFieldData(AnIndex: Integer; AData: TWatchResultData); override;
end;
{ TWatchResultDataRefStruct }
{ TGenericWatchResultDataStructWithAnchestor }
generic TGenericWatchResultDataStructWithAnchestor<_DATA, _TYPE> = class(specialize TGenericWatchResultDataStruct<_DATA, _TYPE>)
private type
{ TNestedFieldsAndAnchestorWatchResultStorage }
TNestedFieldsAndAnchestorWatchResultStorage = class(TNestedFieldsWatchResultStorage)
private
FAnchestorStorage: TWatchResultStorage;
protected
procedure SetCount(AValue: integer); override;
procedure Assign(ASource: TWatchResultStorage); override;
function GetNestedStorage(AnIndex: Integer): TWatchResultStorage; reintroduce;
function GetNestedStoragePtr(AnIndex: Integer): PWatchResultStorage; reintroduce;
procedure SetNestedStorage(AnIndex: Integer; AValue: TWatchResultStorage); reintroduce;
public
destructor Destroy; override;
procedure LoadDataFromXMLConfig(const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData;
ANestLvl: Integer=0); override;
procedure SaveDataToXMLConfig(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer=0); override;
property NestedStorage[AnIndex: Integer]: TWatchResultStorage read GetNestedStorage write SetNestedStorage;
property NestedStoragePtr[AnIndex: Integer]: PWatchResultStorage read GetNestedStoragePtr;
property StoredFieldCount: Integer read GetStoredFieldCount write SetStoredFieldCount;
end;
PNestedFieldsAndAnchestorWatchResultStorage = ^TNestedFieldsAndAnchestorWatchResultStorage;
TWatchResultDataStruct = class(specialize TGenericWatchResultDataStruct<TWatchResultValueStruct, TWatchResultTypeStruct>)
private
function GetClassID: TWatchResultDataClassID; override;
FCurrentAnchestor: TWatchResultData;
protected
class function GetStorageClass: TWatchResultStorageClass; override;
function CreateStorage: TWatchResultStorage; override;
function MaybeUpdateProto(var AProtoData: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData;
AStorage: PWatchResultStorage; ARecurse: boolean = False;
ASkipStorage: boolean = False): boolean;
override;
procedure AfterSaveToIndex(AStorage: TWatchResultStorage; AnIndex: Integer;
var AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData); override;
procedure AfterLoadFromIndex(AStorage: TWatchResultStorage;
AnIndex: Integer; const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData); override;
procedure ClearData; override;
function GetAnchestor: TWatchResultData; override;
public
procedure SetAnchestor(AnAnchestor: TWatchResultData); override;
end;
{ TWatchResultDataStruct }
TWatchResultDataStruct = class(specialize TGenericWatchResultDataStructWithAnchestor<TWatchResultValueStruct, TWatchResultTypeStruct>)
private
function GetClassID: TWatchResultDataClassID; override;
public
constructor Create(AStructType: TLzDbgStructType);
end;
{ TWatchResultDataRefStruct }
TWatchResultDataRefStruct = class(specialize TGenericWatchResultDataStruct<TWatchResultValueStructWithRef, TWatchResultTypeStruct>)
TWatchResultDataRefStruct = class(specialize TGenericWatchResultDataStructWithAnchestor<TWatchResultValueStructWithRef, TWatchResultTypeStruct>)
private
function GetClassID: TWatchResultDataClassID; override;
protected
@ -1357,9 +1438,16 @@ type
);
end;
{ TWatchResultDataConverted }
TWatchResultDataConverted = class(specialize TGenericWatchResultDataStruct<TWatchResultValueConverted, TWatchResultTypeConverted>)
private
function GetClassID: TWatchResultDataClassID; override;
protected
function GetBackendValueHandler: TLazDbgValueConverterIntf;
public
constructor Create(AHandler: TLazDbgValueConverterIntf);
end;
{ TGenericWatchResultDataProc }
@ -1455,6 +1543,7 @@ const
TWatchResultDataStatArray, // wdStatA,
TWatchResultDataStruct, // wdStruct
TWatchResultDataRefStruct, // wdStructRef
TWatchResultDataConverted, // wdConverted
TWatchResultDataFunc, // wdFunc
TWatchResultDataProc, // wdProc
TWatchResultDataFuncRef, // wdFuncRef
@ -2076,9 +2165,9 @@ begin
AConfig.SetDeleteValue(APath + 'Addr', Int64(FDataAddress), 0);
end;
{ TWatchResultTypeStruct }
{ TWatchResultTypeStructBase }
procedure TWatchResultTypeStruct.LoadDataFromXMLConfig(
procedure TWatchResultTypeStructBase.LoadDataFromXMLConfig(
const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
@ -2089,14 +2178,6 @@ var
i: Integer;
p: String;
begin
AConfig.GetValue(APath + 'SubID', int64(ord(dstUnknown)), FStructType, TypeInfo(TLzDbgStructType));
if AConfig.HasPath(APath+'Anch/', True) then begin
FAnchestor := TWatchResultData.CreateFromXMLConfig(AConfig, APath+'Anch/', AnEntryTemplate, AnOverrideTemplate, AnAsProto);
assert((FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct), 'TWatchResultTypeStruct.LoadDataFromXMLConfig: (FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct)');
if (FAnchestor <> nil) and (FAnchestor.ValueKind <> rdkStruct) then
FreeAndNil(FAnchestor);
end;
DataCnt := AConfig.GetValue(APath + 'Cnt', 0);
SetLength(FFieldData, DataCnt);
for i := 0 to DataCnt-1 do begin
@ -2109,16 +2190,12 @@ begin
end;
end;
procedure TWatchResultTypeStruct.SaveDataToXMLConfig(const AConfig: TXMLConfig;
const APath: string; AnAsProto: Boolean);
procedure TWatchResultTypeStructBase.SaveDataToXMLConfig(
const AConfig: TXMLConfig; const APath: string; AnAsProto: Boolean);
var
i: Integer;
p: String;
begin
AConfig.SetDeleteValue(APath + 'SubID', FStructType, ord(dstUnknown), TypeInfo(TLzDbgStructType));
if FAnchestor <> nil then
FAnchestor.SaveDataToXMLConfig(AConfig, APath+'Anch/', AnAsProto);
AConfig.SetDeleteValue(APath + 'Cnt', Length(FFieldData), 0);
for i := 0 to Length(FFieldData)-1 do begin
p := APath+'F'+IntToStr(i)+'/';
@ -2134,29 +2211,28 @@ begin
end;
end;
function TWatchResultTypeStruct.GetFieldCount: Integer;
function TWatchResultTypeStructBase.GetFieldCount: Integer;
begin
Result := Length(FFieldData);
end;
function TWatchResultTypeStruct.GetFieldInfo(AnIndex: Integer
function TWatchResultTypeStructBase.GetFieldInfo(AnIndex: Integer
): PWatchResultTypeStructFieldInfo;
begin
Result := @FFieldData[AnIndex];
end;
procedure TWatchResultTypeStruct.AfterAssign(ATypeOnly: Boolean);
procedure TWatchResultTypeStructBase.AfterAssign(ATypeOnly: Boolean);
var
i: Integer;
begin
FAnchestor := FAnchestor.CreateCopy(ATypeOnly);
SetLength(FFieldData, Length(FFieldData));
for i := 0 to Length(FFieldData) - 1 do
FFieldData[i].Field := FFieldData[i].Field.CreateCopy(ATypeOnly);
end;
procedure TWatchResultTypeStruct.CopyFieldsProtoFrom(
const ASource: TWatchResultTypeStruct);
procedure TWatchResultTypeStructBase.CopyFieldsProtoFrom(
const ASource: TWatchResultTypeStructBase);
var
i: Integer;
begin
@ -2166,16 +2242,69 @@ begin
FFieldData[i].Field := ASource.FFieldData[i].Field.CreateCopy(True);
end;
procedure TWatchResultTypeStruct.DoFree;
procedure TWatchResultTypeStructBase.DoFree;
var
i: Integer;
begin
for i := 0 to Length(FFieldData) - 1 do
FFieldData[i].Field.Free;
FFieldData := nil;
end;
{ TWatchResultTypeStruct }
procedure TWatchResultTypeStruct.LoadDataFromXMLConfig(
const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData; AnAsProto: Boolean);
begin
AConfig.GetValue(APath + 'SubID', int64(ord(dstUnknown)), FStructType, TypeInfo(TLzDbgStructType));
if AConfig.HasPath(APath+'Anch/', True) then begin
FAnchestor := TWatchResultData.CreateFromXMLConfig(AConfig, APath+'Anch/', AnEntryTemplate, AnOverrideTemplate, AnAsProto);
assert((FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct), 'TWatchResultTypeStruct.LoadDataFromXMLConfig: (FAnchestor=nil) or (FAnchestor.ValueKind=rdkStruct)');
if (FAnchestor <> nil) and (FAnchestor.ValueKind <> rdkStruct) then
FreeAndNil(FAnchestor);
end;
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate, AnOverrideTemplate, AnAsProto);
end;
procedure TWatchResultTypeStruct.SaveDataToXMLConfig(const AConfig: TXMLConfig;
const APath: string; AnAsProto: Boolean);
begin
AConfig.SetDeleteValue(APath + 'SubID', FStructType, ord(dstUnknown), TypeInfo(TLzDbgStructType));
if FAnchestor <> nil then
FAnchestor.SaveDataToXMLConfig(AConfig, APath+'Anch/', AnAsProto);
inherited SaveDataToXMLConfig(AConfig, APath, AnAsProto);
end;
procedure TWatchResultTypeStruct.AfterAssign(ATypeOnly: Boolean);
begin
FAnchestor := FAnchestor.CreateCopy(ATypeOnly);
inherited AfterAssign(ATypeOnly);
end;
procedure TWatchResultTypeStruct.DoFree;
begin
inherited DoFree;
FAnchestor.Free;
end;
{ TWatchResultTypeConverted }
procedure TWatchResultTypeConverted.AfterAssign(ATypeOnly: Boolean);
begin
if FHandler <> nil then
FHandler.AddReference;
end;
procedure TWatchResultTypeConverted.DoFree;
begin
if FHandler <> nil then
FHandler.ReleaseReference;
end;
{ TWatchResultTypeProc }
procedure TWatchResultTypeProc.LoadDataFromXMLConfig(const AConfig: TXMLConfig;
@ -2453,6 +2582,11 @@ begin
Result := wdPrePrint;
end;
function TWatchResultData.GetBackendValueHandler: TLazDbgValueConverterIntf;
begin
Result := nil;
end;
procedure TWatchResultData.AfterSaveToIndex(AStorage: TWatchResultStorage;
AnIndex: Integer; var AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData);
@ -4013,8 +4147,6 @@ var
i: Integer;
begin
inherited SetCount(AValue);
if FAnchestorStorage <> nil then
FAnchestorStorage.SetCount(AValue);
for i := 0 to Length(FFieldsStorage) - 1 do
if FFieldsStorage[i] <> nil then
FFieldsStorage[i].SetCount(AValue);
@ -4029,8 +4161,6 @@ begin
inherited Assign(ASource);
if ASource is TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage then begin
FAnchestorStorage := Src.FAnchestorStorage.CreateCopy;
SetLength(FFieldsStorage, Length(Src.FFieldsStorage));
for i := 0 to Length(FFieldsStorage) - 1 do
FFieldsStorage[i] := Src.FFieldsStorage[i].CreateCopy;
@ -4044,33 +4174,20 @@ end;
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetNestedStorage
(AnIndex: Integer): TWatchResultStorage;
begin
if AnIndex < 0 then
Result := FAnchestorStorage
else
Result := FFieldsStorage[AnIndex];
Result := FFieldsStorage[AnIndex];
end;
function TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.GetNestedStoragePtr
(AnIndex: Integer): PWatchResultStorage;
begin
if AnIndex < 0 then
Result := @FAnchestorStorage
else
Result := @FFieldsStorage[AnIndex];
Result := @FFieldsStorage[AnIndex];
end;
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage
(AnIndex: Integer; AValue: TWatchResultStorage);
begin
if AnIndex < 0 then begin
assert((FAnchestorStorage=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FAnchestorStorage=nil) or (AValue=nil)');
FAnchestorStorage := AValue;
end
else begin
assert((FFieldsStorage[AnIndex]=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FFieldsStorage[AnIndex]=nil) or (AValue=nil)');
FFieldsStorage[AnIndex] := AValue;
end;
assert((FFieldsStorage[AnIndex]=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FFieldsStorage[AnIndex]=nil) or (AValue=nil)');
FFieldsStorage[AnIndex] := AValue;
if AValue <> nil then
AValue.Count := Count;
@ -4078,7 +4195,6 @@ end;
destructor TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.Destroy;
begin
FreeAndNil(FAnchestorStorage);
StoredFieldCount := 0;
inherited Destroy;
end;
@ -4103,14 +4219,6 @@ begin
FFieldsStorage[i].LoadDataFromXMLConfig(AConfig, APath+'F'+IntToStr(i)+'/', t, FOverrideTempl[i], ANestLvl);
end;
end;
if FAnchestorStorage <> nil then begin
t := AnEntryTemplate;
if t <> nil then
t := TGenericWatchResultDataStruct(t).FType.FAnchestor;
FAnchestorStorage.LoadDataFromXMLConfig(AConfig, APath+'Anch/', t, AnOverrideTemplate, ANestLvl);
end;
end;
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SaveDataToXMLConfig
@ -4123,10 +4231,6 @@ begin
for i := 0 to Length(FFieldsStorage) - 1 do
if FFieldsStorage[i] <> nil then
FFieldsStorage[i].SaveDataToXMLConfig(AConfig, APath+'F'+IntToStr(i)+'/', ANestLvl);
if FAnchestorStorage <> nil then
FAnchestorStorage.SaveDataToXMLConfig(AConfig, APath+'Anch/', ANestLvl);
end;
{ TGenericWatchResultDataStruct }
@ -4143,9 +4247,6 @@ var
begin
Result := inherited CreateStorage;
if FType.FAnchestor <> nil then
Store.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
Store.StoredFieldCount := Length(FType.FFieldData);
for i := 0 to Length(FType.FFieldData) - 1 do
if FType.FFieldData[i].Field <> nil then
@ -4172,11 +4273,6 @@ begin
AStructProtoData.FType.CopyFieldsProtoFrom(FType);
assert((Length(FType.FFieldData)=0) or (Length(FType.FFieldData)=Length(AStructProtoData.FType.FFieldData)), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (Length(FType.FFieldData)=0) or (Length(FType.FFieldData)=Length(AStructProtoData.FType.FFieldData))');
if (AStructProtoData.FType.FAnchestor = nil) and
(FType.FAnchestor <> nil)
then
AStructProtoData.FType.FAnchestor := FType.FAnchestor.CreateCopy(True);
assert((AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage)');
if (AStorage = nil) or (AStorage^ = nil)
@ -4190,12 +4286,6 @@ begin
assert(dummy = nil, 'TGenericWatchResultDataStruct.MaybeUpdateProto: dummy = nil');
end;
end;
if FType.FAnchestor <> nil then begin
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, dummy,
nil, ARecurse, ASkipStorage);
assert(dummy = nil, 'TGenericWatchResultDataStruct.MaybeUpdateProto: dummy = nil');
end;
end;
end
@ -4210,11 +4300,6 @@ begin
FieldStore^.FOverrideTempl[i], FieldStore^.NestedStoragePtr[i], ARecurse, ASkipStorage);
end;
end;
if FType.FAnchestor <> nil then begin
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, AnOverrideTemplate,
FieldStore^.NestedStoragePtr[-1], ARecurse, ASkipStorage);
end;
end;
end;
@ -4229,24 +4314,6 @@ var
begin
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate, AnOverrideTemplate);
if (FType.FAnchestor <> nil) then begin
assert(AnEntryTemplate is TGenericWatchResultDataStruct, 'TGenericWatchResultDataStruct.AfterSaveToIndex: AnEntryTemplate is TGenericWatchResultDataStruct');
FType.FAnchestor.MaybeUpdateProto(
AStructEntryTemplate.FType.FAnchestor,
AnOverrideTemplate,
AStore.NestedStoragePtr[-1]
);
if (AStore.NestedStorage[-1] = nil) then
AStore.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
AStore.NestedStorage[-1].SaveToIndex(AnIndex,
FType.FAnchestor,
AStructEntryTemplate.FType.FAnchestor,
AnOverrideTemplate);
end;
if Length(FType.FFieldData) > AStore.StoredFieldCount then begin
assert(AStore.StoredFieldCount=0, 'TGenericWatchResultDataStruct.AfterSaveToIndex: AStore.StoredFieldCount=0');
AStore.StoredFieldCount := Length(FType.FFieldData);
@ -4286,11 +4353,6 @@ begin
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate,
AnOverrideTemplate);
if (FType.FAnchestor <> nil) then begin
if (AStore.NestedStorage[-1] <> nil) then
AStore.NestedStorage[-1].LoadFromIndex(AnIndex, FCurrentAnchestor, FType.FAnchestor, AnOverrideTemplate);
end;
if AStore.StoredFieldCount = 0 then begin
SetLength(FCurrentFields, 0);
end
@ -4317,9 +4379,6 @@ var
begin
inherited ClearData;
if FType.FAnchestor <> nil then
FType.FAnchestor.ClearData;
for i := 0 to Length(FType.FFieldData) - 1 do
if (FType.FFieldData[i].Field <> nil) then
FType.FFieldData[i].Field.ClearData;
@ -4333,29 +4392,11 @@ begin
Result.Field := FCurrentFields[AnIndex];
end;
function TGenericWatchResultDataStruct.GetAnchestor: TWatchResultData;
begin
if FCurrentAnchestor <> nil then
Result := FCurrentAnchestor
else
Result := inherited GetAnchestor;
end;
constructor TGenericWatchResultDataStruct.Create(AStructType: TLzDbgStructType);
begin
FType.FStructType := AStructType;
end;
function TGenericWatchResultDataStruct.GetEnumerator: TWatchResultDataEnumerator;
begin
Result := TWatchResultDataStructEnumerator.Create(Self);
end;
procedure TGenericWatchResultDataStruct.SetAnchestor(AnAnchestor: TWatchResultData);
begin
FType.FAnchestor := AnAnchestor;
end;
procedure TGenericWatchResultDataStruct.SetFieldCount(ACount: integer);
begin
SetLength(FType.FFieldData, ACount);
@ -4392,6 +4433,219 @@ begin
FType.FFieldData[AnIndex].Field := AData;
end;
{ TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage }
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SetCount
(AValue: integer);
begin
inherited SetCount(AValue);
if FAnchestorStorage <> nil then
FAnchestorStorage.SetCount(AValue);
end;
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.Assign
(ASource: TWatchResultStorage);
var
Src: TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage absolute ASource;
begin
inherited Assign(ASource);
if ASource is TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage then begin
FAnchestorStorage := Src.FAnchestorStorage.CreateCopy;
end;
end;
function TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.GetNestedStorage
(AnIndex: Integer): TWatchResultStorage;
begin
if AnIndex < 0 then
Result := FAnchestorStorage
else
Result := inherited GetNestedStorage(AnIndex);
end;
function TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.GetNestedStoragePtr
(AnIndex: Integer): PWatchResultStorage;
begin
if AnIndex < 0 then
Result := @FAnchestorStorage
else
Result := inherited GetNestedStoragePtr(AnIndex);
end;
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SetNestedStorage
(AnIndex: Integer; AValue: TWatchResultStorage);
begin
if AnIndex < 0 then begin
assert((FAnchestorStorage=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FAnchestorStorage=nil) or (AValue=nil)');
FAnchestorStorage := AValue;
if AValue <> nil then
AValue.Count := Count;
end
else
inherited SetNestedStorage(AnIndex, AValue);
end;
destructor TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.Destroy;
begin
FreeAndNil(FAnchestorStorage);
inherited Destroy;
end;
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.LoadDataFromXMLConfig
(const AConfig: TXMLConfig; const APath: string;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData; ANestLvl: Integer);
var
t: TWatchResultData;
begin
inherited LoadDataFromXMLConfig(AConfig, APath, AnEntryTemplate,
AnOverrideTemplate, ANestLvl);
if FAnchestorStorage <> nil then begin
t := AnEntryTemplate;
if t <> nil then
t := TGenericWatchResultDataStructWithAnchestor(t).FType.FAnchestor;
FAnchestorStorage.LoadDataFromXMLConfig(AConfig, APath+'Anch/', t, AnOverrideTemplate, ANestLvl);
end;
end;
procedure TGenericWatchResultDataStructWithAnchestor.TNestedFieldsAndAnchestorWatchResultStorage.SaveDataToXMLConfig
(const AConfig: TXMLConfig; const APath: string; ANestLvl: Integer);
begin
inherited SaveDataToXMLConfig(AConfig, APath, ANestLvl);
if FAnchestorStorage <> nil then
FAnchestorStorage.SaveDataToXMLConfig(AConfig, APath+'Anch/', ANestLvl);
end;
{ TGenericWatchResultDataStructWithAnchestor }
class function TGenericWatchResultDataStructWithAnchestor.GetStorageClass: TWatchResultStorageClass;
begin
Result := TNestedFieldsAndAnchestorWatchResultStorage;
end;
function TGenericWatchResultDataStructWithAnchestor.CreateStorage: TWatchResultStorage;
var
Store: TNestedFieldsAndAnchestorWatchResultStorage absolute Result;
begin
Result := inherited CreateStorage;
if FType.FAnchestor <> nil then
Store.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
end;
function TGenericWatchResultDataStructWithAnchestor.MaybeUpdateProto(
var AProtoData: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData; AStorage: PWatchResultStorage;
ARecurse: boolean; ASkipStorage: boolean): boolean;
var
AStructProtoData: TGenericWatchResultDataStructWithAnchestor absolute AProtoData;
FieldStore: PNestedFieldsWatchResultStorage absolute AStorage;
dummy: TOverrideTemplateData;
begin
Result := inherited MaybeUpdateProto(AProtoData, AnOverrideTemplate, AStorage, ARecurse, ASkipStorage);
if Result or not ARecurse then
exit;
if (AStructProtoData.FType.FAnchestor = nil) and
(FType.FAnchestor <> nil)
then
AStructProtoData.FType.FAnchestor := FType.FAnchestor.CreateCopy(True);
assert((AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (AStorage=nil) or (AStorage^=nil) or (AStorage^ is TNestedFieldsWatchResultStorage)');
if (AStorage = nil) or (AStorage^ = nil)
then begin
if (ARecurse) then begin // or "if not ASkipStorage and " ??
dummy := nil;
if FType.FAnchestor <> nil then begin
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, dummy,
nil, ARecurse, ASkipStorage);
assert(dummy = nil, 'TGenericWatchResultDataStructWithAnchestor.MaybeUpdateProto: dummy = nil');
end;
end;
end
else begin
if FType.FAnchestor <> nil then begin
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, AnOverrideTemplate,
FieldStore^.NestedStoragePtr[-1], ARecurse, ASkipStorage);
end;
end;
end;
procedure TGenericWatchResultDataStructWithAnchestor.AfterSaveToIndex(
AStorage: TWatchResultStorage; AnIndex: Integer;
var AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData);
var
AStructEntryTemplate: TGenericWatchResultDataStructWithAnchestor absolute AnEntryTemplate;
AStore: TNestedFieldsAndAnchestorWatchResultStorage absolute AStorage;
begin
inherited AfterSaveToIndex(AStorage, AnIndex, AnEntryTemplate,
AnOverrideTemplate);
if (FType.FAnchestor <> nil) then begin
assert(AnEntryTemplate is TGenericWatchResultDataStructWithAnchestor, 'TGenericWatchResultDataStructWithAnchestor.AfterSaveToIndex: AnEntryTemplate is TGenericWatchResultDataStruct');
FType.FAnchestor.MaybeUpdateProto(
AStructEntryTemplate.FType.FAnchestor,
AnOverrideTemplate,
AStore.NestedStoragePtr[-1]
);
if (AStore.NestedStorage[-1] = nil) then
AStore.NestedStorage[-1] := FType.FAnchestor.CreateStorage;
AStore.NestedStorage[-1].SaveToIndex(AnIndex,
FType.FAnchestor,
AStructEntryTemplate.FType.FAnchestor,
AnOverrideTemplate);
end;
end;
procedure TGenericWatchResultDataStructWithAnchestor.AfterLoadFromIndex(
AStorage: TWatchResultStorage; AnIndex: Integer;
const AnEntryTemplate: TWatchResultData;
var AnOverrideTemplate: TOverrideTemplateData);
var
AStore: TNestedFieldsAndAnchestorWatchResultStorage absolute AStorage;
begin
inherited AfterLoadFromIndex(AStorage, AnIndex, AnEntryTemplate,
AnOverrideTemplate);
if (FType.FAnchestor <> nil) then begin
if (AStore.NestedStorage[-1] <> nil) then
AStore.NestedStorage[-1].LoadFromIndex(AnIndex, FCurrentAnchestor, FType.FAnchestor, AnOverrideTemplate);
end;
end;
procedure TGenericWatchResultDataStructWithAnchestor.ClearData;
begin
inherited ClearData;
if FType.FAnchestor <> nil then
FType.FAnchestor.ClearData;
end;
function TGenericWatchResultDataStructWithAnchestor.GetAnchestor: TWatchResultData;
begin
if FCurrentAnchestor <> nil then
Result := FCurrentAnchestor
else
Result := inherited GetAnchestor;
end;
procedure TGenericWatchResultDataStructWithAnchestor.SetAnchestor(
AnAnchestor: TWatchResultData);
begin
FType.FAnchestor := AnAnchestor;
end;
{ TWatchResultDataStruct }
function TWatchResultDataStruct.GetClassID: TWatchResultDataClassID;
@ -4399,10 +4653,9 @@ begin
Result := wdStruct;
end;
class function TWatchResultDataStruct.GetStorageClass: TWatchResultStorageClass;
constructor TWatchResultDataStruct.Create(AStructType: TLzDbgStructType);
begin
Result := inherited GetStorageClass;
//Result := TGenericNestedWatchResultStorage;
FType.FStructType := AStructType;
end;
{ TWatchResultDataRefStruct }
@ -4421,7 +4674,26 @@ constructor TWatchResultDataRefStruct.Create(AStructType: TLzDbgStructType;
ADataAddress: TDBGPtr);
begin
FData.FDataAddress := ADataAddress;
inherited Create(AStructType);
FType.FStructType := AStructType;
end;
{ TWatchResultDataConverted }
function TWatchResultDataConverted.GetClassID: TWatchResultDataClassID;
begin
Result := wdConverted;
end;
function TWatchResultDataConverted.GetBackendValueHandler: TLazDbgValueConverterIntf;
begin
Result := FType.FHandler;
end;
constructor TWatchResultDataConverted.Create(
AHandler: TLazDbgValueConverterIntf);
begin
FType.FHandler := AHandler;
AHandler.AddReference;
end;
{ TGenericWatchResultDataProc }