mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 05:36:32 +02:00
* Debugger: Implemented value modification. Patch #15628 by Flavio Etrusco (modified)
git-svn-id: trunk@23866 -
This commit is contained in:
marc
parent
e07d361809
commit
99cd20e80f
@ -1783,7 +1783,7 @@ end;
|
||||
|
||||
function TDebugger.Modify(const AExpression, AValue: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
Result := ReqCmd(dcModify, [AExpression, AValue]);
|
||||
end;
|
||||
|
||||
procedure TDebugger.Pause;
|
||||
|
||||
@ -3,6 +3,7 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
Height = 290
|
||||
Top = 393
|
||||
Width = 400
|
||||
ActiveControl = cmbExpression
|
||||
BorderStyle = bsSizeToolWin
|
||||
Caption = 'Evaluate/Modify'
|
||||
ClientHeight = 290
|
||||
@ -19,7 +20,7 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 47
|
||||
Width = 57
|
||||
Width = 72
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
Caption = '&Expression:'
|
||||
@ -32,8 +33,8 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 91
|
||||
Width = 35
|
||||
Top = 93
|
||||
Width = 47
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 6
|
||||
Caption = '&Result:'
|
||||
@ -45,8 +46,8 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
AnchorSideBottom.Control = cmbNewValue
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 246
|
||||
Width = 55
|
||||
Top = 244
|
||||
Width = 69
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Bottom = 3
|
||||
@ -69,7 +70,7 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
object tbInspect: TToolButton
|
||||
Left = 152
|
||||
Left = 156
|
||||
Top = 2
|
||||
Caption = '&Inspect'
|
||||
Enabled = False
|
||||
@ -77,7 +78,7 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
OnClick = tbInspectClick
|
||||
end
|
||||
object tbWatch: TToolButton
|
||||
Left = 102
|
||||
Left = 106
|
||||
Top = 2
|
||||
AllowAllUp = True
|
||||
Caption = '&Watch'
|
||||
@ -86,11 +87,12 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
OnClick = tbWatchClick
|
||||
end
|
||||
object tbModify: TToolButton
|
||||
Left = 52
|
||||
Left = 56
|
||||
Top = 2
|
||||
Caption = '&Modify'
|
||||
Enabled = False
|
||||
ImageIndex = 1
|
||||
OnClick = tbModifyClick
|
||||
end
|
||||
object tbEvaluate: TToolButton
|
||||
Left = 2
|
||||
@ -108,14 +110,14 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 6
|
||||
Height = 21
|
||||
Height = 23
|
||||
Top = 64
|
||||
Width = 388
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Left = 6
|
||||
BorderSpacing.Top = 3
|
||||
BorderSpacing.Right = 6
|
||||
ItemHeight = 13
|
||||
ItemHeight = 0
|
||||
OnChange = cmbExpressionChange
|
||||
OnKeyDown = cmbExpressionKeyDown
|
||||
TabOrder = 2
|
||||
@ -128,8 +130,8 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = lblNewValue
|
||||
Left = 6
|
||||
Height = 132
|
||||
Top = 108
|
||||
Height = 128
|
||||
Top = 110
|
||||
Width = 388
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 6
|
||||
@ -146,14 +148,15 @@ inherited EvaluateDlg: TEvaluateDlg
|
||||
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 = 0
|
||||
OnKeyDown = cmbNewValueKeyDown
|
||||
TabOrder = 3
|
||||
end
|
||||
end
|
||||
|
||||
@ -56,6 +56,8 @@ type
|
||||
tbWatch: TToolButton;
|
||||
tbModify: TToolButton;
|
||||
tbEvaluate: TToolButton;
|
||||
procedure cmbNewValueKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure FormShow(Sender: TObject);
|
||||
@ -64,12 +66,14 @@ type
|
||||
Shift: TShiftState);
|
||||
procedure tbEvaluateClick(Sender: TObject);
|
||||
procedure tbInspectClick(Sender: TObject);
|
||||
procedure tbModifyClick(Sender: TObject);
|
||||
procedure tbWatchClick(Sender: TObject);
|
||||
|
||||
private
|
||||
function GetFindText: string;
|
||||
procedure SetFindText(const NewFindText: string);
|
||||
|
||||
procedure Evaluate;
|
||||
procedure Modify;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
property FindText: string read GetFindText write SetFindText;
|
||||
@ -105,13 +109,33 @@ begin
|
||||
tbEvaluate.ImageIndex := IDEImages.LoadImage(16, 'debugger_evaluate');
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.Evaluate;
|
||||
var
|
||||
S, R: String;
|
||||
DBGType: TDBGType;
|
||||
begin
|
||||
S := cmbExpression.Text;
|
||||
InputHistories.HistoryLists.Add(ClassName, S);
|
||||
DBGType:=nil;
|
||||
if DebugBoss.Evaluate(S, R, DBGType)
|
||||
then begin
|
||||
if cmbExpression.Items.IndexOf(S) = -1
|
||||
then cmbExpression.Items.Insert(0, S);
|
||||
tbModify.Enabled := True;
|
||||
end
|
||||
else
|
||||
tbModify.Enabled := False;
|
||||
FreeAndNil(DBGType);
|
||||
txtResult.Lines.Text := R;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.cmbExpressionChange(Sender: TObject);
|
||||
var
|
||||
HasExpression: Boolean;
|
||||
begin
|
||||
HasExpression := Trim(cmbExpression.Text) <> '';
|
||||
tbEvaluate.Enabled := HasExpression;
|
||||
tbModify.Enabled := False;
|
||||
tbModify.Enabled := HasExpression;
|
||||
tbWatch.Enabled := HasExpression;
|
||||
tbInspect.Enabled := HasExpression;
|
||||
end;
|
||||
@ -121,7 +145,7 @@ procedure TEvaluateDlg.cmbExpressionKeyDown(Sender: TObject; var Key: Word;
|
||||
begin
|
||||
if (Key = VK_RETURN) and tbEvaluate.Enabled
|
||||
then begin
|
||||
tbEvaluate.Click;
|
||||
Evaluate;
|
||||
Key := 0;
|
||||
end;
|
||||
end;
|
||||
@ -143,12 +167,41 @@ begin
|
||||
Result := cmbExpression.Text;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.Modify;
|
||||
var
|
||||
S, V, R: String;
|
||||
DBGType: TDBGType;
|
||||
begin
|
||||
S := Trim(cmbExpression.Text);
|
||||
if S = '' then Exit;
|
||||
V := cmbNewValue.Text;
|
||||
if not DebugBoss.Modify(S, V) then Exit;
|
||||
|
||||
if cmbNewValue.Items.IndexOf(V) = -1
|
||||
then cmbNewValue.Items.Insert(0, V);
|
||||
|
||||
DBGType:=nil;
|
||||
if not DebugBoss.Evaluate(S, R, DBGType) then Exit;
|
||||
FreeAndNil(DBGType);
|
||||
txtResult.Lines.Text := R;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
IDEDialogLayoutList.SaveLayout(Self);
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.cmbNewValueKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if (Key = VK_RETURN) and (tbModify.Enabled)
|
||||
then begin
|
||||
Modify;
|
||||
Key := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.FormShow(Sender: TObject);
|
||||
begin
|
||||
cmbExpression.SetFocus;
|
||||
@ -162,21 +215,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.tbEvaluateClick(Sender: TObject);
|
||||
var
|
||||
S, R: String;
|
||||
DBGType: TDBGType;
|
||||
begin
|
||||
S := cmbExpression.Text;
|
||||
InputHistories.HistoryLists.Add(ClassName, S);
|
||||
DBGType:=nil;
|
||||
if DebugBoss.Evaluate(S, R, DBGType)
|
||||
then begin
|
||||
if cmbExpression.Items.IndexOf(S) = -1
|
||||
then cmbExpression.Items.Insert(0, S);
|
||||
// tbModify.Enabled := True;
|
||||
end;
|
||||
FreeAndNil(DBGType);
|
||||
txtResult.Lines.Text := R;
|
||||
Evaluate;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.tbInspectClick(Sender: TObject);
|
||||
@ -184,6 +224,11 @@ begin
|
||||
DebugBoss.Inspect(cmbExpression.Text);
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.tbModifyClick(Sender: TObject);
|
||||
begin
|
||||
Modify;
|
||||
end;
|
||||
|
||||
procedure TEvaluateDlg.tbWatchClick(Sender: TObject);
|
||||
var
|
||||
S: String;
|
||||
|
||||
@ -63,7 +63,7 @@ type
|
||||
);
|
||||
|
||||
TGDBMIResultFlags = set of (
|
||||
rfNoMI // flag is set if the output is not MI fomatted
|
||||
rfNoMI // flag is set if the output is not MI formatted
|
||||
// some MI functions return normal output
|
||||
// some normal functions return MI output
|
||||
);
|
||||
@ -139,6 +139,7 @@ type
|
||||
// Implementation of external functions
|
||||
function GDBEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
|
||||
function GDBEvaluate(const AExpression: String; var AResult: String; out ATypeInfo: TGDBType): Boolean;
|
||||
function GDBModify(const AExpression, ANewValue: String): Boolean;
|
||||
function GDBRun: Boolean;
|
||||
function GDBPause(const AInternal: Boolean): Boolean;
|
||||
function GDBStop: Boolean;
|
||||
@ -2656,6 +2657,142 @@ begin
|
||||
AResult := FormatResult(AResult);
|
||||
end;
|
||||
|
||||
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
|
||||
R: TGDBMIExecResult;
|
||||
S: String;
|
||||
begin
|
||||
S := Trim(ANewValue);
|
||||
if (S <> '') and (S[1] in ['''', '#'])
|
||||
then begin
|
||||
if not ConvertString(S) then Exit(False);
|
||||
end;
|
||||
|
||||
Result := ExecuteCommand('-gdb-set var %s := %s', [AExpression, S], [cfIgnoreError, cfExternal], R)
|
||||
and (R.State <> dsError);
|
||||
end;
|
||||
|
||||
function TGDBMIDebugger.GDBJumpTo(const ASource: String; const ALine: Integer): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
@ -3804,6 +3941,7 @@ begin
|
||||
dcRunTo: Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
|
||||
dcJumpto: Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
|
||||
dcEvaluate: Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^),TGDBType(AParams[2].VPointer^));
|
||||
dcModify: Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString));
|
||||
dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
|
||||
dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
|
||||
String(AParams[3].VPointer^), String(AParams[4].VPointer^),
|
||||
|
||||
@ -117,6 +117,7 @@ type
|
||||
|
||||
function Evaluate(const AExpression: String; var AResult: String;
|
||||
var ATypeInfo: TDBGType): Boolean; virtual; abstract; // Evaluates the given expression, returns true if valid
|
||||
function Modify(const AExpression: String; const ANewValue: String): Boolean; virtual; abstract; // Modify the given expression, returns true if valid
|
||||
|
||||
function GetFullFilename(var Filename: string; AskUserIfNotFound: Boolean): Boolean; virtual; abstract;
|
||||
procedure Inspect(const AExpression: String); virtual; abstract;
|
||||
|
||||
@ -174,6 +174,7 @@ type
|
||||
procedure EndDebugging; override;
|
||||
function Evaluate(const AExpression: String; var AResult: String;
|
||||
var ATypeInfo: TDBGType): Boolean; override;
|
||||
function Modify(const AExpression, ANewValue: String): Boolean; override;
|
||||
|
||||
procedure Inspect(const AExpression: String); override;
|
||||
|
||||
@ -2485,6 +2486,15 @@ begin
|
||||
and FDebugger.Evaluate(AExpression, AResult, ATypeInfo)
|
||||
end;
|
||||
|
||||
function TDebugManager.Modify(const AExpression, ANewValue: String): Boolean;
|
||||
begin
|
||||
Result := (not Destroying)
|
||||
and (MainIDE.ToolStatus = itDebugger)
|
||||
and (FDebugger <> nil)
|
||||
and (dcModify in FDebugger.Commands)
|
||||
and FDebugger.Modify(AExpression, ANewValue)
|
||||
end;
|
||||
|
||||
procedure TDebugManager.Inspect(const AExpression: String);
|
||||
begin
|
||||
if Destroying then Exit;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user