Debugger: Evaluate Window, use Watch object to retrieve value via new API. Enables FpDebug-value-converter

debugger/debuggerstrconst.pp

@@ -73,6 +73,7 @@ resourcestring
   drsEvalHistoryNone      = 'No history kept';
   dsrEvalHistoryUp        = 'Insert result at top of history';
   dsrEvalHistoryDown      = 'Append result at bottom of history';
+  dsrEvalUseFpDebugConverter = 'Use FpDebug Converter';
 
   drsUseInstanceClassType = 'Use Instance class type';
   drsLen = 'Len=%d: ';

debugger/evaluatedlg.lfm

@@ -1,4 +1,4 @@
-inherited EvaluateDlg: TEvaluateDlg
+object EvaluateDlg: TEvaluateDlg
   Left = 470
   Height = 290
   Top = 393
@@ -14,49 +14,53 @@ inherited EvaluateDlg: TEvaluateDlg
   OnClose = FormClose
   OnCreate = FormCreate
   OnKeyDown = FormKeyDown
-  object Label1: TLabel[0]
+  LCLVersion = '2.3.0.0'
+  object Label1: TLabel
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = ToolBar1
     AnchorSideTop.Side = asrBottom
     Left = 6
-    Height = 14
+    Height = 15
     Top = 47
-    Width = 57
+    Width = 59
     BorderSpacing.Left = 6
     BorderSpacing.Top = 3
     Caption = '&Expression:'
+    Color = clDefault
     FocusControl = cmbExpression
     ParentColor = False
   end
-  object Label2: TLabel[1]
+  object Label2: TLabel
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = cmbExpression
     AnchorSideTop.Side = asrBottom
     Left = 6
-    Height = 14
-    Top = 91
+    Height = 15
+    Top = 94
     Width = 35
     BorderSpacing.Left = 6
     BorderSpacing.Top = 6
     Caption = '&Result:'
+    Color = clDefault
     FocusControl = txtResult
     ParentColor = False
   end
-  object lblNewValue: TLabel[2]
+  object lblNewValue: TLabel
     AnchorSideLeft.Control = Owner
     AnchorSideBottom.Control = cmbNewValue
     Left = 6
-    Height = 14
-    Top = 246
-    Width = 55
+    Height = 15
+    Top = 243
+    Width = 58
     Anchors = [akLeft, akBottom]
     BorderSpacing.Left = 6
     BorderSpacing.Bottom = 3
     Caption = '&New value:'
+    Color = clDefault
     FocusControl = cmbNewValue
     ParentColor = False
   end
-  object ToolBar1: TToolBar[3]
+  object ToolBar1: TToolBar
     Left = 0
     Height = 44
     Top = 0
@@ -71,7 +75,7 @@ inherited EvaluateDlg: TEvaluateDlg
     TabOrder = 0
     TabStop = True
     object tbInspect: TToolButton
-      Left = 152
+      Left = 154
       Top = 2
       Caption = '&Inspect'
       Enabled = False
@@ -79,7 +83,7 @@ inherited EvaluateDlg: TEvaluateDlg
       OnClick = tbInspectClick
     end
     object tbWatch: TToolButton
-      Left = 102
+      Left = 104
       Top = 2
       AllowAllUp = True
       Caption = '&Watch'
@@ -88,7 +92,7 @@ inherited EvaluateDlg: TEvaluateDlg
       OnClick = tbWatchClick
     end
     object tbModify: TToolButton
-      Left = 52
+      Left = 54
       Top = 2
       Caption = '&Modify'
       Enabled = False
@@ -104,9 +108,9 @@ inherited EvaluateDlg: TEvaluateDlg
       OnClick = tbEvaluateClick
     end
     object ToolButton1: TToolButton
-      Left = 202
+      Left = 204
+      Height = 40
       Top = 2
-      Width = 10
       Caption = 'ToolButton1'
       Style = tbsSeparator
     end
@@ -118,28 +122,28 @@ inherited EvaluateDlg: TEvaluateDlg
       Style = tbsDropDown
     end
   end
-  object cmbExpression: TComboBox[4]
+  object cmbExpression: TComboBox
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = Label1
     AnchorSideTop.Side = asrBottom
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
     Left = 6
-    Height = 21
-    Top = 64
+    Height = 23
+    Top = 65
     Width = 388
     Anchors = [akTop, akLeft, akRight]
     BorderSpacing.Left = 6
     BorderSpacing.Top = 3
     BorderSpacing.Right = 6
