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

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -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';

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerbase.pas

@@ -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;

components/lazdebuggers/lazdebuggerfp/fpdebugdebuggerworkthreads.pas

@@ -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 := defAllowFunctionCall in AnEvalFlags;
-    FAllowFunctions := True;
+  FAllowFunctionsAllThread := defFunctionCallRunAllThreads in AnEvalFlags;
   FRes := False;
 end;
 

components/lazdebuggers/lazdebuggerintf/lazdebuggerintf.pas

@@ -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

debugger/debuggerstrconst.pp

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

debugger/watchpropertydlg.lfm

@@ -14,8 +14,8 @@ object WatchPropertyDlg: TWatchPropertyDlg
   LCLVersion = '2.3.0.0'
   object rgStyle: TRadioGroup
     Left = 6
-    Height = 90
+    Height = 71
-    Top = 153
+    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
+      AnchorSideLeft.Control = lblExpression
-      AnchorSideTop.Control = chkAllowFunc
+      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

debugger/watchpropertydlg.pp

@@ -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;

ide/packages/idedebugger/debugger.pp

@@ -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);