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

IdeDebugger: tests and some fixes

Browse Source
This commit is contained in:
Martin 2022-06-26 18:41:38 +02:00
parent 1df670703a
commit f1adf1893b
3 changed files with 259 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -453,6 +453,7 @@ type
function GetFieldCount: Integer; inline; function GetFieldCount: Integer; inline;
function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline; function GetFieldInfo(AnIndex: Integer): PWatchResultTypeStructFieldInfo; inline;
procedure AfterAssign(ATypeOnly: Boolean = False); procedure AfterAssign(ATypeOnly: Boolean = False);
procedure CopyFieldsProtoFrom(const ASource: TWatchResultTypeStruct); inline;
procedure DoFree; procedure DoFree;
end; end;
@ -1945,7 +1946,8 @@ begin
FFieldData[i].FieldName := AConfig.GetValue(p + 'F-Name', ''); FFieldData[i].FieldName := AConfig.GetValue(p + 'F-Name', '');
AConfig.GetValue(p + 'F-Vis', int64(ord(dfvUnknown)), FFieldData[i].FieldVisibility, TypeInfo(TLzDbgFieldVisibility)); AConfig.GetValue(p + 'F-Vis', int64(ord(dfvUnknown)), FFieldData[i].FieldVisibility, TypeInfo(TLzDbgFieldVisibility));
AConfig.GetValue(p + 'F-Flg', Zero, FFieldData[i].FieldFlags, TypeInfo(TLzDbgFieldFlags)); AConfig.GetValue(p + 'F-Flg', Zero, FFieldData[i].FieldFlags, TypeInfo(TLzDbgFieldFlags));
FFieldData[i].Field := TWatchResultData.CreateFromXMLConfig(AConfig, p); if AConfig.GetValue(p+'Empty', 0) = 0 then
FFieldData[i].Field := TWatchResultData.CreateFromXMLConfig(AConfig, p);
end; end;
end; end;
@ -1965,7 +1967,12 @@ begin
AConfig.SetDeleteValue(p + 'F-Name', FFieldData[i].FieldName, ''); AConfig.SetDeleteValue(p + 'F-Name', FFieldData[i].FieldName, '');
AConfig.SetDeleteValue(p + 'F-Vis', FFieldData[i].FieldVisibility, ord(dfvUnknown), TypeInfo(TLzDbgFieldVisibility)); AConfig.SetDeleteValue(p + 'F-Vis', FFieldData[i].FieldVisibility, ord(dfvUnknown), TypeInfo(TLzDbgFieldVisibility));
AConfig.SetDeleteValue(p + 'F-Flg', FFieldData[i].FieldFlags, 0, TypeInfo(TLzDbgFieldFlags)); AConfig.SetDeleteValue(p + 'F-Flg', FFieldData[i].FieldFlags, 0, TypeInfo(TLzDbgFieldFlags));
FFieldData[i].Field.SaveDataToXMLConfig(AConfig, p, AnAsProto); if FFieldData[i].Field <> nil then begin
FFieldData[i].Field.SaveDataToXMLConfig(AConfig, p, AnAsProto);
AConfig.DeleteValue(p+'Empty');
end
else
AConfig.SetValue(p+'Empty',1);
end; end;
end; end;
@ -1990,6 +1997,17 @@ begin
FFieldData[i].Field := FFieldData[i].Field.CreateCopy(ATypeOnly); FFieldData[i].Field := FFieldData[i].Field.CreateCopy(ATypeOnly);
end; end;
procedure TWatchResultTypeStruct.CopyFieldsProtoFrom(
const ASource: TWatchResultTypeStruct);
var
i: Integer;
begin
FFieldData := ASource.FFieldData;
SetLength(FFieldData, Length(FFieldData));
for i := 0 to Length(FFieldData) - 1 do
FFieldData[i].Field := ASource.FFieldData[i].Field.CreateCopy(True);
end;
procedure TWatchResultTypeStruct.DoFree; procedure TWatchResultTypeStruct.DoFree;
var var
i: Integer; i: Integer;
@ -3660,6 +3678,9 @@ procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetStore
var var
i: Integer; i: Integer;
begin begin
if AValue = Length(FFieldsStorage) then
exit;
for i := AValue to Length(FFieldsStorage) - 1 do for i := AValue to Length(FFieldsStorage) - 1 do
FreeAndNil(FFieldsStorage[i]); FreeAndNil(FFieldsStorage[i]);
SetLength(FFieldsStorage, AValue); SetLength(FFieldsStorage, AValue);
@ -3725,10 +3746,14 @@ end;
procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage procedure TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage
(AnIndex: Integer; AValue: TWatchResultStorage); (AnIndex: Integer; AValue: TWatchResultStorage);
begin begin
if AnIndex < 0 then if AnIndex < 0 then begin
FAnchestorStorage := AValue assert((FAnchestorStorage=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FAnchestorStorage=nil) or (AValue=nil)');
else FAnchestorStorage := AValue;
end
else begin
assert((FFieldsStorage[AnIndex]=nil) or (AValue=nil), 'TGenericWatchResultDataStruct.TNestedFieldsWatchResultStorage.SetNestedStorage: (FFieldsStorage[AnIndex]=nil) or (AValue=nil)');
FFieldsStorage[AnIndex] := AValue; FFieldsStorage[AnIndex] := AValue;
end;
if AValue <> nil then if AValue <> nil then
AValue.Count := Count; AValue.Count := Count;
@ -3824,6 +3849,18 @@ begin
if Result or not ARecurse then if Result or not ARecurse then
exit; exit;
if (Length(AStructProtoData.FType.FFieldData) = 0) and
(Length(FType.FFieldData) > 0)
then
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)'); 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) if (AStorage = nil) or (AStorage^ = nil)
then begin then begin
@ -3843,20 +3880,24 @@ begin
assert(dummy = nil, 'TGenericWatchResultDataStruct.MaybeUpdateProto: dummy = nil'); assert(dummy = nil, 'TGenericWatchResultDataStruct.MaybeUpdateProto: dummy = nil');
end; end;
end; end;
end
exit; else begin
end; if (FieldStore^.StoredFieldCount = 0) then
FieldStore^.StoredFieldCount := Length(FType.FFieldData);
assert((length(FType.FFieldData)=0) or (FieldStore^.StoredFieldCount = Length(FType.FFieldData)), 'TGenericWatchResultDataStruct.MaybeUpdateProto: (length(FType.FFieldData)=0) or (FieldStore^.StoredFieldCount = Length(FType.FFieldData))');
for i := 0 to Length(FType.FFieldData) - 1 do begin for i := 0 to Length(FType.FFieldData) - 1 do begin
if FType.FFieldData[i].Field <> nil then begin if FType.FFieldData[i].Field <> nil then begin
FType.FFieldData[i].Field.MaybeUpdateProto(AStructProtoData.FType.FFieldData[i].Field, FType.FFieldData[i].Field.MaybeUpdateProto(AStructProtoData.FType.FFieldData[i].Field,
FieldStore^.FOverrideTempl[i], FieldStore^.NestedStoragePtr[i], ARecurse, ASkipStorage); FieldStore^.FOverrideTempl[i], FieldStore^.NestedStoragePtr[i], ARecurse, ASkipStorage);
end;
end; end;
end;
if FType.FAnchestor <> nil then begin if FType.FAnchestor <> nil then begin
FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, AnOverrideTemplate, FType.FAnchestor.MaybeUpdateProto(AStructProtoData.FType.FAnchestor, AnOverrideTemplate,
FieldStore^.NestedStoragePtr[-1], ARecurse, ASkipStorage); FieldStore^.NestedStoragePtr[-1], ARecurse, ASkipStorage);
end;
end; end;
end; end;
@ -3933,11 +3974,23 @@ begin
AStore.NestedStorage[-1].LoadFromIndex(AnIndex, FCurrentAnchestor, FType.FAnchestor, AnOverrideTemplate); AStore.NestedStorage[-1].LoadFromIndex(AnIndex, FCurrentAnchestor, FType.FAnchestor, AnOverrideTemplate);
end; end;
SetLength(FCurrentFields, Length(FType.FFieldData)); if AStore.StoredFieldCount = 0 then begin
for i := 0 to Length(FType.FFieldData) - 1 do begin SetLength(FCurrentFields, 0);
if (AStore.NestedStorage[i] <> nil) then begin end
AStore.NestedStorage[i].LoadFromIndex(AnIndex, FCurrentFields[i], FType.FFieldData[i].Field, AStore.FOverrideTempl[i]); else begin
assert(AStore.StoredFieldCount = Length(FType.FFieldData), 'TGenericWatchResultDataStruct.AfterLoadFromIndex: AStore.StoredFieldCount = Length(FType.FFieldData)');
SetLength(FCurrentFields, Length(FType.FFieldData));
if AStore.NestedStorage[0].Count = 0 then begin
for i := 0 to Length(FCurrentFields) - 1 do
FCurrentFields[i] := nil;
end end
else begin
for i := 0 to Length(FType.FFieldData) - 1 do begin
if (AStore.NestedStorage[i] <> nil) then begin
AStore.NestedStorage[i].LoadFromIndex(AnIndex, FCurrentFields[i], FType.FFieldData[i].Field, AStore.FOverrideTempl[i]);
end
end;
end;
end; end;
end; end;

