mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 03:53:40 +02:00
90adaffa46
* Upgraded gdb debugger to gdb/mi debugger * Set default value for autpopoup * Added Clear popup to debugger output window git-svn-id: trunk@862 -
795 lines
21 KiB
ObjectPascal
795 lines
21 KiB
ObjectPascal
{ $Id$ }
|
|
{ ----------------------------------------------
|
|
GDBDebugger.pp - Debugger class forGDB
|
|
----------------------------------------------
|
|
|
|
@created(Wed Feb 23rd WET 2002)
|
|
@lastmod($Date$)
|
|
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
|
|
|
This unit contains debugger class for the GDB/MI debugger.
|
|
|
|
|
|
/***************************************************************************
|
|
* *
|
|
* This program is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
***************************************************************************/
|
|
}
|
|
unit GDBMIDebugger;
|
|
|
|
{$mode objfpc}
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Process, Debugger, CmdLineDebugger;
|
|
|
|
|
|
type
|
|
TGDBMIProgramInfo = record
|
|
State: TDBGState;
|
|
BreakPoint: Integer; // ID of Breakpoint hit
|
|
Signal: Integer; // Signal no if we hit one
|
|
SignalText: String; // Signal text if we hit one
|
|
end;
|
|
|
|
|
|
TGDBMIDebugger = class(TCmdLineDebugger)
|
|
private
|
|
FCommandQueue: TStringList;
|
|
FHasSymbols: Boolean;
|
|
FTargetPID: Integer;
|
|
function FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
|
|
procedure GDBRun;
|
|
procedure GDBPause;
|
|
procedure GDBStart;
|
|
procedure GDBStop;
|
|
procedure GDBStepOver;
|
|
procedure GDBStepInto;
|
|
procedure GDBRunTo(const ASource: String; const ALine: Integer);
|
|
procedure GDBJumpTo(const ASource: String; const ALine: Integer);
|
|
function ProcessResult(const AIgnoreError: Boolean; var AResultValues: String): Boolean;
|
|
function ProcessRunning: Boolean;
|
|
function ProcessStopped(const AParams: String): Boolean;
|
|
function ExecuteCommand(const ACommand: String): Boolean; overload;
|
|
function ExecuteCommand(const ACommand: String; var AResultValues: String): Boolean; overload;
|
|
function ExecuteCommand(const ACommand: String; AValues: array of const): Boolean; overload;
|
|
function ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String): Boolean; overload;
|
|
function ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultValues: String): Boolean; overload;
|
|
protected
|
|
function ChangeFileName: Boolean; override;
|
|
function CreateBreakPoints: TDBGBreakPoints; override;
|
|
function CreateWatches: TDBGWatches; override;
|
|
function GetSupportedCommands: TDBGCommands; override;
|
|
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
|
|
public
|
|
constructor Create; {override;}
|
|
destructor Destroy; override;
|
|
|
|
procedure Init; override; // Initializes external debugger
|
|
procedure Done; override; // Kills external debugger
|
|
// internal testing
|
|
procedure TestCmd(const ACommand: String); override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Dialogs;
|
|
|
|
type
|
|
TGDBMIBreakPoint = class(TDBGBreakPoint)
|
|
private
|
|
FBreakID: Integer;
|
|
procedure SetBreakPoint;
|
|
protected
|
|
procedure DoActionChange; override;
|
|
procedure DoEnableChange; override;
|
|
procedure DoExpressionChange; override;
|
|
procedure DoStateChange; override;
|
|
procedure SetLocation(const ASource: String; const ALine: Integer); override;
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
procedure Hit;
|
|
end;
|
|
|
|
TGDBMIWatch = class(TDBGWatch)
|
|
private
|
|
protected
|
|
procedure DoEnableChange; override;
|
|
function GetValue: String; override;
|
|
function GetValid: Boolean; override;
|
|
procedure SetExpression(const AValue: String); override;
|
|
procedure SetValue(const AValue: String); override;
|
|
public
|
|
end;
|
|
|
|
function CreateValueList(AResultValues: String): TStringList;
|
|
var
|
|
n: Integer;
|
|
InString: Boolean;
|
|
InList: Integer;
|
|
begin
|
|
Result := TStringList.Create;
|
|
if AResultValues = '' then Exit;
|
|
|
|
// strip surrounding '[]' and '{}' first
|
|
case AResultValues[1] of
|
|
'[': begin
|
|
if AResultValues[Length(AResultValues)] = ']'
|
|
then begin
|
|
Delete(AResultValues, Length(AResultValues), 1);
|
|
Delete(AResultValues, 1, 1);
|
|
end;
|
|
end;
|
|
'{': begin
|
|
if AResultValues[Length(AResultValues)] = '}'
|
|
then begin
|
|
Delete(AResultValues, Length(AResultValues), 1);
|
|
Delete(AResultValues, 1, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
n := 1;
|
|
InString := False;
|
|
InList := 0;
|
|
while (n <= Length(AResultValues)) do
|
|
begin
|
|
if InString
|
|
then begin
|
|
if AResultValues[n] = '"'
|
|
then begin
|
|
InString := False;
|
|
Delete(AResultValues, n, 1);
|
|
Continue;
|
|
end;
|
|
end
|
|
else begin
|
|
if InList > 0
|
|
then begin
|
|
if AResultValues[n] in [']', '}']
|
|
then Dec(InList);
|
|
end
|
|
else begin
|
|
if AResultValues[n] = ','
|
|
then begin
|
|
Result.Add(Copy(AResultValues, 1, n - 1));
|
|
Delete(AResultValues, 1, n);
|
|
n := 1;
|
|
Continue;
|
|
end
|
|
else if AResultValues[n] = '"'
|
|
then begin
|
|
InString := True;
|
|
Delete(AResultValues, n, 1);
|
|
Continue;
|
|
end;
|
|
end;
|
|
if AResultValues[n] in ['[', '{']
|
|
then Inc(InList);
|
|
end;
|
|
Inc(n);
|
|
end;
|
|
if AResultValues <> ''
|
|
then Result.Add(AResultValues);
|
|
end;
|
|
|
|
|
|
|
|
{ =========================================================================== }
|
|
{ TGDBMIDebugger }
|
|
{ =========================================================================== }
|
|
|
|
function TGDBMIDebugger.ChangeFileName: Boolean;
|
|
var
|
|
S: String;
|
|
begin
|
|
SendCmdLn('-file-exec-and-symbols %s', [FileName]);
|
|
S := ReadLine(True);
|
|
FHasSymbols := Pos('no debugging symbols', S) = 0;
|
|
if not FHasSymbols
|
|
then WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
|
|
Result := ProcessResult(True, S) and inherited ChangeFileName;
|
|
|
|
if Result
|
|
then begin
|
|
ExecuteCommand('set extention-language .lpr pascal');
|
|
ExecuteCommand('set extention-language .lrc pascal');
|
|
ExecuteCommand('set extention-language .dpr pascal');
|
|
ExecuteCommand('set extention-language .pas pascal');
|
|
ExecuteCommand('set extention-language .pp pascal');
|
|
ExecuteCommand('set extention-language .inc pascal');
|
|
end;
|
|
end;
|
|
|
|
constructor TGDBMIDebugger.Create;
|
|
begin
|
|
FCommandQueue := TStringList.Create;
|
|
FTargetPID := 0;
|
|
inherited Create;
|
|
end;
|
|
|
|
function TGDBMIDebugger.CreateBreakPoints: TDBGBreakPoints;
|
|
begin
|
|
Result := TDBGBreakPoints.Create(Self, TGDBMIBreakPoint);
|
|
end;
|
|
|
|
function TGDBMIDebugger.CreateWatches: TDBGWatches;
|
|
begin
|
|
Result := TDBGWatches.Create(Self, TGDBMIWatch);
|
|
end;
|
|
|
|
destructor TGDBMIDebugger.Destroy;
|
|
begin
|
|
inherited;
|
|
FreeAndNil(FCommandQueue);
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.Done;
|
|
begin
|
|
if State = dsRun then GDBPause;
|
|
ExecuteCommand('-gdb-exit');
|
|
inherited Done;
|
|
end;
|
|
|
|
function TGDBMIDebugger.ExecuteCommand(const ACommand: String): Boolean;
|
|
var
|
|
S: String;
|
|
begin
|
|
Result := ExecuteCommand(ACommand, [], S);
|
|
end;
|
|
|
|
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; var AResultValues: String): Boolean;
|
|
begin
|
|
Result := ExecuteCommand(ACommand, [], AResultValues);
|
|
end;
|
|
|
|
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const): Boolean;
|
|
var
|
|
S: String;
|
|
begin
|
|
Result := ExecuteCommand(ACommand, AValues, S);
|
|
end;
|
|
|
|
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; var AResultValues: String): Boolean;
|
|
begin
|
|
Result := ExecuteCommand(ACommand, AValues, False, AResultValues);
|
|
end;
|
|
|
|
function TGDBMIDebugger.ExecuteCommand(const ACommand: String; AValues: array of const; const AIgnoreError: Boolean; var AResultValues: String): Boolean;
|
|
begin
|
|
FCommandQueue.Add(ACommand);
|
|
if FCommandQueue.Count > 1 then Exit;
|
|
repeat
|
|
SendCmdLn(FCommandQueue[0], AValues);
|
|
Result := ProcessResult(AIgnoreError, AResultValues) and ((State <> dsRun) or ProcessRunning);
|
|
FCommandQueue.Delete(0);
|
|
until not Result or (FCommandQueue.Count = 0);
|
|
end;
|
|
|
|
function TGDBMIDebugger.FindBreakpoint(const ABreakpoint: Integer): TDBGBreakPoint;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
if ABreakpoint > 0
|
|
then
|
|
for n := 0 to Breakpoints.Count - 1 do
|
|
begin
|
|
Result := Breakpoints[n];
|
|
if TGDBMIBreakPoint(Result).FBreakID = ABreakpoint
|
|
then Exit;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBJumpTo(const ASource: String; const ALine: Integer);
|
|
begin
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBPause;
|
|
begin
|
|
SendBreak(FTargetPID);
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBRun;
|
|
begin
|
|
case State of
|
|
dsIdle, dsStop: begin
|
|
GDBStart;
|
|
if State = dsPause
|
|
then begin
|
|
ExecuteCommand('-exec-continue');
|
|
end
|
|
else begin
|
|
//error???
|
|
end;
|
|
end;
|
|
dsPause: begin
|
|
ExecuteCommand('-exec-continue');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBRunTo(const ASource: String; const ALine: Integer);
|
|
begin
|
|
if State in [dsRun, dsError] then Exit;
|
|
|
|
ExecuteCommand('-exec-until %s:%d', [ASource, ALine]);
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBStart;
|
|
var
|
|
S: String;
|
|
begin
|
|
if State in [dsIdle, dsStop]
|
|
then begin
|
|
if FHasSymbols
|
|
then begin
|
|
ExecuteCommand('-break-insert -t main');
|
|
ExecuteCommand('-exec-run');
|
|
|
|
// try to find PID
|
|
SendCmdLn('info program', []);
|
|
ReadLine; // skip repeated command
|
|
S := ReadLine;
|
|
FTargetPID := StrToIntDef(GetPart('child process ', '.', S), 0);
|
|
if ProcessResult(False, S)
|
|
then SetState(dsPause);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBStepInto;
|
|
begin
|
|
case State of
|
|
dsIdle, dsStop: begin
|
|
GDBStart;
|
|
end;
|
|
dsPause: begin
|
|
ExecuteCommand('-exec-step');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBStepOver;
|
|
begin
|
|
case State of
|
|
dsIdle, dsStop: begin
|
|
GDBStart;
|
|
end;
|
|
dsPause: begin
|
|
ExecuteCommand('-exec-next');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.GDBStop;
|
|
begin
|
|
if State = dsRun
|
|
then GDBPause;
|
|
|
|
if State = dsPause
|
|
then begin
|
|
// not supported yet
|
|
// ExecuteCommand('-exec-abort');
|
|
ExecuteCommand('kill');
|
|
SetState(dsStop); //assume stop until abort is supported;
|
|
end;
|
|
end;
|
|
|
|
function TGDBMIDebugger.GetSupportedCommands: TDBGCommands;
|
|
begin
|
|
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak{, dcWatch}]
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.Init;
|
|
begin
|
|
if CreateDebugProcess('/usr/bin/gdb -silent -i mi')
|
|
then begin
|
|
ReadLine; //flush first line
|
|
ExecuteCommand('-gdb-set confirm off');
|
|
ExecuteCommand('-gdb-set language pascal');
|
|
inherited Init;
|
|
end
|
|
else begin
|
|
if DebugProcess = nil
|
|
then MessageDlg('Debugger', 'Failed to create debug process for unknown reason', mtError, [mbOK], 0)
|
|
else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0);
|
|
SetState(dsError);
|
|
end;
|
|
end;
|
|
|
|
function TGDBMIDebugger.ProcessResult(const AIgnoreError: Boolean; var AResultValues: String): Boolean;
|
|
var
|
|
S: String;
|
|
begin
|
|
Result := False;
|
|
S := StripLN(ReadLine);
|
|
while DebugProcessRunning and (S <> '(gdb) ') do
|
|
begin
|
|
if S <> ''
|
|
then begin
|
|
case S[1] of
|
|
'^': begin // result-record
|
|
AResultValues := S;
|
|
S := GetPart('^', ',', AResultValues);
|
|
if S = 'done'
|
|
then begin
|
|
Result := True;
|
|
end
|
|
else if S = 'running'
|
|
then begin
|
|
Result := True;
|
|
SetState(dsRun);
|
|
end
|
|
else if S = 'error'
|
|
then begin
|
|
Result := True;
|
|
if not AIgnoreError
|
|
then SetState(dsError);
|
|
end
|
|
else if S = 'exit'
|
|
then begin
|
|
Result := True;
|
|
SetState(dsIdle);
|
|
end
|
|
else WriteLN('[WARNING] Debugger: Unknown result class: ', S);
|
|
end;
|
|
'~': begin // console-stream-output
|
|
WriteLN('[Debugger] Console output: ', S);
|
|
end;
|
|
'@': begin // target-stream-output
|
|
WriteLN('[Debugger] Target output: ', S);
|
|
end;
|
|
'&': begin // log-stream-output
|
|
WriteLN('[Debugger] Log output: ', S);
|
|
end;
|
|
'*', '+', '=': begin
|
|
WriteLN('[WARNING] Debugger: Unexpected async-record: ', S);
|
|
end;
|
|
else
|
|
WriteLN('[WARNING] Debugger: Unknown record: ', S);
|
|
end;
|
|
end;
|
|
S := StripLN(ReadLine);
|
|
end;
|
|
end;
|
|
|
|
function TGDBMIDebugger.ProcessRunning: Boolean;
|
|
var
|
|
S, AsyncClass: String;
|
|
idx: Integer;
|
|
begin
|
|
Result := True;
|
|
|
|
S := StripLN(ReadLine);
|
|
while DebugProcessRunning and (S <> '(gdb) ') do
|
|
begin
|
|
if S <> ''
|
|
then begin
|
|
case S[1] of
|
|
'^': begin
|
|
WriteLN('[WARNING] Debugger: unexpected result-record: ', S);
|
|
end;
|
|
'~': begin // console-stream-output
|
|
WriteLN('[Debugger] Console output: ', S);
|
|
end;
|
|
'@': begin // target-stream-output
|
|
WriteLN('[Debugger] Target output: ', S);
|
|
end;
|
|
'&': begin // log-stream-output
|
|
WriteLN('[Debugger] Log output: ', S);
|
|
end;
|
|
'*': begin // exec-async-output
|
|
AsyncClass := GetPart('*', ',', S);
|
|
if AsyncClass = 'stopped'
|
|
then begin
|
|
ProcessStopped(S);
|
|
end
|
|
// Known, but undocumented classes
|
|
else if AsyncClass = 'started'
|
|
then begin
|
|
end
|
|
else if AsyncClass = 'disappeared'
|
|
then begin
|
|
end
|
|
else begin
|
|
// Assume targetoutput, strip char and continue
|
|
WriteLN('[DBGTGT] *');
|
|
S := AsyncClass + S;
|
|
Continue;
|
|
end;
|
|
end;
|
|
'+': begin // status-async-output
|
|
WriteLN('[Debugger] Status output: ', S);
|
|
end;
|
|
'=': begin // notify-async-output
|
|
WriteLN('[Debugger] Notify output: ', S);
|
|
end;
|
|
else
|
|
// since target output isn't prefixed (yet?)
|
|
// one of our known commands could be part of it.
|
|
idx := Pos('*stopped', S);
|
|
if idx > 0
|
|
then begin
|
|
WriteLN('[DBGTGT] ', Copy(S, 1, idx - 1));
|
|
Delete(S, 1, idx - 1);
|
|
Continue;
|
|
end
|
|
else begin
|
|
// normal target output
|
|
WriteLN('[DBGTGT] ', S);
|
|
end;
|
|
end;
|
|
end;
|
|
S := StripLN(ReadLine);
|
|
end;
|
|
end;
|
|
|
|
function TGDBMIDebugger.ProcessStopped(const AParams: String): Boolean;
|
|
procedure FrameToLocation(const AFrame: String);
|
|
var
|
|
Frame: TStringList;
|
|
Location: TDBGLocationRec;
|
|
begin
|
|
Frame := CreateValueList(AFrame);
|
|
|
|
Location.Adress := Pointer(StrToIntDef(Frame.Values['addr'], 0));
|
|
Location.FuncName := Frame.Values['func'];
|
|
Location.SrcFile := Frame.Values['file'];
|
|
Location.SrcLine := StrToIntDef(Frame.Values['line'], -1);
|
|
|
|
Frame.Free;
|
|
DoCurrent(Location);
|
|
end;
|
|
var
|
|
List: TStringList;
|
|
S, Reason: String;
|
|
BreakPoint: TGDBMIBreakPoint;
|
|
begin
|
|
Result := True;
|
|
List := CreateValueList(AParams);
|
|
Reason := List.Values['reason'];
|
|
if Reason = 'exited-normally'
|
|
then begin
|
|
SetState(dsStop);
|
|
end
|
|
else if Reason = 'exited'
|
|
then begin
|
|
SetExitCode(StrToIntDef(List.Values['exit-code'], 0));
|
|
SetState(dsStop);
|
|
end
|
|
else if Reason = 'exited-signalled'
|
|
then begin
|
|
SetState(dsStop);
|
|
// TODO: define signal no
|
|
DoException(0, List.Values['signal-name']);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else if Reason = 'signal-received'
|
|
then begin
|
|
// TODO: check to run (un)handled
|
|
// TODO: define signal no
|
|
SetState(dsPause);
|
|
S := List.Values['signal-name'];
|
|
if S <> 'SIGINT'
|
|
then DoException(0, S);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else if Reason = 'breakpoint-hit'
|
|
then begin
|
|
BreakPoint := TGDBMIBreakPoint(FindBreakpoint(StrToIntDef(List.Values['bkptno'], -1)));
|
|
if BreakPoint <> nil
|
|
then begin
|
|
BreakPoint.Hit;
|
|
if (bpaStop in BreakPoint.Actions)
|
|
then begin
|
|
SetState(dsPause);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else begin
|
|
ExecuteCommand('-exec-continue');
|
|
end;
|
|
end;
|
|
end
|
|
else if Reason = 'function-finished'
|
|
then begin
|
|
SetState(dsPause);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else if Reason = 'end-stepping-range'
|
|
then begin
|
|
SetState(dsPause);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else if Reason = 'location-reached'
|
|
then begin
|
|
SetState(dsPause);
|
|
FrameToLocation(List.Values['frame']);
|
|
end
|
|
else begin
|
|
Result := False;
|
|
WriteLN('[WARNING] Debugger: Unknown stopped reason: ', Reason);
|
|
end;
|
|
|
|
List.Free;
|
|
end;
|
|
|
|
function TGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
|
|
begin
|
|
case ACommand of
|
|
dcRun: GDBRun;
|
|
dcPause: GDBPause;
|
|
dcStop: GDBStop;
|
|
dcStepOver: GDBStepOver;
|
|
dcStepInto: GDBStepInto;
|
|
dcRunTo: GDBRunTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
|
|
dcJumpto: GDBJumpTo(String(APArams[0].VAnsiString), APArams[1].VInteger);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TGDBMIDebugger.TestCmd(const ACommand: String);
|
|
begin
|
|
ExecuteCommand(ACommand);
|
|
end;
|
|
|
|
{ =========================================================================== }
|
|
{ TGDBMIBreakPoint }
|
|
{ =========================================================================== }
|
|
|
|
constructor TGDBMIBreakPoint.Create(ACollection: TCollection);
|
|
begin
|
|
inherited Create(ACollection);
|
|
FBreakID := 0;
|
|
end;
|
|
|
|
destructor TGDBMIBreakPoint.Destroy;
|
|
begin
|
|
if FBreakID <> 0
|
|
then begin
|
|
TGDBMIDebugger(Debugger).ExecuteCommand('-break-delete %d', [FBreakID]);
|
|
end;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.DoActionChange;
|
|
begin
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.DoEnableChange;
|
|
const
|
|
CMD: array[Boolean] of String = ('disable', 'enable');
|
|
begin
|
|
if FBreakID = 0 then Exit;
|
|
|
|
TGDBMIDebugger(Debugger).ExecuteCommand('-break-%s %d', [CMD[Enabled], FBreakID]);
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.DoExpressionChange;
|
|
begin
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.DoStateChange;
|
|
begin
|
|
inherited;
|
|
if (Debugger.State = dsStop)
|
|
and (FBreakID = 0)
|
|
then SetBreakpoint;
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.Hit;
|
|
begin
|
|
SetHitCount(HitCount + 1);
|
|
|
|
if bpaEnableGroup in Actions
|
|
then; //TODO
|
|
if bpaDisableGroup in Actions
|
|
then; //TODO
|
|
end;
|
|
|
|
procedure TGDBMIBreakPoint.SetBreakpoint;
|
|
var
|
|
S: String;
|
|
ResultList, BkptList: TStringList;
|
|
begin
|
|
TGDBMIDebugger(Debugger).ExecuteCommand('-break-insert %s:%d', [Source, Line], True, S);
|
|
ResultList := CreateValueList(S);
|
|
BkptList := CreateValueList(ResultList.Values['bkpt']);
|
|
FBreakID := StrToIntDef(BkptList.Values['number'], 0);
|
|
SetHitCount(StrToIntDef(BkptList.Values['times'], 0));
|
|
SetValid(FBreakID <> 0);
|
|
DoEnableChange;
|
|
ResultList.Free;
|
|
BkptList.Free;
|
|
end;
|
|
|
|
|
|
procedure TGDBMIBreakPoint.SetLocation(const ASource: String; const ALine: Integer);
|
|
begin
|
|
inherited;
|
|
if TGDBMIDebugger(Debugger).State in [dsStop, dsPause, dsIdle]
|
|
then SetBreakpoint;
|
|
end;
|
|
|
|
{ =========================================================================== }
|
|
{ TGDBMIWatch }
|
|
{ =========================================================================== }
|
|
|
|
procedure TGDBMIWatch.DoEnableChange;
|
|
begin
|
|
end;
|
|
|
|
function TGDBMIWatch.GetValue: String;
|
|
begin
|
|
if (Debugger.State in [dsStop, dsPause, dsIdle])
|
|
and Valid
|
|
then begin
|
|
end
|
|
else Result := inherited GetValue;
|
|
end;
|
|
|
|
function TGDBMIWatch.GetValid: Boolean;
|
|
begin
|
|
Result:=false;
|
|
end;
|
|
|
|
procedure TGDBMIWatch.SetExpression(const AValue: String);
|
|
begin
|
|
if (AValue <> Expression)
|
|
and (Debugger.State in [dsStop, dsPause, dsIdle])
|
|
then begin
|
|
//TGDBMIDebugger(Debugger).SendCmdLn('', True);
|
|
end;
|
|
end;
|
|
|
|
procedure TGDBMIWatch.SetValue(const AValue: String);
|
|
begin
|
|
end;
|
|
|
|
end.
|
|
{ =============================================================================
|
|
$Log$
|
|
Revision 1.1 2002/03/09 02:03:59 lazarus
|
|
MWE:
|
|
* Upgraded gdb debugger to gdb/mi debugger
|
|
* Set default value for autpopoup
|
|
* Added Clear popup to debugger output window
|
|
|
|
Revision 1.6 2002/02/20 23:33:24 lazarus
|
|
MWE:
|
|
+ Published OnClick for TMenuItem
|
|
+ Published PopupMenu property for TEdit and TMemo (Doesn't work yet)
|
|
* Fixed debugger running twice
|
|
+ Added Debugger output form
|
|
* Enabled breakpoints
|
|
|
|
Revision 1.5 2002/02/06 08:58:29 lazarus
|
|
MG: fixed compiler warnings and asking to create non existing files
|
|
|
|
Revision 1.4 2002/02/05 23:16:48 lazarus
|
|
MWE: * Updated tebugger
|
|
+ Added debugger to IDE
|
|
|
|
Revision 1.3 2001/11/12 19:28:23 lazarus
|
|
MG: fixed create, virtual constructors makes no sense
|
|
|
|
Revision 1.2 2001/11/06 23:59:13 lazarus
|
|
MWE: + Initial breakpoint support
|
|
+ Added exeption handling on process.free
|
|
|
|
Revision 1.1 2001/11/05 00:12:51 lazarus
|
|
MWE: First steps of a debugger.
|
|
|
|
|
|
}
|