debugger: start breakpoint log call stack feature

git-svn-id: trunk@30689 -

debugger/breakpointsdlg.pp

@@ -174,7 +174,7 @@ end;
 function GetBreakPointActionsDescription(ABreakpoint: TBaseBreakpoint): string;
 const
   DEBUG_ACTION: array[TIDEBreakPointAction] of ShortString =
-    (lisBreak, lisEnableGroup, lisDisableGroup, lisLogMessage);
+    (lisBreak, lisEnableGroup, lisDisableGroup, lisLogMessage, lisLogCallStack);
 var
   CurBreakPoint: TIDEBreakPoint;
   Action: TIDEBreakPointAction;

debugger/breakpropertydlg.lfm

@@ -1,7 +1,7 @@
 inherited BreakPropertyDlg: TBreakPropertyDlg
-  Left = 249
+  Left = 620
-  Height = 398
+  Height = 424
-  Top = 187
+  Top = 132
   Width = 450
   HorzScrollBar.Page = 386
   VertScrollBar.Page = 366
@@ -11,7 +11,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
   BorderIcons = [biSystemMenu]
   BorderStyle = bsDialog
   Caption = 'Breakpoint Properties'
-  ClientHeight = 398
+  ClientHeight = 424
   ClientWidth = 450
   Constraints.MinWidth = 450
   Position = poScreenCenter
@@ -180,14 +180,14 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
     AnchorSideRight.Control = Owner
     AnchorSideRight.Side = asrBottom
     Left = 6
-    Height = 165
+    Height = 194
     Top = 180
     Width = 438
     Anchors = [akTop, akLeft, akRight]
     AutoSize = True
     BorderSpacing.Around = 6
     Caption = 'Actions'
-    ClientHeight = 147
+    ClientHeight = 176
     ClientWidth = 434
     TabOrder = 4
     object chkActionBreak: TCheckBox
@@ -225,7 +225,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       BorderSpacing.Left = 6
       BorderSpacing.Right = 6
       Caption = 'Disable groups'
-      TabOrder = 2
+      TabOrder = 3
     end
     object edtEnableGroups: TEditButton
       AnchorSideLeft.Control = chkEvalExpression
@@ -246,7 +246,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       Enabled = False
       MaxLength = 0
       NumGlyphs = 1
-      TabOrder = 5
+      TabOrder = 2
     end
     object edtDisableGroups: TEditButton
       AnchorSideLeft.Control = chkEvalExpression
@@ -267,7 +267,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       Enabled = False
       MaxLength = 0
       NumGlyphs = 1
-      TabOrder = 6
+      TabOrder = 4
     end
     object chkEvalExpression: TCheckBox
       AnchorSideLeft.Control = gbActions
@@ -281,7 +281,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       BorderSpacing.Right = 6
       Caption = 'Eval expression'
       Enabled = False
-      TabOrder = 3
+      TabOrder = 5
     end
     object chkLogMessage: TCheckBox
       AnchorSideLeft.Control = gbActions
@@ -295,7 +295,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       BorderSpacing.Right = 6
       Caption = 'Log message'
       OnChange = chkLogMessageChange
-      TabOrder = 4
+      TabOrder = 7
     end
     object edtEvalExpression: TEdit
       AnchorSideLeft.Control = chkEvalExpression
@@ -314,7 +314,7 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       BorderSpacing.Right = 6
       BorderSpacing.Bottom = 6
       Enabled = False
-      TabOrder = 7
+      TabOrder = 6
     end
     object edtLogMessage: TEdit
       AnchorSideLeft.Control = chkEvalExpression
@@ -335,13 +335,55 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
       Enabled = False
       TabOrder = 8
     end
+    object chkLogCallStack: TCheckBox
+      AnchorSideLeft.Control = gbActions
+      AnchorSideTop.Control = edtLogCallStack
+      AnchorSideTop.Side = asrCenter
+      Left = 6
+      Height = 19
+      Top = 149
+      Width = 91
+      BorderSpacing.Left = 6
+      Caption = 'Log call stack'
+      OnChange = chkLogCallStackChange
+      TabOrder = 9
+    end
+    object edtLogCallStack: TSpinEdit
+      AnchorSideLeft.Control = chkEvalExpression
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = edtLogMessage
+      AnchorSideTop.Side = asrBottom
+      Left = 125
+      Height = 23
+      Top = 147
+      Width = 50
+      BorderSpacing.Left = 20
+      BorderSpacing.Top = 6
+      BorderSpacing.Bottom = 6
+      Enabled = False
+      MaxValue = 1024
+      TabOrder = 10
+    end
+    object lblLogCallStackLimit: TLabel
+      AnchorSideLeft.Control = edtLogCallStack
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = edtLogCallStack
+      AnchorSideTop.Side = asrCenter
+      Left = 181
+      Height = 16
+      Top = 150
+      Width = 109
+      BorderSpacing.Left = 6
+      Caption = 'lblLogCallStackLimit'
+      ParentColor = False
+    end
   end
   object ButtonPanel: TButtonPanel[12]
     AnchorSideTop.Control = gbActions
     AnchorSideTop.Side = asrBottom
     Left = 6