55
ide/packages/idedebugger/test/TestIdeDebugger.lpi
View File

@ -11,7 +11,39 @@
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<BuildModes> <BuildModes>
<Item Name="Default" Default="True"/> <Item Name="O1 Criot Sa gh gt" Default="True"/>
<Item Name="O1 Criot Sa gh gtttt&lt;nil>">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="TestIdeDebugger"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
</Item>
<Item Name="full test -O3"> <Item Name="full test -O3">
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
@ -71,14 +103,19 @@
</Linking> </Linking>
</CompilerOptions> </CompilerOptions>
</Item> </Item>
<SharedMatrixOptions Count="7"> <SharedMatrixOptions Count="12">
<Item1 ID="512719448339" Targets="IdeDebugger" Modes="Default,full test -O3" Value="-Sa"/> <Item1 ID="354904912079" Targets="LazUtils" Modes="full test -O3,no assert/check -O3 -gh" Value="-O-4 -Sa- -Si -Cr- -Ci- -Co- -Ct- -gt-"/>
<Item2 ID="026959990514" Targets="IdeDebugger" Modes="Default,full test -O3" Value="-Criot"/> <Item2 ID="337989334087" Targets="IdeDebugger" Modes="full test -O3,O1 Criot Sa gh gt,O1 Criot Sa gh gtttt&lt;nil>" Value="-O-1"/>
<Item3 ID="149801562947" Targets="IdeDebugger" Modes="Default,full test -O3" Value="-gt"/> <Item3 ID="351599647225" Targets="IdeDebugger" Modes="no assert/check -O3 -gh,full test -O3" Value="-O-3"/>
<Item4 ID="337989334087" Targets="IdeDebugger" Modes="Default,full test -O3" Value="-O-1"/> <Item4 ID="703841857666" Targets="IdeDebugger" Modes="no assert/check -O3 -gh" Value="-gt-"/>
<Item5 ID="351599647225" Targets="IdeDebugger" Modes="no assert/check -O3 -gh,full test -O3" Value="-O3"/> <Item5 ID="149801562947" Targets="IdeDebugger" Modes="full test -O3,O1 Criot Sa gh gt" Value="-gt- -gt"/>
<Item6 ID="654923802929" Targets="IdeDebugger" Modes="no assert/check -O3 -gh" Value="-Sa- -Cr- -Ci- -Co- -Ct-"/> <Item6 ID="565851929886" Targets="IdeDebugger" Modes="O1 Criot Sa gh gtttt&lt;nil>" Value="-gt- -gtttt"/>
<Item7 ID="342603141025" Targets="IdeDebugger" Modes="no assert/check -O3 -gh" Value="-Si"/> <Item7 ID="538318268753" Targets="IdeDebugger" Modes="O1 Criot Sa gh gt,O1 Criot Sa gh gtttt&lt;nil>,full test -O3" Value="-gh"/>
<Item8 ID="512719448339" Targets="IdeDebugger" Modes="full test -O3,O1 Criot Sa gh gt,O1 Criot Sa gh gtttt&lt;nil>" Value="-Sa"/>
<Item9 ID="026959990514" Targets="IdeDebugger" Modes="full test -O3,O1 Criot Sa gh gt,O1 Criot Sa gh gtttt&lt;nil>" Value="-Criot"/>
<Item10 ID="654923802929" Targets="IdeDebugger" Modes="no assert/check -O3 -gh" Value="-Sa- -Cr- -Ci- -Co- -Ct- -gh-"/>
<Item11 ID="874538370462" Targets="IdeDebugger" Modes="O1 Criot Sa gh gt,O1 Criot Sa gh gtttt&lt;nil>" Value="-Si-"/>
<Item12 ID="342603141025" Targets="IdeDebugger" Modes="no assert/check -O3 -gh,full test -O3" Value="-Si"/>
</SharedMatrixOptions> </SharedMatrixOptions>
</BuildModes> </BuildModes>
<PublishOptions> <PublishOptions>

