paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 11:36:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Dbg: Added debug expressions. Modyfied patch #16474 by Flavio Etrusco

Browse Source 
* Dbg: Improved pascal to gdb string conversion, so valid gdb strings will 
       be used for breakpoint expresions and string modification
* Dbg: some cleanup

git-svn-id: trunk@25523 -
This commit is contained in:
marc 2010-05-19 23:28:46 +00:00
parent 9d580fed56
commit 07e6bb0f2b
3 changed files with 278 additions and 229 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
debugger/breakpropertydlg.lfm
View File

@ -19,9 +19,9 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtFilename AnchorSideTop.Control = edtFilename
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 10 Top = 10
Width = 62 Width = 55
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Filename:' Caption = 'Filename:'
ParentColor = False ParentColor = False
@ -31,21 +31,20 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtLine AnchorSideTop.Control = edtLine
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 43 Top = 39
Width = 31 Width = 28
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Line:' Caption = 'Line:'
ParentColor = False ParentColor = False
end end
object lblCondition: TLabel[2] object lblCondition: TLabel[2]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = edtCondition
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 76 Top = 76
Width = 65 Width = 58
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Condition:' Caption = 'Condition:'
ParentColor = False ParentColor = False
@ -55,9 +54,9 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtCounter AnchorSideTop.Control = edtCounter
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 109 Top = 109
Width = 59 Width = 51
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Hitcount:' Caption = 'Hitcount:'
ParentColor = False ParentColor = False
@ -67,9 +66,9 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = cmbGroup AnchorSideTop.Control = cmbGroup
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 176 Top = 169
Width = 44 Width = 40
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Group:' Caption = 'Group:'
ParentColor = False ParentColor = False
@ -79,9 +78,9 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtAutocontinueMS AnchorSideTop.Control = edtAutocontinueMS
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 18 Height = 14
Top = 142 Top = 138
Width = 124 Width = 109
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Auto continue after' Caption = 'Auto continue after'
ParentColor = False ParentColor = False
@ -91,10 +90,10 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = lblAutoContinue AnchorSideTop.Control = lblAutoContinue
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 208 Left = 193
Height = 18 Height = 14
Top = 142 Top = 138
Width = 31 Width = 27
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = '(ms)' Caption = '(ms)'
ParentColor = False ParentColor = False
@ -105,58 +104,40 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtCounter AnchorSideTop.Control = edtCounter
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 142 Left = 127
Height = 27 Height = 23
Top = 138 Top = 134
Width = 60 Width = 60
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabOrder = 4 TabOrder = 3
Text = 'edtAutocontinueMS' Text = 'edtAutocontinueMS'
end end
object edtCounter: TEdit[8] object edtCounter: TEdit[8]
AnchorSideLeft.Control = lblAutoContinue AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtCondition
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 142 Left = 127
Height = 27 Height = 23
Top = 105 Top = 105
Width = 295 Width = 310
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Around = 6
TabOrder = 3
Text = 'edtCounter'
end
object edtCondition: TEdit[9]
AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtLine
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 142
Height = 27
Top = 72
Width = 295
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Around = 6 BorderSpacing.Around = 6
TabOrder = 2 TabOrder = 2
Text = 'edtCondition' Text = 'edtCounter'
end end
object edtLine: TEdit[10] object edtLine: TEdit[9]
AnchorSideLeft.Control = lblAutoContinue AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtFilename AnchorSideTop.Control = edtFilename
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 142 Left = 127
Height = 27 Height = 23
Top = 39 Top = 35
Width = 60 Width = 60
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -165,16 +146,16 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 1 TabOrder = 1
Text = 'edtLine' Text = 'edtLine'
end end
object edtFilename: TEdit[11] object edtFilename: TEdit[10]
AnchorSideLeft.Control = lblAutoContinue AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 142 Left = 127
Height = 27 Height = 23
Top = 6 Top = 6
Width = 295 Width = 310
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Around = 6 BorderSpacing.Around = 6
@ -183,48 +164,48 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 0 TabOrder = 0
Text = 'edtFilename' Text = 'edtFilename'
end end
object cmbGroup: TComboBox[12] object cmbGroup: TComboBox[11]
AnchorSideLeft.Control = lblAutoContinue AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtAutocontinueMS AnchorSideTop.Control = edtAutocontinueMS
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 142 Left = 127
Height = 29 Height = 27
Top = 171 Top = 163
Width = 295 Width = 310
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Around = 6 BorderSpacing.Around = 6
ItemHeight = 0 ItemHeight = 0
TabOrder = 5 TabOrder = 4
Text = 'cmbGroup' Text = 'cmbGroup'
end end
object gbActions: TGroupBox[13] object gbActions: TGroupBox[12]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cmbGroup AnchorSideTop.Control = cmbGroup
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 6 Left = 6
Height = 185 Height = 165
Top = 206 Top = 196
Width = 431 Width = 431
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Actions' Caption = 'Actions'
ClientHeight = 166 ClientHeight = 150
ClientWidth = 427 ClientWidth = 427
TabOrder = 6 TabOrder = 5
object chkActionBreak: TCheckBox object chkActionBreak: TCheckBox
AnchorSideLeft.Control = gbActions AnchorSideLeft.Control = gbActions
AnchorSideTop.Control = gbActions AnchorSideTop.Control = gbActions
Left = 6 Left = 6
Height = 22 Height = 22
Top = 6 Top = 6
Width = 61 Width = 57
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Break' Caption = 'Break'
TabOrder = 0 TabOrder = 0
@ -235,8 +216,8 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 22 Height = 22
Top = 36 Top = 34
Width = 110 Width = 101
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Enable goups' Caption = 'Enable goups'
TabOrder = 1 TabOrder = 1
@ -247,8 +228,8 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 22 Height = 22
Top = 69 Top = 63
Width = 119 Width = 110
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Disable groups' Caption = 'Disable groups'
TabOrder = 2 TabOrder = 2
@ -259,10 +240,10 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = chkActionBreak AnchorSideTop.Control = chkActionBreak
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 147 Left = 143
Height = 27 Height = 23
Top = 34 Top = 34
Width = 251 Width = 255
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 80 BorderSpacing.Left = 80
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -280,10 +261,10 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Control = edtEnableGroups AnchorSideTop.Control = edtEnableGroups
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 147 Left = 143
Height = 27 Height = 23
Top = 67 Top = 63
Width = 251 Width = 255
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 80 BorderSpacing.Left = 80
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -301,8 +282,8 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 22 Height = 22
Top = 102 Top = 92
Width = 123 Width = 114
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Eval expression' Caption = 'Eval expression'
Enabled = False Enabled = False
@ -314,8 +295,8 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 6 Left = 6
Height = 22 Height = 22
Top = 135 Top = 121
Width = 110 Width = 101
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Log message' Caption = 'Log message'
Enabled = False Enabled = False
@ -328,10 +309,10 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbActions AnchorSideRight.Control = gbActions
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 147 Left = 143
Height = 27 Height = 23
Top = 100 Top = 92
Width = 274 Width = 278
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 80 BorderSpacing.Left = 80
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -347,10 +328,10 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbActions AnchorSideRight.Control = gbActions
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 147 Left = 143
Height = 27 Height = 23
Top = 133 Top = 121
Width = 274 Width = 278
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 80 BorderSpacing.Left = 80
BorderSpacing.Top = 6 BorderSpacing.Top = 6
@ -360,17 +341,35 @@ inherited BreakPropertyDlg: TBreakPropertyDlg
TabOrder = 8 TabOrder = 8
end end
end end
object ButtonPanel: TButtonPanel[14] object ButtonPanel: TButtonPanel[13]
AnchorSideTop.Control = gbActions AnchorSideTop.Control = gbActions
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 6 Left = 6
Height = 32 Height = 62
Top = 397 Top = 367
Width = 431 Width = 431
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 7 TabOrder = 6
ShowButtons = [pbOK, pbCancel, pbHelp] ShowButtons = [pbOK, pbCancel, pbHelp]
ShowBevel = False ShowBevel = False
end end
object edtCondition: TComboBox[14]
AnchorSideLeft.Control = lblAutoContinue
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edtLine
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 127
Height = 27
Top = 64
Width = 310
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 6
BorderSpacing.Around = 6
ItemHeight = 0
TabOrder = 7
Text = 'edtCondition'
end
end end