-    Height = 41
+    Height = 38
-    Top = 351
+    Top = 380
     Width = 438
     Anchors = [akTop, akLeft, akRight, akBottom]
     OKButton.Name = 'OKButton'

debugger/breakpropertydlg.pas

@@ -16,6 +16,7 @@ type
 
   TBreakPropertyDlg = class(TDebuggerDlg)
     ButtonPanel: TButtonPanel;
+    chkLogCallStack: TCheckBox;
     chkEnableGroups: TCheckBox;
     chkDisableGroups: TCheckBox;
     chkEvalExpression: TCheckBox;
@@ -32,6 +33,7 @@ type
     edtCounter: TEdit;
     edtFilename: TEdit;
     gbActions: TGroupBox;
+    lblLogCallStackLimit: TLabel;
     lblMS: TLabel;
     lblFileName: TLabel;
     lblLine: TLabel;
@@ -39,12 +41,14 @@ type
     lblHitCount: TLabel;
     lblGroup: TLabel;
     lblAutoContinue: TLabel;
+    edtLogCallStack: TSpinEdit;
     procedure btnHelpClick(Sender: TObject);
     procedure btnOKClick(Sender: TObject);
     procedure BreakPointRemove(const ASender: TIDEBreakPoints;
       const ABreakpoint: TIDEBreakPoint);
     procedure BreakPointUpdate(const ASender: TIDEBreakPoints;
       const ABreakpoint: TIDEBreakPoint);
+    procedure chkLogCallStackChange(Sender: TObject);
     procedure chkLogMessageChange(Sender: TObject);
   private
     FBreakpointsNotification : TIDEBreakPointsNotification;
@@ -69,6 +73,11 @@ begin
   UpdateInfo;
 end;
 
+procedure TBreakPropertyDlg.chkLogCallStackChange(Sender: TObject);
+begin
+  edtLogCallStack.Enabled := chkLogCallStack.Checked;
+end;
+
 procedure TBreakPropertyDlg.chkLogMessageChange(Sender: TObject);
 begin
   edtLogMessage.Enabled := chkLogMessage.Checked;
@@ -119,6 +128,7 @@ begin
   if chkEnableGroups.Checked then Include(Actions, bpaEnableGroup);
 //  if chkEvalExpression.Checked then Include(Actions, bpaEValExpression);
   if chkLogMessage.Checked then Include(Actions, bpaLogMessage);
+  if chkLogCallStack.Checked then Include(Actions, bpaLogCallStack);
   FBreakpoint.Actions := Actions;
   FBreakpoint.LogMessage := edtLogMessage.Text;
 
@@ -170,6 +180,8 @@ begin
 //  chkEvalExpression.Checked := bpaEValExpression in Actions;
   chkLogMessage.Checked := bpaLogMessage in Actions;
   edtLogMessage.Text := FBreakpoint.LogMessage;
+  chkLogCallStack.Checked := bpaLogCallStack in Actions;
+  edtLogCallStack.Value := FBreakpoint.LogCallStackLimit;
 end;
 
 constructor TBreakPropertyDlg.Create(AOwner: TComponent; ABreakPoint: TIDEBreakPoint);
@@ -203,6 +215,8 @@ begin
   chkDisableGroups.Caption := lisDisableGroup;
   chkEvalExpression.Caption := lisEvalExpression;
   chkLogMessage.Caption := lisLogMessage;
+  chkLogCallStack.Caption := lisLogCallStack;
+  lblLogCallStackLimit.Caption := lisLogCallStackLimit;
   edtCondition.Items.Assign(InputHistories.HistoryLists.GetList('BreakPointExpression', True));
 
   FBreakpoint := ABreakPoint;

debugger/debugger.pp

@@ -276,7 +276,8 @@ type
     bpaStop,
     bpaEnableGroup,
     bpaDisableGroup,
-    bpaLogMessage
+    bpaLogMessage,
+    bpaLogCallStack
     );
   TIDEBreakPointActions = set of TIDEBreakPointAction;
 
@@ -357,6 +358,7 @@ type
     FGroup: TIDEBreakPointGroup;
     FLoading: Boolean;
     FLogMessage: String;
+    FLogCallStackLimit: Integer;
   protected
     procedure AssignLocationTo(Dest: TPersistent); override;
     procedure AssignTo(Dest: TPersistent); override;
@@ -383,10 +385,12 @@ type
     function GetGroup: TIDEBreakPointGroup; virtual;
     function GetAutoContinueTime: Cardinal; virtual;
     function GetLogMessage: String; virtual;
+    function GetLogCallStackLimit: Integer;
     procedure SetActions(const AValue: TIDEBreakPointActions); virtual;
     procedure SetGroup(const AValue: TIDEBreakPointGroup); virtual;
     procedure SetAutoContinueTime(const AValue: Cardinal); virtual;
     procedure SetLogMessage(const AValue: String); virtual;
+    procedure SetLogCallStackLimit(const AValue: Integer);
   public
     constructor Create(ACollection: TCollection); override;
     destructor Destroy; override;