-    ItemHeight = 13
+    ItemHeight = 15
     OnChange = cmbExpressionChange
     OnKeyDown = cmbExpressionKeyDown
     OnKeyUp = cmbExpressionKeyUp
     OnSelect = cmbExpressionSelect
     TabOrder = 2
   end
-  object txtResult: TMemo[5]
+  object txtResult: TMemo
     AnchorSideLeft.Control = Owner
     AnchorSideTop.Control = Label2
     AnchorSideTop.Side = asrBottom
@@ -147,8 +151,8 @@ inherited EvaluateDlg: TEvaluateDlg
     AnchorSideRight.Side = asrBottom
     AnchorSideBottom.Control = lblNewValue
     Left = 6
-    Height = 132
-    Top = 108
+    Height = 125
+    Top = 112
     Width = 388
     Anchors = [akTop, akLeft, akRight, akBottom]
     BorderSpacing.Left = 6
@@ -158,33 +162,32 @@ inherited EvaluateDlg: TEvaluateDlg
     ScrollBars = ssAutoVertical
     TabOrder = 3
   end
-  object cmbNewValue: TComboBox[6]
+  object cmbNewValue: TComboBox
     AnchorSideLeft.Control = Owner
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
     AnchorSideBottom.Control = Owner
     AnchorSideBottom.Side = asrBottom
     Left = 6
-    Height = 21
-    Top = 263
+    Height = 23
+    Top = 261
     Width = 388
     Anchors = [akLeft, akRight, akBottom]
     BorderSpacing.Left = 6
     BorderSpacing.Right = 6
     BorderSpacing.Bottom = 6
-    ItemHeight = 13
+    ItemHeight = 15
     OnKeyDown = cmbNewValueKeyDown
     TabOrder = 4
   end
-  object chkTypeCast: TCheckBox[7]
+  object chkTypeCast: TCheckBox
     AnchorSideTop.Control = Label1
     AnchorSideTop.Side = asrCenter
-    AnchorSideRight.Control = Owner
-    AnchorSideRight.Side = asrBottom
-    Left = 312
-    Height = 17
-    Top = 46
-    Width = 82
+    AnchorSideRight.Control = chkFpDbgConv
+    Left = 203
+    Height = 19
+    Top = 45
+    Width = 85
     Anchors = [akTop, akRight]
     BorderSpacing.Right = 6
     Caption = 'chkTypeCast'
@@ -192,9 +195,25 @@ inherited EvaluateDlg: TEvaluateDlg
     State = cbChecked
     TabOrder = 1
   end
-  object mnuHistory: TPopupMenu[8]
-    left = 72
-    top = 136
+  object chkFpDbgConv: TCheckBox
+    AnchorSideTop.Control = Label1
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 294
+    Height = 19
+    Top = 45
+    Width = 100
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 6
+    Caption = 'chkFpDbgConv'
+    Checked = True
+    State = cbChecked
+    TabOrder = 5
+  end
+  object mnuHistory: TPopupMenu
+    Left = 72
+    Top = 136
     object MenuItem1: TMenuItem
       Caption = 'None'
       OnClick = MenuItem1Click

debugger/evaluatedlg.pp

@@ -43,10 +43,11 @@ uses
   // IdeIntf
   IDEWindowIntf, IDEImagesIntf,
   // DebuggerIntf
-  DbgIntfDebuggerBase, LazDebuggerIntf,
+  DbgIntfDebuggerBase, LazClasses, LazDebuggerIntf, LazDebuggerIntfBaseTypes,
   // IDE
-  LazarusIDEStrConsts, BaseDebugManager, InputHistory, IDEProcs,
-  Debugger, DebuggerDlg, DebuggerStrConst, EnvironmentOpts;
+  LazarusIDEStrConsts, BaseDebugManager, InputHistory, IDEProcs, Debugger,
+  IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, DebuggerDlg,
+  DebuggerStrConst, EnvironmentOpts;
 
 type
 
@@ -57,6 +58,7 @@ type
 
   TEvaluateDlg = class(TDebuggerDlg)
     chkTypeCast: TCheckBox;
+    chkFpDbgConv: TCheckBox;
     cmbExpression: TComboBox;
     cmbNewValue: TComboBox;
     Label1: TLabel;
@@ -98,14 +100,18 @@ type
   private
     fSkipKeySelect: Boolean;
     fHistDirection:TEvalHistDirection;
