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

Debugger-tests: speed up internal logging (needed on windows).

Browse Source 
git-svn-id: trunk@60133 -
This commit is contained in:
martin 2019-01-21 16:58:38 +00:00
parent 54a8e6dadc
commit 52cadc4bb3
2 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/lazdebuggers/lazdebugtestbase/testdbgcontrolform.lfm
View File

@ -29,6 +29,7 @@ object DbgTestControlForm: TDbgTestControlForm
Top = 1 Top = 1
Width = 76 Width = 76
Caption = 'Write Logs' Caption = 'Write Logs'
OnChange = CheckWriteLogsChange
TabOrder = 0 TabOrder = 0
end end
object Label1: TLabel object Label1: TLabel
@ -53,6 +54,7 @@ object DbgTestControlForm: TDbgTestControlForm
BorderSpacing.Left = 10 BorderSpacing.Left = 10
Caption = 'Write Logs On Error' Caption = 'Write Logs On Error'
Checked = True Checked = True
OnChange = CheckWriteLogsChange
State = cbChecked State = cbChecked
TabOrder = 1 TabOrder = 1
end end

16
components/lazdebuggers/lazdebugtestbase/testdbgcontrolform.pas
View File

@ -48,10 +48,12 @@ type
procedure btnGdbNoneClick(Sender: TObject); procedure btnGdbNoneClick(Sender: TObject);
procedure btnTestAllClick(Sender: TObject); procedure btnTestAllClick(Sender: TObject);
procedure btnTestNoneClick(Sender: TObject); procedure btnTestNoneClick(Sender: TObject);
procedure CheckWriteLogsChange(Sender: TObject);
procedure chkTestsMouseDown(Sender: TObject; Button: TMouseButton; procedure chkTestsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
private private
FWriteLogValCache: TWriteLogConfig;
FWriteLogIsCached: Boolean;
public public
procedure DbgShow(Data: PtrInt); procedure DbgShow(Data: PtrInt);
end; end;
@ -145,11 +147,18 @@ end;
function GetWriteLog: TWriteLogConfig; function GetWriteLog: TWriteLogConfig;
begin begin
if DbgTestControlForm.FWriteLogIsCached then begin
Result := DbgTestControlForm.FWriteLogValCache;
exit;
end;
Result := wlNever; Result := wlNever;
if DbgTestControlForm.WriteLogsOnErr.Checked then if DbgTestControlForm.WriteLogsOnErr.Checked then
Result := wlOnError; Result := wlOnError;
if DbgTestControlForm.CheckWriteLogs.Checked then if DbgTestControlForm.CheckWriteLogs.Checked then
Result := wlAlways; Result := wlAlways;
DbgTestControlForm.FWriteLogValCache := Result;
DbgTestControlForm.FWriteLogIsCached := True;
end; end;
procedure RegisterCompiler(name: string); procedure RegisterCompiler(name: string);
@ -243,6 +252,11 @@ begin
DbgTestControlForm.chkTests.Items[i].StateIndex := ord(tsUnChecked); DbgTestControlForm.chkTests.Items[i].StateIndex := ord(tsUnChecked);
end; end;
procedure TDbgTestControlForm.CheckWriteLogsChange(Sender: TObject);
begin
FWriteLogIsCached := False;
end;
procedure TDbgTestControlForm.DbgShow(Data: PtrInt); procedure TDbgTestControlForm.DbgShow(Data: PtrInt);
var var
s: TSymbolType; s: TSymbolType;