@@ -408,6 +412,7 @@ type
     property Group: TIDEBreakPointGroup read GetGroup write SetGroup;
     property Loading: Boolean read FLoading;
     property LogMessage: String read GetLogMessage write SetLogMessage;
+    property LogCallStackLimit: Integer read GetLogCallStackLimit write SetLogCallStackLimit;
   end;
   TIDEBreakPointClass = class of TIDEBreakPoint;
 
@@ -422,6 +427,7 @@ type
     procedure DoChanged; override;
     procedure DoStateChange(const AOldState: TDBGState); virtual;
     procedure DoLogMessage(const AMessage: String); virtual;
+    procedure DoLogCallStack(const Limit: Integer); virtual;
     property  Debugger: TDebugger read GetDebugger;
   public
     constructor Create(ACollection: TCollection); override;
@@ -2149,7 +2155,8 @@ const
     'Stop',
     'EnableGroup',
     'DisableGroup',
-    'LogMessage'
+    'LogMessage',
+    'LogCallStack'
     );
 
 function DBGCommandNameToCommand(const s: string): TDBGCommand;
@@ -3579,6 +3586,20 @@ begin
   Result := FLogMessage;
 end;
 
+function TIDEBreakPoint.GetLogCallStackLimit: Integer;
+begin
+  Result := FLogCallStackLimit;
+end;
+
+procedure TIDEBreakPoint.SetLogCallStackLimit(const AValue: Integer);
+begin
+  if FLogCallStackLimit <> AValue then
+  begin
+    FLogCallStackLimit := AValue;
+    Changed;
+  end;
+end;
+
 procedure TIDEBreakPoint.AssignLocationTo(Dest: TPersistent);
 var
   DestBreakPoint: TBaseBreakPoint absolute Dest;
@@ -3597,6 +3618,7 @@ begin
     TIDEBreakPoint(Dest).Actions := FActions;
     TIDEBreakPoint(Dest).AutoContinueTime := FAutoContinueTime;
     TIDEBreakPoint(Dest).LogMessage := FLogMessage;
+    TIDEBreakPoint(Dest).LogCallStackLimit := FLogCallStackLimit;
   end;
 
   if (Collection <> nil) and (TIDEBreakPoints(Collection).FMaster <> nil)
@@ -3732,6 +3754,8 @@ begin
   inherited DoHit(ACount, AContinue);
   if bpaLogMessage in Actions
   then FMaster.DoLogMessage(FLogMessage);
+  if bpaLogCallStack in Actions
+  then FMaster.DoLogCallStack(FLogCallStackLimit);
   if bpaEnableGroup in Actions
   then EnableGroups;
   if bpaDisableGroup in Actions
@@ -3803,6 +3827,7 @@ begin
     Enabled:=FInitialEnabled;
     FLine:=XMLConfig.GetValue(Path+'Line/Value',-1);
     FLogMessage:=XMLConfig.GetValue(Path+'LogMessage/Value','');
+    FLogCallStackLimit:=XMLConfig.GetValue(Path+'LogCallStackLimit/Value',0);
     NewActions:=[];
     for CurAction:=Low(TIDEBreakPointAction) to High(TIDEBreakPointAction) do
       if XMLConfig.GetValue(
@@ -3872,6 +3897,7 @@ begin
   AConfig.SetDeleteValue(APath+'InitialEnabled/Value',InitialEnabled,true);
   AConfig.SetDeleteValue(APath+'Line/Value',Line,-1);
   AConfig.SetDeleteValue(APath+'LogMessage/Value',LogMessage,'');
+  AConfig.SetDeleteValue(APath+'LogCallStackLimit/Value',LogCallStackLimit,0);
 
   for CurAction := Low(TIDEBreakPointAction) to High(TIDEBreakPointAction) do
   begin
@@ -4019,6 +4045,15 @@ begin
   Debugger.DoDbgEvent(ecBreakpoint, etBreakpointMessage, 'Breakpoint Message: ' + AMessage);
 end;
 
+procedure TDBGBreakPoint.DoLogCallStack(const Limit: Integer);
+begin
+  if Limit = 0 then
+    Debugger.DoDbgEvent(ecBreakpoint, etBreakpointMessage, 'Breakpoint Call Stack: Log all stack frames')
+  else
+    Debugger.DoDbgEvent(ecBreakpoint, etBreakpointMessage, Format('Breakpoint Call Stack: Log %d stack frames', [Limit]));
+  Debugger.DoDbgEvent(ecBreakpoint, etBreakpointStackDump, '    TODO: unimplemented');
+end;
+
 function TDBGBreakPoint.GetDebugger: TDebugger;
 begin
   Result := TDBGBreakPoints(Collection).FDebugger;

ide/lazarusidestrconsts.pas

@@ -4638,6 +4638,8 @@ resourcestring
   lisEnableGroup = 'Enable Group';
   lisDisableGroup = 'Disable Group';
   lisLogMessage = 'Log Message';
+  lisLogCallStack = 'Log Call Stack';
+  lisLogCallStackLimit = '(frames limit. 0 - no limits)';
   lisAutoContinue = 'Auto Continue';
   lisDisabled = 'Disabled';
   lisInvalidOff = 'Invalid (Off)';