paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 09:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Refactor, move initialization to queue-able object

Browse Source 
git-svn-id: trunk@30810 -
This commit is contained in:
martin 2011-05-19 15:00:26 +00:00
parent f24dae67c0
commit 3ac04fa211
1 changed files with 95 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
debugger/gdbmidebugger.pp
View File

@ -352,7 +352,6 @@ type
// All ExecuteCommand functions are wrappers for the real (full) implementation
// ExecuteCommandFull is never called directly
function ExecuteCommand(const ACommand: String; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean; overload;
function ExecuteCommand(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; var AResult: TGDBMIExecResult): Boolean; overload;
function ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload;
@ -553,6 +552,21 @@ type
property Success: Boolean read FSuccess;
end;
{ TGDBMIDebuggerCommandChangeFilename }
TGDBMIDebuggerCommandChangeFilename = class(TGDBMIDebuggerCommand)
private
FErrorMsg: String;
FSuccess: Boolean;
FFileName: String;
protected
function DoExecute: Boolean; override;
public
constructor Create(AOwner: TGDBMIDebugger; AFileName: String);
property Success: Boolean read FSuccess;
property ErrorMsg: String read FErrorMsg;
end;
{ TGDBMIDebuggerCommandStartDebugging }
TGDBMIDebuggerCommandStartDebugging = class(TGDBMIDebuggerCommand)
@ -1436,6 +1450,70 @@ begin
Result := '"' + Result + '"';
end;
{ TGDBMIDebuggerCommandChangeFilename }
function TGDBMIDebuggerCommandChangeFilename.DoExecute: Boolean;
procedure ClearBreakpoint(var ABreakID: Integer);
begin
if DebuggerState = dsError then Exit;
if ABreakID = -1 then Exit;
ExecuteCommand('-break-delete %d', [ABreakID], [cfCheckError]);
ABreakID := -1;
end;
var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
begin
Result := True;
FSuccess := False;
//Cleanup our own breakpoints
ClearBreakpoint(FTheDebugger.FExceptionBreakID);
ClearBreakpoint(FTheDebugger.FBreakErrorBreakID);
ClearBreakpoint(FTheDebugger.FRunErrorBreakID);
if DebuggerState = dsError then Exit;
FSuccess := ExecuteCommand('-file-exec-and-symbols %s', [FFileName], R);
if not FSuccess then exit;
if (R.State = dsError) and (FFileName <> '')
then begin
List := TGDBMINameValueList.Create(R);
FErrorMsg := DeleteEscapeChars((List.Values['msg']));
List.Free;
FSuccess := False;
Exit;
end;
if FFileName = ''
then exit;
if tfHasSymbols in TargetInfo^.TargetFlags
then begin
// Force setting language
// Setting extensions dumps GDB (bug #508)
FSuccess := ExecuteCommand('-gdb-set language pascal', [], [cfCheckError]);
FSuccess := FSuccess and (DebuggerState <> dsError);
(*
ExecuteCommand('-gdb-set extension-language .lpr pascal', False);
if not FHasSymbols then Exit; // file-exec-and-symbols not allways result in no symbols
ExecuteCommand('-gdb-set extension-language .lrs pascal', False);
ExecuteCommand('-gdb-set extension-language .dpr pascal', False);
ExecuteCommand('-gdb-set extension-language .pas pascal', False);
ExecuteCommand('-gdb-set extension-language .pp pascal', False);
ExecuteCommand('-gdb-set extension-language .inc pascal', False);
*)
end;
end;
constructor TGDBMIDebuggerCommandChangeFilename.Create(AOwner: TGDBMIDebugger;
AFileName: String);
begin
FFileName := AFileName;
inherited Create(AOwner);
end;
{ TGDBMIDebuggerCommandInitDebugger }
function TGDBMIDebuggerCommandInitDebugger.DoExecute: Boolean;
@ -5228,60 +5306,28 @@ begin
end;
function TGDBMIDebugger.ChangeFileName: Boolean;
procedure ClearBreakpoint(var ABreakID: Integer);
begin
if ABreakID = -1 then Exit;
ExecuteCommand('-break-delete %d', [ABreakID], [cfIgnoreError]);
ABreakID := -1;
end;
var
S: String;
R: TGDBMIExecResult;
List: TGDBMINameValueList;
Cmd: TGDBMIDebuggerCommandChangeFilename;
begin
Result := False;
//Cleanup our own breakpoints
ClearBreakpoint(FExceptionBreakID);
ClearBreakpoint(FBreakErrorBreakID);
ClearBreakpoint(FRunErrorBreakID);
S := ConvertToGDBPath(UTF8ToSys(FileName));
if not ExecuteCommand('-file-exec-and-symbols %s', [S], [cfIgnoreError], R) then Exit;
if (R.State = dsError)
and (FileName <> '')
then begin
List := TGDBMINameValueList.Create(R);
MessageDlg('Debugger', Format('Failed to load file: %s', [DeleteEscapeChars((List.Values['msg']))]), mtError, [mbOK], 0);
List.Free;
Cmd := TGDBMIDebuggerCommandChangeFilename.Create(Self, S);
Cmd.KeepFinished := True;
QueueCommand(Cmd);
// if filename = '', then command may be queued
if (FileName <> '') and (not Cmd.Success) then begin
MessageDlg('Debugger', Format('Failed to load file: %s', [Cmd.ErrorMsg]), mtError, [mbOK], 0);
Cmd.Cancel;
Cmd.KeepFinished := False;
SetState(dsStop);
Exit;
end;
if not (inherited ChangeFileName) then Exit;
if State = dsError then Exit;
if FileName = ''
then begin
Result := True;
Exit;
end
else begin
Cmd.KeepFinished := False;
end;
if tfHasSymbols in FTargetInfo.TargetFlags
then begin
// Force setting language
// Setting extensions dumps GDB (bug #508)
if not ExecuteCommand('-gdb-set language pascal', []) then exit;
if State=dsError then exit;
(*
ExecuteCommand('-gdb-set extension-language .lpr pascal', False);
if not FHasSymbols then Exit; // file-exec-and-symbols not allways result in no symbols
ExecuteCommand('-gdb-set extension-language .lrs pascal', False);
ExecuteCommand('-gdb-set extension-language .dpr pascal', False);
ExecuteCommand('-gdb-set extension-language .pas pascal', False);
ExecuteCommand('-gdb-set extension-language .pp pascal', False);
ExecuteCommand('-gdb-set extension-language .inc pascal', False);
*)
end;
if not (inherited ChangeFileName) then Exit;
Result:=true;
end;
@ -5388,7 +5434,7 @@ begin
CancelAllQueued;
if (DebugProcess <> nil) and DebugProcess.Running then begin
if State = dsRun then GDBPause(True);
ExecuteCommand('-gdb-exit', []);
ExecuteCommand('-gdb-exit', [], []);
end;
inherited Done;
finally
@ -5590,14 +5636,6 @@ begin
end;
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AFlags: TGDBMICmdFlags): Boolean;
var
R: TGDBMIExecResult;
begin
Result := ExecuteCommandFull(ACommand, [], AFlags, nil, 0, R);
end;
function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
const AValues: array of const; const AFlags: TGDBMICmdFlags): Boolean;
var
@ -6680,7 +6718,7 @@ end;
procedure TGDBMIDebugger.TestCmd(const ACommand: String);
begin
ExecuteCommand(ACommand, [cfIgnoreError]);
ExecuteCommand(ACommand, [], [cfIgnoreError]);
end;
{%region ***** BreakPoints ***** }