paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-25 16:09:17 +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
Width = 76
Caption = 'Write Logs'
OnChange = CheckWriteLogsChange
TabOrder = 0
end
object Label1: TLabel
@ -53,6 +54,7 @@ object DbgTestControlForm: TDbgTestControlForm
BorderSpacing.Left = 10
Caption = 'Write Logs On Error'
Checked = True
OnChange = CheckWriteLogsChange
State = cbChecked
TabOrder = 1
end

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

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