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

Debugger: DebuggerOptions load unknown/unsupported backends into separate lists.

Browse Source
This commit is contained in:
Martin 2023-01-01 22:50:19 +01:00
parent c7de909539
commit 4a616acb99
3 changed files with 388 additions and 145 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
debugger/frames/debugger_class_options.pas
View File

@ -332,7 +332,10 @@ begin
List := TStringListUTF8Fast.Create;
for i := 0 to TBaseDebugManagerIntf.DebuggerCount - 1 do begin
d := TBaseDebugManagerIntf.Debuggers[i];
if dfNotSuitableForOsArch in d.SupportedFeatures then
if (dfNotSuitableForOsArch in d.SupportedFeatures) and
( (DebuggerOptions.DebuggerPropertiesConfigList.ForcedUnsuitableClass = nil) or
( d <> DebuggerOptions.DebuggerPropertiesConfigList.ForcedUnsuitableClass) )
then
continue;
List.AddObject(d.Caption, TObject(d));
end;
@ -569,16 +572,14 @@ begin
tbSelect.DropdownMenu := tbDropMenu;
{$ENDIF}
tbDropMenu.Items.Clear;
for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do
if (FCopiedDbgPropertiesConfigList.Opt[i].IsLoaded)
then begin
m := TMenuItem.Create(tbDropMenu);
m.Caption := FCopiedDbgPropertiesConfigList.Opt[i].DisplayName;
m.Tag := i;
m.OnClick := @DoNameSelected;
m.Checked := FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig;
tbDropMenu.Items.Add(m);
end;
for i := 0 to FCopiedDbgPropertiesConfigList.Count - 1 do begin
m := TMenuItem.Create(tbDropMenu);
m.Caption := FCopiedDbgPropertiesConfigList.Opt[i].DisplayName;
m.Tag := i;
m.OnClick := @DoNameSelected;
m.Checked := FCopiedDbgPropertiesConfigList.Opt[i] = FSelectedDbgPropertiesConfig;
tbDropMenu.Items.Add(m);
end;
if FSelectedDbgPropertiesConfig <> nil then
tbSelect.Caption := FSelectedDbgPropertiesConfig.DisplayName
else

199
ide/packages/idedebugger/idedebuggeropts.pas
View File

