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

Debugger: Run only current thread for watch function eval. Add option to run all threads.

Browse Source
This commit is contained in:
Martin 2022-09-11 15:16:18 +02:00
parent 8fd2e40aec
commit 069baa2497
8 changed files with 76 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -440,6 +440,7 @@ type
procedure ThreadHandleBreakPointInCallRoutine(AnAddress: TDBGPtr; out ACanContinue: Boolean);
procedure BeforeWatchEval(ACallContext: TFpDbgInfoCallContext); override;
procedure RunProcessLoop(OnlyCurrentThread: Boolean); override;
class function Caption: String; override;
class function NeedsExePath: boolean; override;
@ -4421,6 +4422,25 @@ begin
bplStepOut]);
end;
procedure TFpDebugDebugger.RunProcessLoop(OnlyCurrentThread: Boolean);
var
ct, t: TDbgThread;
begin
ct := FDbgController.CurrentThread;
if OnlyCurrentThread then
for t in FDbgController.CurrentProcess.ThreadMap do
if t <> ct then
t.IncSuspendCount;
FDbgController.ProcessLoop;
if OnlyCurrentThread then
for t in FDbgController.CurrentProcess.ThreadMap do
if (t <> ct) and (t.SuspendCount > 0) then // new threads will have count=0
t.DecSuspendCount;
end;
class function TFpDebugDebugger.Caption: String;
begin
Result:='FpDebug internal Dwarf-debugger';

5
components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas
View File

@ -65,6 +65,7 @@ type
function ReadAnsiStringFromTarget(AStringAddr: TDBGPtr; out AString: String): boolean;
procedure BeforeWatchEval(ACallContext: TFpDbgInfoCallContext); virtual; abstract;
procedure RunProcessLoop(OnlyCurrentThread: Boolean); virtual; abstract;
property DbgController: TDbgController read FDbgController;
property MemManager: TFpDbgMemManager read FMemManager;
@ -170,7 +171,7 @@ begin
CallContext.AddOrdinalViaRefAsParam(AStringDataAddr);
CallContext.FinalizeParams;
BeforeWatchEval(CallContext);
DbgController.ProcessLoop;
RunProcessLoop(True);
finally
DbgController.AbortCurrentCommand;
CallContext.ReleaseReference;
@ -203,7 +204,7 @@ begin
exit;
CallContext.FinalizeParams;
BeforeWatchEval(CallContext);
DbgController.ProcessLoop;
RunProcessLoop(True);
if not CallContext.IsValid then
exit;

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