7
debugger/breakpropertydlg.pas
View File

@ -7,7 +7,7 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Buttons, DebuggerDlg, Debugger, ButtonPanel, EditBtn, ExtCtrls, StdCtrls, Buttons, DebuggerDlg, Debugger, ButtonPanel, EditBtn,
BaseDebugManager, IDEContextHelpEdit, LazarusIDEStrConsts; BaseDebugManager, IDEContextHelpEdit, LazarusIDEStrConsts, InputHistory;
type type
@ -21,12 +21,12 @@ type
chkLogMessage: TCheckBox; chkLogMessage: TCheckBox;
chkActionBreak: TCheckBox; chkActionBreak: TCheckBox;
cmbGroup: TComboBox; cmbGroup: TComboBox;
edtCondition: TComboBox;
edtEvalExpression: TEdit; edtEvalExpression: TEdit;
edtLogMessage: TEdit; edtLogMessage: TEdit;
edtEnableGroups: TEditButton; edtEnableGroups: TEditButton;
edtDisableGroups: TEditButton; edtDisableGroups: TEditButton;
edtAutocontinueMS: TEdit; edtAutocontinueMS: TEdit;
edtCondition: TEdit;
edtCounter: TEdit; edtCounter: TEdit;
edtFilename: TEdit; edtFilename: TEdit;
edtLine: TEdit; edtLine: TEdit;
@ -105,6 +105,8 @@ begin
// if chkEvalExpression.Checked then Include(Actions, bpaEValExpression); // if chkEvalExpression.Checked then Include(Actions, bpaEValExpression);
// if chkLogMessage.Checked then Include(Actions, bpaLogMessage); // if chkLogMessage.Checked then Include(Actions, bpaLogMessage);
FBreakpoint.Actions := Actions; FBreakpoint.Actions := Actions;
InputHistories.HistoryLists.GetList('BreakPointExpression', True).Add(edtCondition.Text);
end; end;
procedure TBreakPropertyDlg.DoEndUpdate; procedure TBreakPropertyDlg.DoEndUpdate;
@ -162,6 +164,7 @@ begin
chkDisableGroups.Caption := lisDisableGroup; chkDisableGroups.Caption := lisDisableGroup;
chkEvalExpression.Caption := lisEvalExpression; chkEvalExpression.Caption := lisEvalExpression;
chkLogMessage.Caption := lisLogMessage; chkLogMessage.Caption := lisLogMessage;
edtCondition.Items.Assign(InputHistories.HistoryLists.GetList('BreakPointExpression', True));
FBreakpoint := ABreakPoint; FBreakpoint := ABreakPoint;
FBreakpointsNotification := TIDEBreakPointsNotification.Create; FBreakpointsNotification := TIDEBreakPointsNotification.Create;