@ -59,30 +59,51 @@ type
property UID: String read FUID write FUID;
end;
{ TDebuggerPropertiesConfigList }
{ TDebuggerPropertiesConfigListBase }
TDebuggerPropertiesConfigList = class(TStringListUTF8Fast)
private const
XML_PATH_DEBUGGER_CONF = 'Config[%d]/';
XML_PATH_DEBUGGER_CONF_OLD = 'Class%s/';
TDebuggerPropertiesConfigListBase = class(TStringListUTF8Fast)
private
FHasActiveDebuggerEntry: Boolean;
FKnownDebuggerClassCount: Integer;
FCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; // Active entry, if loaded (if class was found, and is supported)
function GetOpt(Index: Integer): TDebuggerPropertiesConfig;
procedure SetCurrentDebuggerPropertiesOpt(AValue: TDebuggerPropertiesConfig);
public
constructor Create;
procedure LoadFromXml(AXMLCfg: TRttiXMLConfig; APath: String);
procedure LoadFromOldXml(AXMLCfg: TRttiXMLConfig; APath: String; AnOldFileNamePath: String = '');
procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AForceSaveEmpty: Boolean = False);
function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig;
function EntryByUid(AnUid: String): TDebuggerPropertiesConfig;
property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt;
property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read FCurrentDebuggerPropertiesConfig;
end;
{ TDebuggerPropertiesConfigList }
TDebuggerPropertiesConfigList = class(TDebuggerPropertiesConfigListBase)
private const
XML_PATH_DEBUGGER_CONF = 'Config[%d]/';
XML_PATH_DEBUGGER_CONF_OLD = 'Class%s/';
private
FForcedUnsuitableClass: TDebuggerClass;
FHasActiveDebuggerEntry: Boolean;
FKnownDebuggerClassCount: Integer;
FUnsuitable, FUnloaded: TDebuggerPropertiesConfigListBase;
function GetListForEntry(AnEntry: TDebuggerPropertiesConfig): TDebuggerPropertiesConfigListBase;
procedure SetCurrentDebuggerPropertiesOpt(AValue: TDebuggerPropertiesConfig);
procedure AddEntry(AnEntry: TDebuggerPropertiesConfig);
public
constructor Create;
destructor Destroy; override;
procedure Clear; override;
procedure LoadFromXml(AXMLCfg: TRttiXMLConfig; APath: String);
procedure LoadFromOldXml(AXMLCfg: TRttiXMLConfig; APath: String; AnOldFileNamePath: String = '');
procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AForceSaveEmpty: Boolean = False);
property HasActiveDebuggerEntry: Boolean read FHasActiveDebuggerEntry write FHasActiveDebuggerEntry; // for the initial setup dialog / entry may be of unknown class
property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read FCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt;
property Unsuitable: TDebuggerPropertiesConfigListBase read FUnsuitable;
property Unloaded: TDebuggerPropertiesConfigListBase read FUnloaded;
property ForcedUnsuitableClass: TDebuggerClass read FForcedUnsuitableClass;
end;
{ TDebuggerOptions }
@ -463,27 +484,106 @@ end;
// end;
//end;
{ TDebuggerPropertiesConfigList }
{ TDebuggerPropertiesConfigListBase }
function TDebuggerPropertiesConfigList.GetOpt(Index: Integer): TDebuggerPropertiesConfig;
function TDebuggerPropertiesConfigListBase.GetOpt(Index: Integer
): TDebuggerPropertiesConfig;
begin
Result := TDebuggerPropertiesConfig(Objects[Index]);
end;
constructor TDebuggerPropertiesConfigListBase.Create;
begin
inherited Create;
OwnsObjects := True;
end;
function TDebuggerPropertiesConfigListBase.EntryByName(AConfName,
AConfClass: String): TDebuggerPropertiesConfig;
var
i: Integer;
dpCfg: TDebuggerPropertiesConfig;
begin
Result := nil;
i := Count - 1;
while i >= 0 do begin
dpCfg := Opt[i];
if dpCfg.IsLoaded
and (dpCfg.ConfigName = AConfName)
and (dpCfg.ConfigClass = AConfClass) then
Break;
dec(i);
end;
if i >= 0 then
Result := dpCfg;
end;
function TDebuggerPropertiesConfigListBase.EntryByUid(AnUid: String
): TDebuggerPropertiesConfig;
var
i: Integer;
begin
Result := nil;
i := Count - 1;
while (i >= 0) and (Opt[i].UID <> AnUid) do
dec(i);
if i >= 0 then
Result := Opt[i];
end;
{ TDebuggerPropertiesConfigList }
function TDebuggerPropertiesConfigList.GetListForEntry(
AnEntry: TDebuggerPropertiesConfig): TDebuggerPropertiesConfigListBase;
begin
Result := Self;
if not AnEntry.IsLoaded then begin
if (AnEntry.DebuggerClass <> nil) and (dfNotSuitableForOsArch in AnEntry.DebuggerClass.SupportedFeatures) then
Result := FUnsuitable
else
Result := FUnloaded;
end;
end;
procedure TDebuggerPropertiesConfigList.SetCurrentDebuggerPropertiesOpt(
AValue: TDebuggerPropertiesConfig);
begin
if FCurrentDebuggerPropertiesConfig = AValue then Exit;
assert(AValue.IsLoaded, 'TDebuggerPropertiesConfigList.SetCurrentDebuggerPropertiesOpt: AValue.IsLoaded');
if (AValue <> nil) and (IndexOfObject(AValue) < 0) then
AddObject(AValue.ConfigName, AValue);
AddEntry(AValue);
FCurrentDebuggerPropertiesConfig := AValue;
end;
procedure TDebuggerPropertiesConfigList.AddEntry(
AnEntry: TDebuggerPropertiesConfig);
begin
GetListForEntry(AnEntry).AddObject(AnEntry.ConfigName, AnEntry);
if AnEntry.IsLoaded and (dfNotSuitableForOsArch in AnEntry.DebuggerClass.SupportedFeatures) then
FForcedUnsuitableClass := AnEntry.DebuggerClass;
end;
constructor TDebuggerPropertiesConfigList.Create;
begin
FUnsuitable := TDebuggerPropertiesConfigListBase.Create;
FUnloaded := TDebuggerPropertiesConfigListBase.Create;
inherited Create;
OwnsObjects := True;
end;
destructor TDebuggerPropertiesConfigList.Destroy;
begin
inherited Destroy;
FUnsuitable.Free;
FUnloaded.Free;
end;
procedure TDebuggerPropertiesConfigList.Clear;
begin
inherited Clear;
FUnsuitable.Clear;
FUnloaded.Clear;
end;
procedure TDebuggerPropertiesConfigList.LoadFromXml(AXMLCfg: TRttiXMLConfig;
@ -503,15 +603,16 @@ begin
Clear;
FCurrentDebuggerPropertiesConfig := nil;
FForcedUnsuitableClass := nil;
ConfCount := AXMLCfg.GetListItemCount(APath, 'Config', False);
for i := 1 to ConfCount do begin
Entry := TDebuggerPropertiesConfig.CreateFromXmlConf(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF, i, FCurrentDebuggerPropertiesConfig<>nil);
AddObject(Entry.ConfigName, Entry);
AddEntry(Entry);
if Entry.Active then begin
HasActiveDebuggerEntry := True;
if Entry.IsLoaded and (FCurrentDebuggerPropertiesConfig = nil) then
FCurrentDebuggerPropertiesConfig := Entry;
if GetListForEntry(Entry).FCurrentDebuggerPropertiesConfig = nil then
GetListForEntry(Entry).FCurrentDebuggerPropertiesConfig := Entry;
end;
end;
end;
@ -561,13 +662,13 @@ begin
if IsEntryForCurrentClass then begin
ActiveClassName := '';
if Entry.IsLoaded and Entry.Active then
FCurrentDebuggerPropertiesConfig := Entry;
if GetListForEntry(Entry).FCurrentDebuggerPropertiesConfig = nil then
GetListForEntry(Entry).FCurrentDebuggerPropertiesConfig := Entry;
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
Entry.DebuggerFilename := CurFilename;
end;
AddObject(Entry.ConfigName, Entry);
AddEntry(Entry);
end;
end;
@ -576,10 +677,9 @@ begin
if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then
Entry.DebuggerFilename := CurFilename;
AddObject(Entry.ConfigName, Entry);
AddEntry(Entry);
assert(FCurrentDebuggerPropertiesConfig=nil, 'TDebuggerPropertiesConfigList.LoadFromOldXml: FCurrentDebuggerPropertiesConfig=nil');
if Entry.IsLoaded then
FCurrentDebuggerPropertiesConfig := Entry;
GetListForEntry(Entry).FCurrentDebuggerPropertiesConfig := Entry;
end;
end;
end;
@ -603,43 +703,26 @@ begin
inc(Idx);
end;
for i := 0 to FUnloaded.Count - 1 do begin
Entry := FUnloaded.Opt[i];
Entry.Active := (FCurrentDebuggerPropertiesConfig = nil) and
(Entry = FUnloaded.FCurrentDebuggerPropertiesConfig);
Entry.SaveToXml(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF, Idx);
inc(Idx);
end;
for i := 0 to FUnsuitable.Count - 1 do begin
Entry := FUnsuitable.Opt[i];
Entry.Active := (FCurrentDebuggerPropertiesConfig = nil) and
(FUnloaded.FCurrentDebuggerPropertiesConfig = nil) and
(Entry = FUnsuitable.FCurrentDebuggerPropertiesConfig);
Entry.SaveToXml(AXMLCfg, APath + XML_PATH_DEBUGGER_CONF, Idx);
inc(Idx);
end;
if (Count > 0) or AForceSaveEmpty then
AXMLCfg.SetValue(APath+'Version', 1);
end;
function TDebuggerPropertiesConfigList.EntryByName(AConfName, AConfClass: String
): TDebuggerPropertiesConfig;
var
i: Integer;
dpCfg: TDebuggerPropertiesConfig;
begin
Result := nil;
i := Count - 1;
while i >= 0 do begin
dpCfg := Opt[i];
if dpCfg.IsLoaded
and (dpCfg.ConfigName = AConfName)
and (dpCfg.ConfigClass = AConfClass) then
Break;
dec(i);
end;
if i >= 0 then
Result := dpCfg;
end;
function TDebuggerPropertiesConfigList.EntryByUid(AnUid: String
): TDebuggerPropertiesConfig;
var
i: Integer;
begin
Result := nil;
i := Count - 1;
while (i >= 0) and (Opt[i].UID <> AnUid) do
dec(i);
if i >= 0 then
Result := Opt[i];
end;
{ TDebuggerOptions }
procedure TDebuggerOptions.InitXMLCfg(CleanConfig: boolean);

311
ide/packages/idedebugger/test/testxmlopts.pas
View File

@ -64,12 +64,12 @@ type
public
procedure InitXMLCfg(CleanConfig: boolean);
property XMLCfg;
function EntryCntByName(AName: String): Integer;
function EntryCntByClass(AClass: String): Integer;
function EntryCntByNameAndClass(AName, AClass: String): Integer;
function EntryByName(AName: String): TDebuggerPropertiesConfig;
function EntryByClass(AClass: String): TDebuggerPropertiesConfig;
function EntryByNameAndClass(AName,AClass: String): TDebuggerPropertiesConfig;
function EntryCntByName(AName: String; AnUnloaded: Boolean = False): Integer;
function EntryCntByClass(AClass: String; AnUnloaded: Boolean = False): Integer;
function EntryCntByNameAndClass(AName, AClass: String; AnUnloaded: Boolean = False): Integer;
function EntryByName(AName: String; AnUnloaded: Boolean = False): TDebuggerPropertiesConfig;
function EntryByClass(AClass: String; AnUnloaded: Boolean = False): TDebuggerPropertiesConfig;
function EntryByNameAndClass(AName,AClass: String; AnUnloaded: Boolean = False): TDebuggerPropertiesConfig;
end;
{ TTestXmlOpts }
@ -88,20 +88,20 @@ type
protected
procedure DebuglnDbgOptConfigs(opts: TTestDebuggerOptions);
procedure TearDown; override;
procedure TestEntryCnt(AnOpts: TTestDebuggerOptions; ExpCount: Integer);
procedure TestEntryCnt(AnOpts: TTestDebuggerOptions; ExpCount, ExpUnloadedCount: Integer);
procedure TestHasEntry(AnOpts: TTestDebuggerOptions;
ExpName, ExpClass: String;
ExpActive: Boolean = False;
ExpPath: String = '';
ExpUUID: String = ''
//ExpLoaded: Boolean = False;
ExpUUID: String = '';
ExpLoaded: Boolean = True
);
procedure TestHasClassEntry(AnOpts: TTestDebuggerOptions;
ExpClass: String;
ExpActive: Boolean = False;
ExpPath: String = '';
ExpUUID: String = ''
//ExpLoaded: Boolean = False;
ExpUUID: String = '';
ExpLoaded: Boolean = True
);
procedure TestEntryCnt(AnXml: TXMLDocument; ExpCount: Integer);
procedure TestHasEntry(AnXml: TXMLDocument;
@ -118,6 +118,8 @@ type
procedure TestLoadEnvNew;
procedure TestLoadEnvOld;
procedure TestLoadEnvMixed;
procedure TestLoadEnvNewUnknowActive;
procedure TestLoadEnvOldUnknowActive;
procedure TestLoadFromDbg; // Check options from DebuggerOptions are loaded, and not EnvironmentOpts
procedure TestDeleteSave;
end;
@ -259,6 +261,48 @@ begin
'</CONFIG>';
end;
function ConfigEnvNewUnknowActive: String;
begin
Result :=
'<?xml version="1.0"?>' +
'<CONFIG>' +
' <EnvironmentOptions>' +
' <Version Value="110" Lazarus="2.3.0"/>' +
' <Debugger>' +
' <Configs>' +
EntryNew('abc1', 'TTestDebuggerBackendAbc', 'abc.exe', False, '', 'U-1') +
EntryNew('abc2', 'TTestDebuggerBackendAbc', 'abc.exe', False, PROPS_ABC1, 'U-2') +
EntryNew('abc3', 'TTestDebuggerBackendAbc', 'abc3.exe', False, '', 'U-3') +
EntryNew('foo1', 'TTestDebuggerBackendFoo', 'foo.exe', False, PROPS_FOO1, 'U-4') +
EntryNew('xxx0', 'TUnknownDebuggerBackend', 'any.exe', True, PROPS_UNK1, 'U-5') +
EntryNew('xxx1', 'TNotFoundDebuggerBackend', 'no.exe', False, PROPS_ABC1, 'U-6') +
' </Configs>' +
' </Debugger>' +
' </EnvironmentOptions>' +
'</CONFIG>';
end;
function ConfigEnv1_8_UnknownActive: String;
begin
Result :=
'<?xml version="1.0"?>' +
'<CONFIG>' +
' <EnvironmentOptions>' +
' <Version Value="110" Lazarus="1.8.5"/>' +
' <Debugger Class="TUnknownDebuggerBackend" EventLogLineLimit="100">' +
EntryOld('TTestDebuggerBackendBar') +
EntryOld('TTestDebuggerBackendAbc', PROPS_ABC1) +
EntryOld('TUnknownDebuggerBackend', PROPS_UNK1)+
EntryOld('TTestDebuggerBackendFoo', PROPS_FOO1)+
' </Debugger>' +
' <DebuggerFilename Value="C:\gdb.exe">' +
' <History Count="1">' +
' <Item1 Value="$Path($(CompPath))\gdb.exe"/>' +
' </History>' +
' </DebuggerFilename>' +
' </EnvironmentOptions>' +
'</CONFIG>';
end;
function ConfigDbgNewOne: String;
begin
Result :=
@ -356,71 +400,97 @@ begin
inherited InitXMLCfg(CleanConfig);
end;
function TTestDebuggerOptions.EntryCntByName(AName: String): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if DebuggerPropertiesConfigList.Opt[i].ConfigName = AName then
inc(Result);
end;
function TTestDebuggerOptions.EntryCntByClass(AClass: String): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if DebuggerPropertiesConfigList.Opt[i].ConfigClass = AClass then
inc(Result);
end;
function TTestDebuggerOptions.EntryCntByNameAndClass(AName, AClass: String
function TTestDebuggerOptions.EntryCntByName(AName: String; AnUnloaded: Boolean
): Integer;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := 0;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if (DebuggerPropertiesConfigList.Opt[i].ConfigName = AName) and
(DebuggerPropertiesConfigList.Opt[i].ConfigClass = AClass)
for i := 0 to l.Count - 1 do
if l.Opt[i].ConfigName = AName then
inc(Result);
end;
function TTestDebuggerOptions.EntryCntByClass(AClass: String;
AnUnloaded: Boolean): Integer;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := 0;
for i := 0 to l.Count - 1 do
if l.Opt[i].ConfigClass = AClass then
inc(Result);
end;
function TTestDebuggerOptions.EntryCntByNameAndClass(AName, AClass: String;
AnUnloaded: Boolean): Integer;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := 0;
for i := 0 to l.Count - 1 do
if (l.Opt[i].ConfigName = AName) and
(l.Opt[i].ConfigClass = AClass)
then
inc(Result);
end;
function TTestDebuggerOptions.EntryByName(AName: String
function TTestDebuggerOptions.EntryByName(AName: String; AnUnloaded: Boolean
): TDebuggerPropertiesConfig;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := nil;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if DebuggerPropertiesConfigList.Opt[i].ConfigName = AName then
exit(DebuggerPropertiesConfigList.Opt[i]);
for i := 0 to l.Count - 1 do
if l.Opt[i].ConfigName = AName then
exit(l.Opt[i]);
end;
function TTestDebuggerOptions.EntryByClass(AClass: String
function TTestDebuggerOptions.EntryByClass(AClass: String; AnUnloaded: Boolean
): TDebuggerPropertiesConfig;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := nil;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if DebuggerPropertiesConfigList.Opt[i].ConfigClass = AClass then
exit(DebuggerPropertiesConfigList.Opt[i]);
for i := 0 to l.Count - 1 do
if l.Opt[i].ConfigClass = AClass then
exit(l.Opt[i]);
end;
function TTestDebuggerOptions.EntryByNameAndClass(AName, AClass: String
): TDebuggerPropertiesConfig;
function TTestDebuggerOptions.EntryByNameAndClass(AName, AClass: String;
AnUnloaded: Boolean): TDebuggerPropertiesConfig;
var
i: Integer;
l: TDebuggerPropertiesConfigListBase;
begin
l := DebuggerPropertiesConfigList;
if AnUnloaded then l := DebuggerPropertiesConfigList.Unloaded;
Result := nil;
for i := 0 to DebuggerPropertiesConfigList.Count - 1 do
if (DebuggerPropertiesConfigList.Opt[i].ConfigName = AName) and
(DebuggerPropertiesConfigList.Opt[i].ConfigClass = AClass) then
exit(DebuggerPropertiesConfigList.Opt[i]);
for i := 0 to l.Count - 1 do
if (l.Opt[i].ConfigName = AName) and
(l.Opt[i].ConfigClass = AClass) then
exit(l.Opt[i]);
end;
@ -539,31 +609,36 @@ begin
inherited TearDown;
end;
procedure TTestXmlOpts.TestEntryCnt(AnOpts: TTestDebuggerOptions;
ExpCount: Integer);
procedure TTestXmlOpts.TestEntryCnt(AnOpts: TTestDebuggerOptions; ExpCount,
ExpUnloadedCount: Integer);
begin
AssertEquals('Opts-Cnt', ExpCount, AnOpts.DebuggerPropertiesConfigList.Count);
AssertEquals('Opts-Cnt', ExpUnloadedCount, AnOpts.DebuggerPropertiesConfigList.Unloaded.Count);
end;
procedure TTestXmlOpts.TestHasEntry(AnOpts: TTestDebuggerOptions; ExpName,
ExpClass: String; ExpActive: Boolean; ExpPath: String; ExpUUID: String);
ExpClass: String; ExpActive: Boolean; ExpPath: String; ExpUUID: String;
ExpLoaded: Boolean);
var
e: TDebuggerPropertiesConfig;
begin
if ExpName = #1 then begin
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByNameAndClass('', ExpClass));
e := AnOpts.EntryByNameAndClass('', ExpClass);
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByNameAndClass('', ExpClass, not ExpLoaded));
AssertEquals('Opt Has Entry', 0, AnOpts.EntryCntByNameAndClass('', ExpClass, ExpLoaded));
e := AnOpts.EntryByNameAndClass('', ExpClass, not ExpLoaded);
end
else
if ExpName = '' then begin
// Unnamed Entry for class => and NO other entries by that class
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByClass(ExpClass));
e := AnOpts.EntryByClass(ExpClass);
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByClass(ExpClass, not ExpLoaded));
AssertEquals('Opt Has Entry', 0, AnOpts.EntryCntByClass(ExpClass, ExpLoaded));
e := AnOpts.EntryByClass(ExpClass, not ExpLoaded);
AssertEquals('name', '', e.ConfigName);
end
else begin
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByName(ExpName));
e := AnOpts.EntryByName(ExpName);
AssertEquals('Opt Has Entry', 1, AnOpts.EntryCntByName(ExpName, not ExpLoaded));
AssertEquals('Opt Has Entry', 0, AnOpts.EntryCntByName(ExpName, ExpLoaded));
e := AnOpts.EntryByName(ExpName, not ExpLoaded);
end;
AssertEquals('class', ExpClass, e.ConfigClass);
@ -577,9 +652,10 @@ begin
end;
procedure TTestXmlOpts.TestHasClassEntry(AnOpts: TTestDebuggerOptions;
ExpClass: String; ExpActive: Boolean; ExpPath: String; ExpUUID: String);
ExpClass: String; ExpActive: Boolean; ExpPath: String; ExpUUID: String;
ExpLoaded: Boolean);
begin
TestHasEntry(AnOpts, #1, ExpClass, ExpActive, ExpPath, ExpUUID );
TestHasEntry(AnOpts, #1, ExpClass, ExpActive, ExpPath, ExpUUID, ExpLoaded);
end;
procedure TTestXmlOpts.TestEntryCnt(AnXml: TXMLDocument; ExpCount: Integer);
@ -655,12 +731,12 @@ begin
//WriteLn(SaveDbgOpts(opts));
//WriteLn(SaveEnvOpts);
TestEntryCnt(opts, 5);
TestEntryCnt(opts, 4, 1);
TestHasEntry(opts, 'abc1', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-1');
TestHasEntry(opts, 'abc2', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-2');
TestHasEntry(opts, 'abc3', 'TTestDebuggerBackendAbc', True, 'abc3.exe', 'U-3');
TestHasEntry(opts, 'foo1', 'TTestDebuggerBackendFoo', False, 'foo.exe', 'U-4');
TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5');
TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5', False);
xml := ParseXml(SaveDbgOpts(opts));
@ -700,10 +776,10 @@ begin
InitEnvOpts(ConfigEnv1_8(NoDataForDefault));
opts := InitDbgOpts(CONF_EMPTY);
TestEntryCnt(opts, 4);
TestEntryCnt(opts, 3, 1);
TestHasEntry(opts, '', 'TTestDebuggerBackendBar', False, '');
TestHasEntry(opts, '', 'TTestDebuggerBackendAbc', True, 'C:\gdb.exe');
TestHasEntry(opts, '', 'TUnknownDebuggerBackend', False, '');
TestHasEntry(opts, '', 'TUnknownDebuggerBackend', False, '', '', False);
TestHasEntry(opts, '', 'TTestDebuggerBackendFoo', False, '');
@ -748,21 +824,21 @@ begin
InitEnvOpts(ConfigEnv_Mixed(OldDefault, NoOldClassAttr));
opts := InitDbgOpts(CONF_EMPTY);
TestEntryCnt(opts, 11);
TestEntryCnt(opts, 7, 4);
TestHasEntry(opts, 'abc1', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-1');
TestHasEntry(opts, 'abc2', 'TTestDebuggerBackendAbc', not OldDefault, 'abc.exe', 'U-2');
TestHasEntry(opts, 'abc3', 'TTestDebuggerBackendAbc', False, 'abc3.exe', 'U-3');
TestHasEntry(opts, 'foo1', 'TTestDebuggerBackendFoo', False, 'foo.exe', 'U-4');
TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5');
TestHasEntry(opts, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6');
TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5', False);
TestHasEntry(opts, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6', False);
TestHasClassEntry(opts, 'TTestDebuggerBackendBar', False, 'mixbar', 'M-U1');
if NoOldClassAttr then
TestHasClassEntry(opts, 'TTestDebuggerBackendAbc', False, '')
else
TestHasClassEntry(opts, 'TTestDebuggerBackendAbc', OldDefault, 'C:\gdb.exe');
TestHasClassEntry(opts, 'TUnknownDebuggerBackend', False, '');
TestHasClassEntry(opts, 'TOtherDebuggerBackend', False, '');
TestHasClassEntry(opts, 'TUnknownDebuggerBackend', False, '', '', False);
TestHasClassEntry(opts, 'TOtherDebuggerBackend', False, '', '', False);
TestHasClassEntry(opts, 'TTestDebuggerBackendFoo', False, 'mixfoo', 'M-U2');
@ -820,6 +896,88 @@ begin
end;
end;
procedure TTestXmlOpts.TestLoadEnvNewUnknowActive;
var
opts: TTestDebuggerOptions;
xml: TXMLDocument;
begin
InitEnvOpts(ConfigEnvNewUnknowActive);
opts := InitDbgOpts(CONF_EMPTY);
TestEntryCnt(opts, 4, 2);
TestHasEntry(opts, 'abc1', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-1');
TestHasEntry(opts, 'abc2', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-2');
TestHasEntry(opts, 'abc3', 'TTestDebuggerBackendAbc', False, 'abc3.exe', 'U-3');
TestHasEntry(opts, 'foo1', 'TTestDebuggerBackendFoo', False, 'foo.exe', 'U-4');
TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', True, 'any.exe', 'U-5', False);
TestHasEntry(opts, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6', False);
xml := ParseXml(SaveDbgOpts(opts));
TestEntryCnt(xml, 6);
TestHasEntry(xml, 'abc1', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-1');
TestHasEntry(xml, 'abc2', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-2');
TestHasEntry(xml, 'abc3', 'TTestDebuggerBackendAbc', False, 'abc3.exe', 'U-3');
TestHasEntry(xml, 'foo1', 'TTestDebuggerBackendFoo', False, 'foo.exe', 'U-4');
TestHasEntry(xml, 'xxx0', 'TUnknownDebuggerBackend', True, 'any.exe', 'U-5');
TestHasEntry(xml, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6');
TestHasEntryWithoutProps(xml, 'abc1');
TestHasEntryProps(xml, 'abc2', 'AbcVal', '123');
TestHasEntryProps(xml, 'abc2', 'AbcProp', 'True');
TestHasEntryWithoutProps(xml, 'abc3');
TestHasEntryProps(xml, 'foo1', 'FooProp', '987');
TestHasEntryProps(xml, 'xxx0', 'SomeProp', '100');
TestHasEntryProps(xml, 'xxx0', 'SomeVal', 'False');
TestHasEntryProps(xml, 'xxx0', 'SomeTxt', '');
xml.Destroy;
opts.Free;
end;
procedure TTestXmlOpts.TestLoadEnvOldUnknowActive;
var
opts: TTestDebuggerOptions;
xml: TXMLDocument;
begin
InitEnvOpts(ConfigEnv1_8_UnknownActive);
opts := InitDbgOpts(CONF_EMPTY);
TestEntryCnt(opts, 3, 1);
TestHasEntry(opts, '', 'TTestDebuggerBackendBar', False, '');
TestHasEntry(opts, '', 'TTestDebuggerBackendAbc', False, '');
TestHasEntry(opts, '', 'TUnknownDebuggerBackend', True, 'C:\gdb.exe', '', False);
TestHasEntry(opts, '', 'TTestDebuggerBackendFoo', False, '');
xml := ParseXml(SaveDbgOpts(opts));
TestEntryCnt(xml, 4);
TestHasEntry(xml, '', 'TTestDebuggerBackendBar', False, '');
TestHasEntry(xml, '', 'TTestDebuggerBackendAbc', False, '');
TestHasEntry(xml, '', 'TUnknownDebuggerBackend', True, 'C:\gdb.exe');
TestHasEntry(xml, '', 'TTestDebuggerBackendFoo', False, '');
TestHasClassOnlyEntryWithoutProps(xml, 'TTestDebuggerBackendBar');
TestHasClassOnlyEntryProps(xml, 'TTestDebuggerBackendAbc', 'AbcVal', '123');
TestHasClassOnlyEntryProps(xml, 'TTestDebuggerBackendAbc', 'AbcProp', 'True');
TestHasClassOnlyEntryProps(xml, 'TTestDebuggerBackendFoo', 'FooProp', '987');
TestHasClassOnlyEntryProps(xml, 'TUnknownDebuggerBackend', 'SomeProp', '100');
TestHasClassOnlyEntryProps(xml, 'TUnknownDebuggerBackend', 'SomeVal', 'False');
TestHasClassOnlyEntryProps(xml, 'TUnknownDebuggerBackend', 'SomeTxt', '');
xml.Destroy;
opts.Free;
end;
procedure TTestXmlOpts.TestLoadFromDbg;
var
opts: TTestDebuggerOptions;
@ -834,7 +992,7 @@ begin
end;
opts := InitDbgOpts(ConfigDbgNewOne);
TestEntryCnt(opts, 1);
TestEntryCnt(opts, 1, 0);
TestHasEntry(opts, 'new', 'TTestDebuggerBackendAbc', True, 'new.exe', 'U-99');
xml := ParseXml(SaveDbgOpts(opts));
@ -861,20 +1019,21 @@ begin
2: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('abc2'));
3: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('abc3'));
4: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('foo1'));
5: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('xxx0'));
6: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('xxx1'));
5: opts.DebuggerPropertiesConfigList.Unloaded.Delete(opts.DebuggerPropertiesConfigList.Unloaded.IndexOf('xxx0'));
6: opts.DebuggerPropertiesConfigList.Unloaded.Delete(opts.DebuggerPropertiesConfigList.Unloaded.IndexOf('xxx1'));
7: opts.DebuggerPropertiesConfigList.Delete(opts.DebuggerPropertiesConfigList.IndexOf('zbar'));
end;
if i = 0 then TestEntryCnt(opts, 7)
else TestEntryCnt(opts, 6);
if i = 0 then TestEntryCnt(opts, 5, 2)
else if i in [5,6] then TestEntryCnt(opts, 5, 1)
else TestEntryCnt(opts, 4, 2);
if i <> 1 then TestHasEntry(opts, 'abc1', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-1');
if i <> 2 then TestHasEntry(opts, 'abc2', 'TTestDebuggerBackendAbc', False, 'abc.exe', 'U-2');
if i <> 3 then TestHasEntry(opts, 'abc3', 'TTestDebuggerBackendAbc', True, 'abc3.exe', 'U-3');
if i <> 4 then TestHasEntry(opts, 'foo1', 'TTestDebuggerBackendFoo', False, 'foo.exe', 'U-4');
if i <> 5 then TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5');
if i <> 6 then TestHasEntry(opts, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6');
if i <> 5 then TestHasEntry(opts, 'xxx0', 'TUnknownDebuggerBackend', False, 'any.exe', 'U-5', False);
if i <> 6 then TestHasEntry(opts, 'xxx1', 'TNotFoundDebuggerBackend', False, 'no.exe', 'U-6', False);
if i <> 7 then TestHasEntry(opts, 'zbar', 'TTestDebuggerBackendBar', False, 'bar.exe', 'U-7');
xml := ParseXml(SaveDbgOpts(opts));