-    procedure EvaluateCallback(Sender: TObject; ASuccess: Boolean;
-      ResultText: String; ResultDBGType: TDBGType);
+    FWatchPrinter: TWatchResultPrinter;
+    FInspectWatches: TCurrentWatches;
+    FCurrentWatchValue: TCurrentWatchValue;
+
+    procedure DoWatchValidityChanged(Sender: TObject);
     function GetFindText: string;
     procedure SetFindText(const NewFindText: string);
     procedure Evaluate;
     procedure Modify;
   public
     constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
     procedure Execute(const AExpression: String);
     property FindText: string read GetFindText write SetFindText;
     procedure UpdateData;
@@ -128,6 +134,13 @@ constructor TEvaluateDlg.Create(TheOwner:TComponent);
 begin
   inherited Create(TheOwner);
 
+  ThreadsMonitor := DebugBoss.Threads;
+  CallStackMonitor := DebugBoss.CallStack;
+  WatchesMonitor := DebugBoss.Watches;
+
+  FWatchPrinter := TWatchResultPrinter.Create;
+  FInspectWatches := TCurrentWatches.Create(WatchesMonitor);
+
   fSkipKeySelect := False;
   Caption := lisKMEvaluateModify;
   cmbExpression.Items.Assign(InputHistories.HistoryLists.
@@ -143,6 +156,7 @@ begin
   Label2.Caption := lisDBGEMResult;
   lblNewValue.Caption := lisDBGEMNewValue;
   chkTypeCast.Caption := drsUseInstanceClassType;
+  chkFpDbgConv.Caption := dsrEvalUseFpDebugConverter;
   fHistDirection:=EHDNone;
 
   ToolBar1.Images := IDEImages.Images_16;
@@ -157,6 +171,15 @@ begin
   mnuHistory.Items[2].Caption:=dsrEvalHistoryDown;
 end;
 
+destructor TEvaluateDlg.Destroy;
+begin
+  ReleaseRefAndNil(FCurrentWatchValue);
+  FreeAndNil(FWatchPrinter);
+
+  inherited Destroy;
+  FreeAndNil(FInspectWatches);
+end;
+
 procedure TEvaluateDlg.Execute(const AExpression: String);
 begin
   SetFindText(AExpression);
@@ -170,41 +193,62 @@ end;
 
 procedure TEvaluateDlg.UpdateData;
 begin
+  ReleaseRefAndNil(FCurrentWatchValue);
+  FInspectWatches.Clear;
   Evaluate;
 end;
 
-procedure TEvaluateDlg.EvaluateCallback(Sender: TObject; ASuccess: Boolean;
-  ResultText: String; ResultDBGType: TDBGType);
+procedure TEvaluateDlg.DoWatchValidityChanged(Sender: TObject);
 var
-  S: TCaption;
+  expr: TCaption;
+  ResultText: String;
 begin
-  S := cmbExpression.Text;
+  if (FCurrentWatchValue = nil ) then begin
+    txtResult.Clear;
+    exit;
+  end;
 
-  if ASuccess then begin
-    if cmbExpression.Items.IndexOf(S) = -1
-    then cmbExpression.Items.Insert(0, S);
-    tbModify.Enabled := True;
+  if DebugBoss.State <> dsPause then
+    exit;
+  if not (FCurrentWatchValue.Validity in [ddsValid, ddsError, ddsInvalid]) then
+    exit;
 
-    if (ResultDBGType <> nil) and (ResultDBGType.Attributes * [saArray, saDynArray] <> []) and (ResultDBGType.Len >= 0)
-    then ResultText := Format(drsLen, [ResultDBGType.Len]) + LineEnding + ResultText;
+  expr := cmbExpression.Text;
+  ResultText := '';
 
+  if cmbExpression.Items.IndexOf(expr) = -1 then
+    cmbExpression.Items.Insert(0, expr);
+
+  if FCurrentWatchValue.Validity = ddsValid then begin
+    ResultText := FWatchPrinter.PrintWatchValue(FCurrentWatchValue.ResultData, wdfStructure);
+    if (FCurrentWatchValue.ResultData <> nil) and
+       (FCurrentWatchValue.ResultData.ValueKind = rdkArray) and (FCurrentWatchValue.ResultData.ArrayLength > 0)
+    then
+      ResultText := Format(drsLen, [FCurrentWatchValue.ResultData.ArrayLength]) + ResultText
+    else
+    if (FCurrentWatchValue.TypeInfo <> nil) and
+       (FCurrentWatchValue.TypeInfo.Attributes * [saArray, saDynArray] <> []) and
+       (FCurrentWatchValue.TypeInfo.Len >= 0)
+    then
+      ResultText := Format(drsLen, [FCurrentWatchValue.TypeInfo.Len]) + ResultText;
   end
   else
-    tbModify.Enabled := False;
+    ResultText := FCurrentWatchValue.Value;
+
+  tbModify.Enabled := FCurrentWatchValue.Validity = ddsValid;
 
-  FreeAndNil(ResultDBGType);
   if fHistDirection<>EHDNone then
     begin
     if txtResult.Lines.Text='' then
-      txtResult.Lines.Text := RESULTEVAL+ S+':'+LineEnding+ ResultText + LineEnding
+      txtResult.Lines.Text := RESULTEVAL+ expr+':'+LineEnding+ ResultText + LineEnding
     else
       if fHistDirection=EHDUp then
-        txtResult.Lines.Text := RESULTEVAL+ S+':'+LineEnding+ ResultText + LineEnding
+        txtResult.Lines.Text := RESULTEVAL+ expr+':'+LineEnding+ ResultText + LineEnding
            + RESULTSEPARATOR + LineEnding + txtResult.Lines.Text
       else
         begin
         txtResult.Lines.Text := txtResult.Lines.Text + RESULTSEPARATOR + LineEnding
-           + RESULTEVAL+ S+':'+LineEnding+ ResultText+LineEnding;
+           + RESULTEVAL+ expr+':'+LineEnding+ ResultText+LineEnding;
         txtResult.SelStart:=length(txtResult.Lines.Text);
         end;
     end
@@ -214,18 +258,62 @@ end;
 
 procedure TEvaluateDlg.Evaluate;
 var
-  S: String;
+  expr: String;
   Opts: TWatcheEvaluateFlags;
+  tid, idx: Integer;
+  stack: TIdeCallStack;
+  AWatch: TCurrentWatch;
 begin
-  S := cmbExpression.Text;
-  if S = '' then Exit;
-  InputHistories.HistoryLists.Add(ClassName, S,rltCaseSensitive);
-  Opts := [];
+  if DebugBoss.State <> dsPause then
+    exit;
+
+  expr := trim(cmbExpression.Text);
+  if expr = '' then Exit;
+  InputHistories.HistoryLists.Add(ClassName, expr,rltCaseSensitive);
+  Opts := [defExtraDepth];
   if chkTypeCast.Checked then
-    Opts := [defClassAutoCast];
-  if not DebugBoss.Evaluate(S, @EvaluateCallback, Opts)
-  then
-    EvaluateCallback(nil, false, '', nil);
+    Opts := Opts + [defClassAutoCast];
+  if not chkFpDbgConv.Checked then
+    Opts := Opts + [defSkipValConv];
+
+  tid    := ThreadsMonitor.CurrentThreads.CurrentThreadId;
+  stack  := CallStackMonitor.CurrentCallStackList.EntriesForThreads[tid];
+  idx := 0;
+  if stack <> nil then
+    idx := stack.CurrentIndex;
+
+  if (FCurrentWatchValue <> nil) and
+     (FCurrentWatchValue.Validity in [ddsEvaluating, ddsRequested]) and
+     (FCurrentWatchValue.Expression = expr) and
+     (FCurrentWatchValue.EvaluateFlags = Opts) and
+     (FCurrentWatchValue.ThreadId = tid) and
+     (FCurrentWatchValue.StackFrame = idx)
+  then begin
+    FCurrentWatchValue.Value;
+    DoWatchValidityChanged(FCurrentWatchValue);
+    exit;
+  end;
+
+  ReleaseRefAndNil(FCurrentWatchValue);
+
+  FInspectWatches.Clear;
+  FInspectWatches.BeginUpdate;
+  AWatch := FInspectWatches.Find(expr);
+  if AWatch = nil then begin
+    FInspectWatches.Clear;
+    AWatch := FInspectWatches.Add(expr);
+  end;
+  AWatch.EvaluateFlags := Opts;
+  AWatch.Enabled := True;
+  FInspectWatches.EndUpdate;
+
+  FCurrentWatchValue := AWatch.Values[tid, idx] as TCurrentWatchValue;
+  if FCurrentWatchValue <> nil then begin
+    FCurrentWatchValue.OnValidityChanged := @DoWatchValidityChanged;
+    FCurrentWatchValue.AddReference;
+    FCurrentWatchValue.Value;
+    DoWatchValidityChanged(FCurrentWatchValue);
+  end;
 end;
 
 procedure TEvaluateDlg.cmbExpressionChange(Sender: TObject);
@@ -350,7 +438,7 @@ begin
   if (Key = VK_ESCAPE) and not Docked then
     Close
   else
-    inherited;;
+    inherited;
 end;
 
 procedure TEvaluateDlg.tbEvaluateClick(Sender: TObject);