315
debugger/gdbmidebugger.pp
View File

@ -153,6 +153,7 @@ type
function GDBSourceAdress(const ASource: String; ALine, AColumn: Integer; out AAddr: TDbgPtr): Boolean; function GDBSourceAdress(const ASource: String; ALine, AColumn: Integer; out AAddr: TDbgPtr): Boolean;
procedure CallStackSetCurrent(AIndex: Integer); procedure CallStackSetCurrent(AIndex: Integer);
function ConvertPascalExpression(var AExpression: String): Boolean;
// --- // ---
procedure ClearSourceInfo; procedure ClearSourceInfo;
procedure GDBStopCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt); procedure GDBStopCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt);
@ -285,6 +286,7 @@ type
TGDBMIBreakPoint = class(TDBGBreakPoint) TGDBMIBreakPoint = class(TDBGBreakPoint)
private private
FBreakID: Integer; FBreakID: Integer;
FParsedExpression: String;
procedure SetBreakPointCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt); procedure SetBreakPointCallback(const AResult: TGDBMIExecResult; const ATag: PtrInt);
procedure SetBreakPoint; procedure SetBreakPoint;
procedure ReleaseBreakPoint; procedure ReleaseBreakPoint;
@ -2683,127 +2685,6 @@ begin
end; end;
function TGDBMIDebugger.GDBModify(const AExpression, ANewValue: String): Boolean; function TGDBMIDebugger.GDBModify(const AExpression, ANewValue: String): Boolean;
function ConvertString(var AValue: String): Boolean;
var
R: String;
P: PChar;
InString, EndString, EndVal: Boolean;
CharVal: Byte;
n: Integer;
ValMode: Char;
begin
R := '"';
Instring := False;
EndString := False;
EndVal := False;
ValMode := #0;
CharVal := 0;
P := @AValue[1];
for n := 1 to Length(AVAlue) do
begin
if InString
then begin
case P^ of
'''': begin
InString := False;
EndString := True;
end;
#0..#31,
'"',
#128..#255: begin
R := R + '\' + OctStr(Ord(P^), 3);
end;
else
R := R + P^;
end;
Inc(P);
Continue;
end;
case P^ of
'''': begin
if EndString
then R := R + '\' + OctStr(Ord(''''), 3);
EndVal := True;
InString := True;
end;
'#': begin
if ValMode <> #0
then begin
if not (ValMode in ['h', 'd', 'o', 'b']) then Exit(False);
R := R + '\' + OctStr(CharVal, 3);
end;
CharVal := 0;
ValMode := 'D';
end;
'$', '&', '%': begin
if ValMode <> 'D' then Exit(False);
ValMode := P^;
end;
else
case ValMode of
'D', 'd': begin
case P^ of
'0'..'9': CharVal := CharVal * 10 + Ord(P^) - Ord('0');
else
Exit(False);
end;
ValMode := 'd';
end;
'$', 'h': begin
case P^ of
'0'..'9': CharVal := CharVal * 16 + Ord(P^) - Ord('0');
'a'..'f': CharVal := CharVal * 16 + Ord(P^) - Ord('a');
'A'..'F': CharVal := CharVal * 16 + Ord(P^) - Ord('A');
else
Exit(False);
end;
ValMode := 'h';
end;
'&', 'o': begin
case P^ of
'0'..'7': CharVal := CharVal * 8 + Ord(P^) - Ord('0');
else
Exit(False);
end;
ValMode := 'o';
end;
'%', 'b': begin
case P^ of
'0': CharVal := CharVal shl 1;
'1': CharVal := CharVal shl 1 or 1;
else
Exit(False);
end;
ValMode := 'o';
end;
else
Exit(False);
end;
end;
if EndVal
then begin
case Valmode of
#0:;
'h', 'd', 'o', 'b': begin
R := R + '\' + OctStr(CharVal, 3);
ValMode := #0;
end;
else
Exit(False);
end;
EndVal := False;
end;
EndString := False;
Inc(p);
end;
AValue := R + '"';
Result := True;
end;
var var
R: TGDBMIExecResult; R: TGDBMIExecResult;
S: String; S: String;
@ -2811,7 +2692,7 @@ begin
S := Trim(ANewValue); S := Trim(ANewValue);
if (S <> '') and (S[1] in ['''', '#']) if (S <> '') and (S[1] in ['''', '#'])
then begin then begin
if not ConvertString(S) then Exit(False); if not ConvertPascalExpression(S) then Exit(False);
end; end;
Result := ExecuteCommand('-gdb-set var %s := %s', [AExpression, S], [cfIgnoreError, cfExternal], R) Result := ExecuteCommand('-gdb-set var %s := %s', [AExpression, S], [cfIgnoreError, cfExternal], R)
@ -4028,6 +3909,157 @@ begin
FSourceNames.Clear; FSourceNames.Clear;
end; end;
function TGDBMIDebugger.ConvertPascalExpression(var AExpression: String): Boolean;
var
R: String;
P: PChar;
InString, WasString, IsText, ValIsChar: Boolean;
n: Integer;
ValMode: Char;
Value: QWord;
function AppendValue: Boolean;
var
S: String;
begin
if ValMode = #0 then Exit(True);
if not (ValMode in ['h', 'd', 'o', 'b']) then Exit(False);
if ValIsChar
then begin
if not IsText
then begin
R := R + '"';
IsText := True;
end;
R := R + '\' + OctStr(Value, 3);
ValIsChar := False;
end
else begin
if IsText
then begin
R := R + '"';
IsText := False;
end;
Str(Value, S);
R := R + S;
end;
Result := True;
ValMode := #0;
end;
begin
R := '';
Instring := False;
WasString := False;
IsText := False;
ValIsChar := False;
ValMode := #0;
Value := 0;
P := @AExpression[1];
for n := 1 to Length(AExpression) do
begin
if InString
then begin
case P^ of
'''': begin
InString := False;
// delay setting terminating ", more characters defined through # may follow
WasString := True;
end;
#0..#31,
'"', '\',
#128..#255: begin
R := R + '\' + OctStr(Ord(P^), 3);
end;
else
R := R + P^;
end;
Inc(P);
Continue;
end;
case P^ of
'''': begin
if WasString
then begin
R := R + '\' + OctStr(Ord(''''), 3)
end
else begin
if not AppendValue then Exit(False);
if not IsText
then R := R + '"';
end;
IsText := True;
InString := True;
end;
'#': begin
if not AppendValue then Exit(False);
Value := 0;
ValMode := 'D';
ValIsChar := True;
end;
'$', '&', '%': begin
if not (ValMode in [#0, 'D']) then Exit(False);
ValMode := P^;
end;
else
case ValMode of
'D', 'd': begin
case P^ of
'0'..'9': Value := Value * 10 + Ord(P^) - Ord('0');
else
Exit(False);
end;
ValMode := 'd';
end;
'$', 'h': begin
case P^ of
'0'..'9': Value := Value * 16 + Ord(P^) - Ord('0');
'a'..'f': Value := Value * 16 + Ord(P^) - Ord('a');
'A'..'F': Value := Value * 16 + Ord(P^) - Ord('A');
else
Exit(False);
end;
ValMode := 'h';
end;
'&', 'o': begin
case P^ of
'0'..'7': Value := Value * 8 + Ord(P^) - Ord('0');
else
Exit(False);
end;
ValMode := 'o';
end;
'%', 'b': begin
case P^ of
'0': Value := Value shl 1;
'1': Value := Value shl 1 or 1;
else
Exit(False);
end;
ValMode := 'b';
end;
else
if IsText
then begin
R := R + '"';
IsText := False;
end;
R := R + P^;
end;
end;
WasString := False;
Inc(p);
end;
if not AppendValue then Exit(False);
if IsText then R := R + '"';
AExpression := R;
Result := True;
end;
procedure TGDBMIDebugger.SelectStackFrame(AIndex: Integer); procedure TGDBMIDebugger.SelectStackFrame(AIndex: Integer);
begin begin
ExecuteCommand('-stack-select-frame %d', [AIndex], [cfIgnoreError]); ExecuteCommand('-stack-select-frame %d', [AIndex], [cfIgnoreError]);
@ -4427,7 +4459,13 @@ begin
end; end;
procedure TGDBMIBreakPoint.DoExpressionChange; procedure TGDBMIBreakPoint.DoExpressionChange;
var
S: String;
begin begin
S := Expression;
if TGDBMIDebugger(Debugger).ConvertPascalExpression(S)
then FParsedExpression := S
else FParsedExpression := Expression;
UpdateExpression; UpdateExpression;
inherited; inherited;
end; end;
@ -4474,14 +4512,18 @@ begin
ResultList := TGDBMINameValueList.Create(AResult, ['bkpt']); ResultList := TGDBMINameValueList.Create(AResult, ['bkpt']);
FBreakID := StrToIntDef(ResultList.Values['number'], 0); FBreakID := StrToIntDef(ResultList.Values['number'], 0);
SetHitCount(StrToIntDef(ResultList.Values['times'], 0)); SetHitCount(StrToIntDef(ResultList.Values['times'], 0));
if FBreakID <> 0 if FBreakID = 0
then SetValid(vsValid) then begin
else SetValid(vsInvalid); ResultList.Free;
UpdateExpression; SetValid(vsInvalid);
Exit;
end;
SetValid(vsValid);
if FParsedExpression <> '' then UpdateExpression;
UpdateEnable; UpdateEnable;
if (FBreakID <> 0) if Enabled
and Enabled
and (TGDBMIDebugger(Debugger).FBreakAtMain = nil) and (TGDBMIDebugger(Debugger).FBreakAtMain = nil)
then begin then begin
// Check if this BP is at the same location as the temp break // Check if this BP is at the same location as the temp break
@ -4521,19 +4563,24 @@ const
// Use shortstring as fix for fpc 1.9.5 [2004/07/15] // Use shortstring as fix for fpc 1.9.5 [2004/07/15]
CMD: array[Boolean] of ShortString = ('disable', 'enable'); CMD: array[Boolean] of ShortString = ('disable', 'enable');
begin begin
if (FBreakID = 0) if FBreakID = 0 then Exit;
or (Debugger = nil) if Debugger = nil then Exit;
then Exit;
if Debugger.State = dsRun if Debugger.State = dsRun
then TGDBMIDebugger(Debugger).GDBPause(True); then TGDBMIDebugger(Debugger).GDBPause(True);
//writeln('TGDBMIBreakPoint.UpdateEnable Line=',Line,' Enabled=',Enabled,' InitialEnabled=',InitialEnabled);
TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', [CMD[Enabled], FBreakID], []);
[CMD[Enabled], FBreakID], []);
end; end;
procedure TGDBMIBreakPoint.UpdateExpression; procedure TGDBMIBreakPoint.UpdateExpression;
begin begin
if FBreakID = 0 then Exit;
if Debugger = nil then Exit;
if Debugger.State = dsRun
then TGDBMIDebugger(Debugger).GDBPause(True);
TGDBMIDebugger(Debugger).ExecuteCommand('-break-condition %d %s', [FBreakID, FParsedExpression], [cfIgnoreError, cfExternal]);
end; end;
{ =========================================================================== } { =========================================================================== }