179
ide/packages/idedebugger/test/testwatchresult.pas
View File

@ -43,10 +43,12 @@ type
cdErrPre, cdErrPre,
cdPtr_ErrNum, cdErrPtr_Num, cdPtr_ErrNum, cdErrPtr_Num,
cdPtr_Ptr_ErrNum, cdPtr_ErrPtr_Num, cdErrPtr_Ptr_Num, cdPtr_Ptr_ErrNum, cdPtr_ErrPtr_Num, cdErrPtr_Ptr_Num,
cdErrArr_Num, cdArr_EmptyNum, cdErrArr_Num, cdArr_EmptyNum, cdArr_ErrNum,
cdPtr_ErrArr_Num, cdPtr_ErrArr_Num,
// cdErrStruct, cdErrStruct, cdStruct_ErrField,
cdStruct_ErrField cdStruct_Nil, // Instead of error, create struct, but no fields / no field-data
cdStruct_ErrEmptyFields
//cdStruct_EmptyFields // Add fields, but instead of error, do not create data for the fields
); );
const const
SecondType: array [TTestCreateDataKind] of array [0..1] of TTestCreateDataKind = ( SecondType: array [TTestCreateDataKind] of array [0..1] of TTestCreateDataKind = (
@ -57,10 +59,15 @@ type
(cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdPtr_Ptr_ErrNum, (cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdPtr_Ptr_ErrNum,
(cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdPtr_ErrPtr_Num, (cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdPtr_ErrPtr_Num,
(cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdErrPtr_Ptr_Num (cdPtr_Ptr_ErrNum, cdErrPtr_Ptr_Num), // cdErrPtr_Ptr_Num
(cdErrArr_Num, cdArr_EmptyNum), // cdErrArr_Num (cdErrArr_Num, cdArr_ErrNum), // cdErrArr_Num
(cdErrArr_Num, cdArr_EmptyNum), // cdArr_EmptyNum (cdErrArr_Num, cdArr_ErrNum), // cdArr_EmptyNum
(cdErrArr_Num, cdArr_ErrNum), // cdArr_ErrNum
(cdPtr_ErrArr_Num, cdPtr_ErrArr_Num), // cdPtr_ErrArr_Num (cdPtr_ErrArr_Num, cdPtr_ErrArr_Num), // cdPtr_ErrArr_Num
(cdStruct_ErrField,cdStruct_ErrField) (cdErrStruct, cdStruct_Nil), // cdErrStruct
(cdErrStruct, cdStruct_Nil), // cdStruct_ErrField
(cdErrStruct, cdStruct_Nil), // cdStruct_Nil
(cdStruct_ErrEmptyFields,cdStruct_ErrEmptyFields) //cdStruct_ErrEmptyFields
//(cdStruct_EmptyFields, cdStruct_EmptyFields) // cdStruct_EmptyFields
); );
protected protected
class procedure AssertEquals(const AMessage: string; Expected, Actual: TWatchResultDataKind); overload; class procedure AssertEquals(const AMessage: string; Expected, Actual: TWatchResultDataKind); overload;
@ -139,6 +146,10 @@ type
ExpTypeName: String = #1; ExpTypeName: String = #1;
ASaveLoad: Boolean = True; ACreateCopy: Boolean = True ASaveLoad: Boolean = True; ACreateCopy: Boolean = True
); );
procedure AssertArrayOfErrData(const AMessage: string; IdeRes: TWatchResultData;
ExpAnErr: String;
ASaveLoad: Boolean = True; ACreateCopy: Boolean = True
);
procedure AssertEmptyArrayOfNumData(const AMessage: string; IdeRes: TWatchResultData; procedure AssertEmptyArrayOfNumData(const AMessage: string; IdeRes: TWatchResultData;
ExpNum: Int64; ExpNum: Int64;
ExpTypeName: String = #1; ExpTypeName: String = #1;
@ -167,7 +178,8 @@ type
ExpAnchTypeName: String = #1; ExpAnchTypeName: String = #1;
ExpTypeName: String = #1; ExpTypeName: String = #1;
ExpKind: TWatchResultDataKind = rdkUnknown; ExpKind: TWatchResultDataKind = rdkUnknown;
ASaveLoad: Boolean = True; ACreateCopy: Boolean = True ASaveLoad: Boolean = True; ACreateCopy: Boolean = True;
aOnlyFieldData: Boolean = False
); );
procedure AssertStructData(const AMessage: string; IdeRes: TWatchResultData; procedure AssertStructData(const AMessage: string; IdeRes: TWatchResultData;
@ -192,7 +204,8 @@ type
aEntryType1, aEntryType2: TTestCreateDataKind; aEntryType1, aEntryType2: TTestCreateDataKind;
aErr1, aErr2: Boolean; aErr1, aErr2: Boolean;
aNil: Boolean = False; aNil: Boolean = False;
ExpTypeName: String = '' ExpTypeName: String = '';
aOnlyFieldData: Boolean = False
); );
function SaveLoad(ARes: TWatchResultData): TWatchResultData; function SaveLoad(ARes: TWatchResultData): TWatchResultData;
@ -205,6 +218,7 @@ type
function CreatePtrPtrNum(ResIntf: TLzDbgWatchDataIntf; AnAddr: QWord; ANum: Int64; AByteSize: integer = 2): TTwoResRecord; function CreatePtrPtrNum(ResIntf: TLzDbgWatchDataIntf; AnAddr: QWord; ANum: Int64; AByteSize: integer = 2): TTwoResRecord;
function CreatePtrPtrErr(ResIntf: TLzDbgWatchDataIntf; AnAddr: QWord; AnErr: String): TTwoResRecord; function CreatePtrPtrErr(ResIntf: TLzDbgWatchDataIntf; AnAddr: QWord; AnErr: String): TTwoResRecord;
function CreateArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord; function CreateArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord;
function CreateArrayOfErr(ResIntf: TLzDbgWatchDataIntf; AnErr: String): TTwoResRecord;
function CreateEmptyArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord; function CreateEmptyArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord;
function CreatePtrArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord; function CreatePtrArrayOfNum(ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer = 2): TTwoResRecord;
procedure CreateStruct(ResIntf: TLzDbgWatchDataIntf; procedure CreateStruct(ResIntf: TLzDbgWatchDataIntf;
@ -214,7 +228,8 @@ type
WithAnch1Fld, WithAnch2Fld: Boolean; WithAnch1Fld, WithAnch2Fld: Boolean;
aEntryType1, aEntryType2: TTestCreateDataKind; aEntryType1, aEntryType2: TTestCreateDataKind;
aErr1, aErr2: Boolean; aErr1, aErr2: Boolean;
aNil: Boolean = False aNil: Boolean = False;
aOnlyFieldData: Boolean = False
); );
function CreateData(ResIntf: TLzDbgWatchDataIntf; function CreateData(ResIntf: TLzDbgWatchDataIntf;
@ -581,6 +596,28 @@ begin
end; end;
end; end;
procedure TTestIdeDebuggerWatchResult.AssertArrayOfErrData(
const AMessage: string; IdeRes: TWatchResultData; ExpAnErr: String;
ASaveLoad: Boolean; ACreateCopy: Boolean);
var
t: TWatchResultData;
begin
AssertArrayData(AMessage, IdeRes, datDynArray, 1, 0);
IdeRes.SetSelectedIndex(0);
AssertErrData(AMessage, IdeRes.SelectedEntry, ExpAnErr);
if ASaveLoad and not SkipSubTestSave then begin
t := SaveLoad(IdeRes);
AssertArrayOfErrData(AMessage, IdeRes, ExpAnErr, False, False);
t.Free;
end;
if ACreateCopy and not SkipSubTestCopy then begin
t := IdeRes.CreateCopy;
AssertArrayOfErrData(AMessage, IdeRes, ExpAnErr, False, False);
t.Free;
end;
end;
procedure TTestIdeDebuggerWatchResult.AssertEmptyArrayOfNumData( procedure TTestIdeDebuggerWatchResult.AssertEmptyArrayOfNumData(
const AMessage: string; IdeRes: TWatchResultData; ExpNum: Int64; const AMessage: string; IdeRes: TWatchResultData; ExpNum: Int64;
ExpTypeName: String; ASaveLoad: Boolean; ACreateCopy: Boolean); ExpTypeName: String; ASaveLoad: Boolean; ACreateCopy: Boolean);
@ -668,7 +705,7 @@ procedure TTestIdeDebuggerWatchResult.AssertStructField(const AMessage: string;
IdeRes: TWatchResultData; TestFieldNum: Integer; ExpName: String; IdeRes: TWatchResultData; TestFieldNum: Integer; ExpName: String;
ExpVisibilty: TLzDbgFieldVisibility; ExpFlags: TLzDbgFieldFlags; ExpVisibilty: TLzDbgFieldVisibility; ExpFlags: TLzDbgFieldFlags;
ExpAnchTypeName: String; ExpTypeName: String; ExpKind: TWatchResultDataKind; ExpAnchTypeName: String; ExpTypeName: String; ExpKind: TWatchResultDataKind;
ASaveLoad: Boolean; ACreateCopy: Boolean); ASaveLoad: Boolean; ACreateCopy: Boolean; aOnlyFieldData: Boolean);
var var
t: TWatchResultData; t: TWatchResultData;
FldData: TWatchResultDataFieldInfo; FldData: TWatchResultDataFieldInfo;
@ -677,18 +714,23 @@ begin
AssertTrue(AMessage+': in range', IdeRes.FieldCount > TestFieldNum); AssertTrue(AMessage+': in range', IdeRes.FieldCount > TestFieldNum);
FldData := IdeRes.Fields[TestFieldNum]; FldData := IdeRes.Fields[TestFieldNum];
AssertTrue(AMessage+': Field not nil', FldData.Field <> nil); if not aOnlyFieldData then
AssertTrue(AMessage+': Field not nil', FldData.Field <> nil);
AssertTrue(AMessage+': Owner not nil', FldData.Owner <> nil); AssertTrue(AMessage+': Owner not nil', FldData.Owner <> nil);
AssertEquals(AMessage+': Field Name', ExpName, FldData.FieldName); AssertEquals(AMessage+': Field Name', ExpName, FldData.FieldName);
AssertEquals(AMessage+': Field Visibility', ord(ExpVisibilty), ord(FldData.FieldVisibility)); AssertEquals(AMessage+': Field Visibility', ord(ExpVisibilty), ord(FldData.FieldVisibility));
AssertTrue (AMessage+': Field Flags', ExpFlags = FldData.FieldFlags); AssertTrue (AMessage+': Field Flags', ExpFlags = FldData.FieldFlags);
if ExpKind <> rdkUnknown then if (ExpKind <> rdkUnknown) and
(not aOnlyFieldData)
then
AssertEquals(AMessage + ': VKind', ExpKind, FldData.Field.ValueKind); AssertEquals(AMessage + ': VKind', ExpKind, FldData.Field.ValueKind);
AssertTypeName(AMessage + ': Anch TypeName', FldData.Owner, ExpAnchTypeName); AssertTypeName(AMessage + ': Anch TypeName', FldData.Owner, ExpAnchTypeName);
if FldData.Field.ValueKind <> rdkError then if (not aOnlyFieldData) and
(FldData.Field.ValueKind <> rdkError)
then
AssertTypeName(AMessage + ': Field TypeName', FldData.Field, ExpTypeName); AssertTypeName(AMessage + ': Field TypeName', FldData.Field, ExpTypeName);
@ -772,7 +814,7 @@ procedure TTestIdeDebuggerWatchResult.AssertStruct(const AMessage: string;
IdeRes: TWatchResultData; StrctTyp: TLzDbgStructType; WithFld: Boolean; IdeRes: TWatchResultData; StrctTyp: TLzDbgStructType; WithFld: Boolean;
WithAnch: Integer; WithAnch1Fld, WithAnch2Fld: Boolean; aEntryType1, WithAnch: Integer; WithAnch1Fld, WithAnch2Fld: Boolean; aEntryType1,
aEntryType2: TTestCreateDataKind; aErr1, aErr2: Boolean; aNil: Boolean; aEntryType2: TTestCreateDataKind; aErr1, aErr2: Boolean; aNil: Boolean;
ExpTypeName: String); ExpTypeName: String; aOnlyFieldData: Boolean);
var var
ExpCnt, ExpOffs: Integer; ExpCnt, ExpOffs: Integer;
begin begin
@ -791,32 +833,46 @@ begin
AssertStructData('', IdeRes, StrctTyp, 700, ExpCnt, ExpTypeName); AssertStructData('', IdeRes, StrctTyp, 700, ExpCnt, ExpTypeName);
ExpOffs := 0; ExpOffs := 0;
if WithFld then begin if WithFld then begin
if aErr1 and not aErr2 then if aErr1 and not aErr2 then begin
AssertErrData('', IdeRes.Fields[ExpOffs+0].Field, 'bad') if not aOnlyFieldData then
else AssertErrData('', IdeRes.Fields[ExpOffs+0].Field, 'bad');
AssertStructField('', IdeRes, ExpOffs+0, 'Foo', dfvProtected, [], ExpTypeName, 'TMyFoo'); end
else begin
AssertStructField('', IdeRes, ExpOffs+0, 'Foo', dfvProtected, [], ExpTypeName, 'TMyFoo',
rdkUnknown, True, True, aOnlyFieldData);
end;
AssertStructField('', IdeRes, ExpOffs+1, 'Abc', dfvPublic, [], ExpTypeName, #1, rdkError); AssertStructField('', IdeRes, ExpOffs+1, 'Abc', dfvPublic, [], ExpTypeName, #1, rdkError,
AssertErrData('', IdeRes.Fields[ExpOffs+1].Field, 'ouch'); True, True, aOnlyFieldData);
if not aOnlyFieldData then
AssertErrData('', IdeRes.Fields[ExpOffs+1].Field, 'ouch');
AssertStructField('', IdeRes, ExpOffs+2, 'Bar', dfvPublic, [], ExpTypeName, 'TMyBar'); AssertStructField('', IdeRes, ExpOffs+2, 'Bar', dfvPublic, [], ExpTypeName, 'TMyBar',
AssertData('', IdeRes.Fields[ExpOffs+2].Field, aEntryType2, aErr2, 'TMyBar', 301, 1201); rdkUnknown, True, True, aOnlyFieldData);
if not aOnlyFieldData then
AssertData('', IdeRes.Fields[ExpOffs+2].Field, aEntryType2, aErr2, 'TMyBar', 301, 1201);
ExpOffs := ExpOffs + 3; ExpOffs := ExpOffs + 3;
end; end;
if WithAnch1Fld and (WithAnch >= 1) then begin if WithAnch1Fld and (WithAnch >= 1) then begin
AssertStructField('', IdeRes, ExpOffs+0, 'P1Abc', dfvPrivate, [], 'TAnch1', #1, rdkError); AssertStructField('', IdeRes, ExpOffs+0, 'P1Abc', dfvPrivate, [], 'TAnch1', #1, rdkError,
AssertErrData('', IdeRes.Fields[ExpOffs+0].Field, 'bad'); True, True, aOnlyFieldData);
if not aOnlyFieldData then
AssertErrData('', IdeRes.Fields[ExpOffs+0].Field, 'bad');
AssertStructField('', IdeRes, ExpOffs+1, 'P1Foo', dfvProtected, [], 'TAnch1', 'TMyFoo'); AssertStructField('', IdeRes, ExpOffs+1, 'P1Foo', dfvProtected, [], 'TAnch1', 'TMyFoo',
AssertData('', IdeRes.Fields[ExpOffs+1].Field, aEntryType1, False, 'TMyFoo', 310, 1210); rdkUnknown, True, True, aOnlyFieldData);
if not aOnlyFieldData then
AssertData('', IdeRes.Fields[ExpOffs+1].Field, aEntryType1, False, 'TMyFoo', 310, 1210);
ExpOffs := ExpOffs + 2; ExpOffs := ExpOffs + 2;
end; end;
if WithAnch2Fld and (WithAnch >= 2) then begin if WithAnch2Fld and (WithAnch >= 2) then begin
AssertStructField('', IdeRes, ExpOffs+0, 'P2Foo', dfvProtected, [], 'TAnch2', 'TMyXyz'); AssertStructField('', IdeRes, ExpOffs+0, 'P2Foo', dfvProtected, [], 'TAnch2', 'TMyXyz',
AssertData('', IdeRes.Fields[ExpOffs+0].Field, aEntryType2, not aErr2, 'TMyXyz', 320, 1220); rdkUnknown, True, True, aOnlyFieldData);
if not aOnlyFieldData then
AssertData('', IdeRes.Fields[ExpOffs+0].Field, aEntryType2, not aErr2, 'TMyXyz', 320, 1220);
ExpOffs := ExpOffs + 1; ExpOffs := ExpOffs + 1;
end; end;
@ -937,6 +993,17 @@ begin
dat.CreateNumValue(ANum+7, True, 2); dat.CreateNumValue(ANum+7, True, 2);
end; end;
function TTestIdeDebuggerWatchResult.CreateArrayOfErr(
ResIntf: TLzDbgWatchDataIntf; AnErr: String): TTwoResRecord;
var
dat: TLzDbgWatchDataIntf;
begin
Result.NestPtr := ResIntf.CreateArrayValue(datDynArray, 2);
Result.NestNum := ResIntf.SetNextArrayData;
Result.NestNum.CreateError(AnErr);
end;
function TTestIdeDebuggerWatchResult.CreateEmptyArrayOfNum( function TTestIdeDebuggerWatchResult.CreateEmptyArrayOfNum(
ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer): TTwoResRecord; ResIntf: TLzDbgWatchDataIntf; ANum: Int64; AByteSize: integer): TTwoResRecord;
var var
@ -958,7 +1025,8 @@ end;
procedure TTestIdeDebuggerWatchResult.CreateStruct( procedure TTestIdeDebuggerWatchResult.CreateStruct(
ResIntf: TLzDbgWatchDataIntf; StrctTyp: TLzDbgStructType; WithFld: Boolean; ResIntf: TLzDbgWatchDataIntf; StrctTyp: TLzDbgStructType; WithFld: Boolean;
WithAnch: Integer; WithAnch1Fld, WithAnch2Fld: Boolean; aEntryType1, WithAnch: Integer; WithAnch1Fld, WithAnch2Fld: Boolean; aEntryType1,
aEntryType2: TTestCreateDataKind; aErr1, aErr2: Boolean; aNil: Boolean); aEntryType2: TTestCreateDataKind; aErr1, aErr2: Boolean; aNil: Boolean;
aOnlyFieldData: Boolean);
var var
ExpCnt: Integer; ExpCnt: Integer;
FldIntf, Anch1Intf: TLzDbgWatchDataIntf; FldIntf, Anch1Intf: TLzDbgWatchDataIntf;
@ -981,7 +1049,8 @@ begin
ExpCnt := 0; ExpCnt := 0;
if WithFld then begin if WithFld then begin
FldIntf := ResIntf.AddField('Foo', dfvProtected, []); FldIntf := ResIntf.AddField('Foo', dfvProtected, []);
CreateData(FldIntf, aEntryType1, aErr1, 'TMyFoo', 300, 1200); if not aOnlyFieldData then
CreateData(FldIntf, aEntryType1, aErr1, 'TMyFoo', 300, 1200);
//if aErr3 then //if aErr3 then
if aErr1 and not aErr2 then if aErr1 and not aErr2 then
FldIntf.CreateError('bad'); FldIntf.CreateError('bad');
@ -990,7 +1059,8 @@ begin
FldIntf.CreateError('ouch'); FldIntf.CreateError('ouch');
FldIntf := ResIntf.AddField('Bar', dfvPublic, []); FldIntf := ResIntf.AddField('Bar', dfvPublic, []);
CreateData(FldIntf, aEntryType2, aErr2, 'TMyBar', 301, 1201); if not aOnlyFieldData then
CreateData(FldIntf, aEntryType2, aErr2, 'TMyBar', 301, 1201);
ExpCnt := ExpCnt + 3; ExpCnt := ExpCnt + 3;
end; end;
@ -1001,7 +1071,8 @@ begin
FldIntf.CreateError('bad'); FldIntf.CreateError('bad');
FldIntf := Anch1Intf.AddField('P1Foo', dfvProtected, []); FldIntf := Anch1Intf.AddField('P1Foo', dfvProtected, []);
CreateData(FldIntf, aEntryType1, False, 'TMyFoo', 310, 1210); if not aOnlyFieldData then
CreateData(FldIntf, aEntryType1, False, 'TMyFoo', 310, 1210);
ExpCnt := ExpCnt + 2; ExpCnt := ExpCnt + 2;
end; end;
@ -1010,7 +1081,8 @@ begin
if WithAnch2Fld then begin if WithAnch2Fld then begin
FldIntf := Anch1Intf.AddField('P2Foo', dfvProtected, []); FldIntf := Anch1Intf.AddField('P2Foo', dfvProtected, []);
CreateData(FldIntf, aEntryType2, not aErr2, 'TMyXyz', 320, 1220); if not aOnlyFieldData then
CreateData(FldIntf, aEntryType2, not aErr2, 'TMyXyz', 320, 1220);
ExpCnt := ExpCnt + 1; ExpCnt := ExpCnt + 1;
end; end;
end; end;
@ -1040,9 +1112,15 @@ begin
cdErrArr_Num: ResIntf.CreateError(AnErrPreFix+'ouch'); cdErrArr_Num: ResIntf.CreateError(AnErrPreFix+'ouch');
cdArr_EmptyNum: Result := cdArr_EmptyNum: Result :=
CreateEmptyArrayOfNum(ResIntf, ANumVal); CreateEmptyArrayOfNum(ResIntf, ANumVal);
cdArr_ErrNum: Result :=
CreateArrayOfErr(ResIntf, AnErrPreFix+'no');
cdPtr_ErrArr_Num: Result.NestNum := cdPtr_ErrArr_Num: Result.NestNum :=
CreatePtrErr (ResIntf, AnAddr, AnErrPreFix+'argh'); CreatePtrErr (ResIntf, AnAddr, AnErrPreFix+'argh');
cdErrStruct: ResIntf.CreateError(AnErrPreFix+'bad-obj');
cdStruct_ErrField:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, True, True); cdStruct_ErrField:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, True, True);
cdStruct_Nil: CreateStruct(ResIntf, dstObject, False, 0, False, False, cdErrNum, cdErrNum, False, False);
cdStruct_ErrEmptyFields:ResIntf.CreateError(AnErrPreFix+'f-ouch');
//cdStruct_EmptyFields:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False,False, True);
end end
else else
case AKind of case AKind of
@ -1056,11 +1134,16 @@ begin
CreatePtrPtrNum(ResIntf, AnAddr, ANumVal, 2); CreatePtrPtrNum(ResIntf, AnAddr, ANumVal, 2);
cdErrArr_Num: Result := cdErrArr_Num: Result :=
CreateArrayOfNum(ResIntf, ANumVal); CreateArrayOfNum(ResIntf, ANumVal);
cdArr_EmptyNum: Result := cdArr_EmptyNum,
cdArr_ErrNum: Result :=
CreateArrayOfNum(ResIntf, ANumVal); CreateArrayOfNum(ResIntf, ANumVal);
cdPtr_ErrArr_Num: Result := cdPtr_ErrArr_Num: Result :=
CreatePtrArrayOfNum(ResIntf, ANumVal); CreatePtrArrayOfNum(ResIntf, ANumVal);
cdStruct_ErrField:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False); cdErrStruct,
cdStruct_ErrField,
cdStruct_Nil,
cdStruct_ErrEmptyFields:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False);
//cdStruct_EmptyFields:CreateStruct(ResIntf, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False);
end; end;
if ATypeName <> '' then if ATypeName <> '' then
@ -1082,8 +1165,13 @@ begin
cdErrPtr_Ptr_Num: AssertErrData (AMessage, IdeRes, AnErrPreFix+'ouch'); cdErrPtr_Ptr_Num: AssertErrData (AMessage, IdeRes, AnErrPreFix+'ouch');
cdErrArr_Num: AssertErrData (AMessage, IdeRes, AnErrPreFix+'ouch'); cdErrArr_Num: AssertErrData (AMessage, IdeRes, AnErrPreFix+'ouch');
cdArr_EmptyNum: AssertEmptyArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName); cdArr_EmptyNum: AssertEmptyArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName);
cdArr_ErrNum: AssertArrayOfErrData (AMessage, IdeRes, AnErrPreFix+'no');
cdPtr_ErrArr_Num: AssertPointerToErrData (AMessage, IdeRes, AnAddr, AnErrPreFix+'argh'); cdPtr_ErrArr_Num: AssertPointerToErrData (AMessage, IdeRes, AnAddr, AnErrPreFix+'argh');
cdErrStruct: AssertErrData (AMessage, IdeRes, AnErrPreFix+'bad-obj');
cdStruct_ErrField:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, True, True, False, ATypeName); cdStruct_ErrField:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, True, True, False, ATypeName);
cdStruct_Nil: AssertStruct(AMessage, IdeRes, dstObject, False, 0, False, False, cdErrNum, cdErrNum, False, False, True, ATypeName);
cdStruct_ErrEmptyFields:AssertErrData (AMessage, IdeRes, AnErrPreFix+'f-ouch');
//cdStruct_EmptyFields:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False, False, ATypeName, True);
end end
else else
case AKind of case AKind of
@ -1093,10 +1181,15 @@ begin
cdErrPtr_Num: AssertPointerToSignedNumData(AMessage, IdeRes, AnAddr, ANumVal, 2, ATypeName, 'TMyNum'); cdErrPtr_Num: AssertPointerToSignedNumData(AMessage, IdeRes, AnAddr, ANumVal, 2, ATypeName, 'TMyNum');
cdPtr_Ptr_ErrNum.. cdPtr_Ptr_ErrNum..
cdErrPtr_Ptr_Num: AssertPtrPointerToSignedNumData(AMessage, IdeRes, AnAddr, AnAddr+1, ANumVal, 2, ATypeName, 'TFooPtr', 'TFooNum'); cdErrPtr_Ptr_Num: AssertPtrPointerToSignedNumData(AMessage, IdeRes, AnAddr, AnAddr+1, ANumVal, 2, ATypeName, 'TFooPtr', 'TFooNum');
cdErrArr_Num: AssertArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName); cdErrArr_Num,
cdArr_EmptyNum: AssertArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName); cdArr_EmptyNum,
cdArr_ErrNum: AssertArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName);
cdPtr_ErrArr_Num: AssertPtrArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName); cdPtr_ErrArr_Num: AssertPtrArrayOfNumData(AMessage, IdeRes, ANumVal, ATypeName);
cdStruct_ErrField:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False, False, ATypeName); cdErrStruct,
cdStruct_ErrField,
cdStruct_Nil,
cdStruct_ErrEmptyFields:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False, False, ATypeName);
//cdStruct_EmptyFields:AssertStruct(AMessage, IdeRes, dstObject, True, 0, False, False, cdErrNum, cdErrNum, False, False, False, ATypeName);
end; end;
end; end;
@ -1478,6 +1571,16 @@ var
ResIntfStr, ProtoIntf: TLzDbgWatchDataIntf; ResIntfStr, ProtoIntf: TLzDbgWatchDataIntf;
Res, ResArray: TWatchResultData; Res, ResArray: TWatchResultData;
begin begin
(*
- PCharOrString
0: Array[aLen] OR Err (AErrIdx=-2)
[0] Data-or-Err (aErrIdx=0)
[1] Data-or-Err (aErrIdx=1)
1: Array[aLen] OR Err (AErrIdxSecond=-2)
[0] Data-or-Err (AErrIdxSecond=0)
[1] Data-or-Err (AErrIdxSecond=1)
*)
for x := 0 to 2 do for x := 0 to 2 do
for aEntryType := low(TTestCreateDataKind) to high(TTestCreateDataKind) do for aEntryType := low(TTestCreateDataKind) to high(TTestCreateDataKind) do
for aLen := 0 to 2 do for aLen := 0 to 2 do