@ -229,7 +229,7 @@ type
TFpThreadWorkerEvaluate = class(TFpDbgDebggerThreadWorkerLinkedItem)
private
FAllowFunctions: Boolean;
FAllowFunctions, FAllowFunctionsAllThread: Boolean;
FExpressionScope: TFpDbgSymbolScope;
function DoWatchFunctionCall(AnExpressionPart: TFpPascalExpressionPart;
@ -1040,7 +1040,7 @@ begin
end;
FDebugger.BeforeWatchEval(CallContext);
FDebugger.DbgController.ProcessLoop;
FDebugger.RunProcessLoop(not FAllowFunctionsAllThread);
if not CallContext.IsValid then begin
DebugLn(['Error in call ',CallContext.Message]);
@ -1278,8 +1278,8 @@ begin
FDispFormat := ADispFormat;
FRepeatCnt := ARepeatCnt;
FEvalFlags := AnEvalFlags;
if (defAllowFunctionCall in AnEvalFlags) then
FAllowFunctions := True;
FAllowFunctions := defAllowFunctionCall in AnEvalFlags;
FAllowFunctionsAllThread := defFunctionCallRunAllThreads in AnEvalFlags;
FRes := False;
end;

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

@ -84,6 +84,7 @@ type
TWatcheEvaluateFlag =
( defClassAutoCast, // Find real class of instance, and use, instead of declared class of variable
defAllowFunctionCall, //
defFunctionCallRunAllThreads, //
defExtraDepth, // Evaluate 1 extra level of sub-elements => i.e., evaluate each nested sub-item
defSkipValConv,
// deprecated

1
debugger/debuggerstrconst.pp
View File

@ -80,6 +80,7 @@ resourcestring
dlgBackendConvOptDefault = '- Default -';
dlgBackendConvOptDisabled = '- Disabled -';
drsSuspend = 'Suspend';
drsRunAllThreadsWhileEvaluat = 'Run all threads while evaluating';
implementation

40
debugger/watchpropertydlg.lfm
View File

@ -14,8 +14,8 @@ object WatchPropertyDlg: TWatchPropertyDlg
LCLVersion = '2.3.0.0'
object rgStyle: TRadioGroup
Left = 6
Height = 90
Top = 153
Height = 71
Top = 172
Width = 416
Align = alClient
AutoFill = True
@ -31,7 +31,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 70
ClientHeight = 51
ClientWidth = 412
Columns = 3
ItemIndex = 7
@ -71,16 +71,15 @@ object WatchPropertyDlg: TWatchPropertyDlg
end
object PanelTop: TPanel
Left = 0
Height = 153
Height = 172
Top = 0
Width = 428
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 153
ClientHeight = 172
ClientWidth = 428
TabOrder = 0
OnClick = PanelTopClick
object lblExpression: TLabel
AnchorSideLeft.Control = PanelTop
AnchorSideTop.Control = txtExpression
@ -166,19 +165,19 @@ object WatchPropertyDlg: TWatchPropertyDlg
ParentColor = False
end
object chkEnabled: TCheckBox
AnchorSideLeft.Control = lblExpression
AnchorSideTop.Control = txtRepCount
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 61
Width = 60
BorderSpacing.Left = 6
BorderSpacing.Top = 3
Caption = 'Enabled'
TabOrder = 3
end
object chkAllowFunc: TCheckBox
AnchorSideLeft.Control = chkEnabled
AnchorSideLeft.Control = lblExpression
AnchorSideTop.Control = chkEnabled
AnchorSideTop.Side = asrBottom
Left = 6
@ -186,15 +185,16 @@ object WatchPropertyDlg: TWatchPropertyDlg
Top = 80
Width = 126
Caption = 'Allow Function Calls'
OnChange = chkAllowFuncChange
TabOrder = 4
end
object chkUseInstanceClass: TCheckBox
AnchorSideLeft.Control = chkEnabled
AnchorSideTop.Control = chkAllowFunc
AnchorSideLeft.Control = lblExpression
AnchorSideTop.Control = chkAllowFuncThreads
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 99
Top = 118
Width = 127
BorderSpacing.Bottom = 6
Caption = 'chkUseInstanceClass'
@ -207,7 +207,7 @@ object WatchPropertyDlg: TWatchPropertyDlg
AnchorSideTop.Side = asrBottom
Left = 88
Height = 23
Top = 124
Top = 143
Width = 160
BorderSpacing.Left = 6
BorderSpacing.Bottom = 6
@ -216,14 +216,26 @@ object WatchPropertyDlg: TWatchPropertyDlg
TabOrder = 6
end
object lblFpDbgConv: TLabel
AnchorSideLeft.Control = chkEnabled
AnchorSideLeft.Control = lblExpression
AnchorSideTop.Control = dropFpDbgConv
AnchorSideTop.Side = asrCenter
Left = 6
Height = 15
Top = 128
Top = 147
Width = 76
Caption = 'lblFpDbgConv'
end
object chkAllowFuncThreads: TCheckBox
AnchorSideLeft.Control = lblExpression
AnchorSideTop.Control = chkAllowFunc
AnchorSideTop.Side = asrBottom
Left = 26
Height = 19
Top = 99
Width = 134
BorderSpacing.Left = 20
Caption = 'chkAllowFuncThreads'
TabOrder = 7
end
end
end

16
debugger/watchpropertydlg.pp
View File

@ -51,6 +51,7 @@ type
TWatchPropertyDlg = class(TForm)
ButtonPanel: TButtonPanel;
chkAllowFunc: TCheckBox;
chkAllowFuncThreads: TCheckBox;
chkEnabled: TCheckBox;
chkUseInstanceClass: TCheckBox;
dropFpDbgConv: TComboBox;
@ -65,7 +66,7 @@ type
txtRepCount: TEdit;
procedure btnHelpClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure PanelTopClick(Sender: TObject);
procedure chkAllowFuncChange(Sender: TObject);
procedure txtExpressionChange(Sender: TObject);
private
FWatch: TIdeWatch;
@ -110,6 +111,8 @@ begin
then FWatch.EvaluateFlags := FWatch.EvaluateFlags + [defClassAutoCast];
if chkAllowFunc.Checked
then FWatch.EvaluateFlags := FWatch.EvaluateFlags + [defAllowFunctionCall];
if chkAllowFuncThreads.Checked
then FWatch.EvaluateFlags := FWatch.EvaluateFlags + [defFunctionCallRunAllThreads];
FWatch.RepeatCount := StrToIntDef(txtRepCount.Text, 0);
if dropFpDbgConv.ItemIndex = 0 then
@ -128,9 +131,11 @@ begin
end;
end;
procedure TWatchPropertyDlg.PanelTopClick(Sender: TObject);
procedure TWatchPropertyDlg.chkAllowFuncChange(Sender: TObject);
begin
chkAllowFuncThreads.Enabled := EnvironmentOptions.DebuggerAllowFunctionCalls and
(dfEvalFunctionCalls in DebugBoss.DebuggerClass.SupportedFeatures) and
(chkAllowFunc.Checked);
end;
procedure TWatchPropertyDlg.txtExpressionChange(Sender: TObject);
@ -173,6 +178,7 @@ begin
rgStyle.ItemIndex := DispFormatToStyle[FWatch.DisplayFormat];
chkUseInstanceClass.Checked := defClassAutoCast in FWatch.EvaluateFlags;
chkAllowFunc.Checked := defAllowFunctionCall in FWatch.EvaluateFlags;
chkAllowFuncThreads.Checked := defFunctionCallRunAllThreads in FWatch.EvaluateFlags;
txtRepCount.Text := IntToStr(FWatch.RepeatCount);
end;
txtExpressionChange(nil);
@ -181,6 +187,9 @@ begin
txtDigits.Enabled := False;
chkAllowFunc.Enabled := EnvironmentOptions.DebuggerAllowFunctionCalls and
(dfEvalFunctionCalls in DebugBoss.DebuggerClass.SupportedFeatures);
chkAllowFuncThreads.Enabled := EnvironmentOptions.DebuggerAllowFunctionCalls and
(dfEvalFunctionCalls in DebugBoss.DebuggerClass.SupportedFeatures) and
(chkAllowFunc.Checked);
Caption:= lisWatchPropert;
lblExpression.Caption:= lisExpression;
@ -188,6 +197,7 @@ begin
lblDigits.Caption:= lisDigits;
chkEnabled.Caption:= lisEnabled;
chkAllowFunc.Caption:= lisAllowFunctio;
chkAllowFuncThreads.Caption := drsRunAllThreadsWhileEvaluat;
chkUseInstanceClass.Caption := drsUseInstanceClassType;
rgStyle.Caption:= lisStyle;
rgStyle.Items[0]:= lisCharacter;

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

@ -6568,6 +6568,9 @@ begin
if AConfig.GetValue(APath + 'AllowFunctionCall', False)
then Include(FEvaluateFlags, defAllowFunctionCall)
else Exclude(FEvaluateFlags, defAllowFunctionCall);
if AConfig.GetValue(APath + 'AllowFunctionThreads', False)
then Include(FEvaluateFlags, defFunctionCallRunAllThreads)
else Exclude(FEvaluateFlags, defFunctionCallRunAllThreads);
try ReadStr(AConfig.GetValue(APath + 'DisplayFormat', 'wdfDefault'), FDisplayFormat);
except FDisplayFormat := wdfDefault; end;
FRepeatCount := AConfig.GetValue(APath + 'RepeatCount', 0);
@ -6593,6 +6596,7 @@ begin
AConfig.SetDeleteValue(APath + 'DisplayFormat', s, 'wdfDefault');
AConfig.SetDeleteValue(APath + 'ClassAutoCast', defClassAutoCast in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'AllowFunctionCall', defAllowFunctionCall in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'AllowFunctionThreads', defFunctionCallRunAllThreads in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'RepeatCount', FRepeatCount, 0);
AConfig.SetDeleteValue(APath + 'SkipFpDbgConv', defSkipValConv in FEvaluateFlags, False);
@ -6715,6 +6719,9 @@ begin
if AConfig.GetValue(APath + 'AllowFunctionCall', False)
then Include(FEvaluateFlags, defAllowFunctionCall)
else Exclude(FEvaluateFlags, defAllowFunctionCall);
if AConfig.GetValue(APath + 'AllowFunctionThreads', False)
then Include(FEvaluateFlags, defFunctionCallRunAllThreads)
else Exclude(FEvaluateFlags, defFunctionCallRunAllThreads);
i := StringCase
(AConfig.GetValue(APath + 'DisplayStyle/Value', TWatchDisplayFormatNames[wdfDefault]),
TWatchDisplayFormatNames);
@ -6740,6 +6747,7 @@ begin
TWatchDisplayFormatNames[DisplayFormat], TWatchDisplayFormatNames[wdfDefault]);
AConfig.SetDeleteValue(APath + 'ClassAutoCast', defClassAutoCast in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'AllowFunctionCall', defAllowFunctionCall in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'AllowFunctionThreads', defFunctionCallRunAllThreads in FEvaluateFlags, False);
AConfig.SetDeleteValue(APath + 'RepeatCount', FRepeatCount, 0);
AConfig.SetDeleteValue(APath + 'SkipFpDbgConv', defSkipValConv in FEvaluateFlags, False);