From 99cd20e80f08e79ccdc3e16ad222cb6b50629548 Mon Sep 17 00:00:00 2001 From: marc Date: Sun, 7 Mar 2010 18:37:20 +0000 Subject: [PATCH] * Debugger: Implemented value modification. Patch #15628 by Flavio Etrusco (modified) git-svn-id: trunk@23866 - --- debugger/debugger.pp | 2 +- debugger/evaluatedlg.lfm | 33 +++++---- debugger/evaluatedlg.pp | 79 ++++++++++++++++----- debugger/gdbmidebugger.pp | 140 +++++++++++++++++++++++++++++++++++++- ide/basedebugmanager.pas | 1 + ide/debugmanager.pas | 10 +++ 6 files changed, 231 insertions(+), 34 deletions(-) diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 6312700291..f5af86cf4f 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -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; diff --git a/debugger/evaluatedlg.lfm b/debugger/evaluatedlg.lfm index 9a698a29fe..ba3313ffe2 100644 --- a/debugger/evaluatedlg.lfm +++ b/debugger/evaluatedlg.lfm @@ -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 diff --git a/debugger/evaluatedlg.pp b/debugger/evaluatedlg.pp index df67b73a26..7e7a3ec52a 100644 --- a/debugger/evaluatedlg.pp +++ b/debugger/evaluatedlg.pp @@ -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; diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 1c7f2c5c94..83c3cdc703 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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^), diff --git a/ide/basedebugmanager.pas b/ide/basedebugmanager.pas index ac1c40a5ec..70f29f8e0c 100644 --- a/ide/basedebugmanager.pas +++ b/ide/basedebugmanager.pas @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 08b978c04c..0100ccb485 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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;