paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 03:20:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

MWE: * Updated tebugger

Browse Source 
+ Added debugger to IDE

git-svn-id: trunk@666 -
This commit is contained in:
lazarus 2002-02-05 23:16:48 +00:00
parent c64d618c01
commit 5e00188a21
15 changed files with 1029 additions and 486 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -63,6 +63,7 @@ debugger/tdbgoutputform.lfm svneol=native#text/plain
debugger/test/debugtest.pp svneol=native#text/pascal
debugger/test/debugtestform.pp svneol=native#text/pascal
debugger/test/examples/testcntr.pp svneol=native#text/pascal
debugger/test/examples/testwait.pp svneol=native#text/pascal
debugger/test/tdebugtesttorm.lfm svneol=native#text/plain
designer/abstractcompiler.pp svneol=native#text/pascal
designer/abstracteditor.pp svneol=native#text/pascal

74
debugger/cmdlinedebugger.pp
View File

@ -32,7 +32,7 @@ uses
Classes, Process, Debugger{, strmlsnr};
type
TCmdLineDebugger = class(TInternalDebugger)
TCmdLineDebugger = class(TDebugger)
private
FTargetProcess: TProcess; // The target process to be debugged
FDbgProcess: TProcess; // The process used to call the debugger
@ -59,6 +59,10 @@ type
procedure SendBreak(const AHandle: Integer);
function GetLine(var ABuffer: String): String;
function StripLN(const ALine: String): String;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
implementation
uses
@ -164,12 +168,47 @@ var
begin
idx := Pos(#10, ALine);
if idx = 0
then Result := ''
then begin
idx := Pos(#13, ALine);
if idx = 0
then begin
Result := ALine;
Exit;
end;
end
else begin
if (idx > 1)
and (ALine[idx - 1] = #13)
then Dec(idx);
Result := Copy(ALine, 1, idx - 1);
end;
Result := Copy(ALine, 1, idx - 1);
end;
function GetPart(const ASkipTo, AnEnd: String; var ASource: String): String;
var
idx: Integer;
begin
if ASkipTo <> ''
then begin
idx := Pos(ASkipTo, ASource);
if idx = 0
then begin
Result := '';
Exit;
end;
Delete(ASource, 1, idx + Length(ASkipTo) - 1);
end;
if AnEnd = ''
then idx := 0
else idx := Pos(AnEnd, ASource);
if idx = 0
then begin
Result := ASource;
ASource := '';
end
else begin
Result := Copy(ASource, 1, idx - 1);
Delete(ASource, 1, idx - 1);
end;
end;
@ -246,9 +285,9 @@ var
Line: String;
OutHandle: Integer;
WaitSet: Integer;
Count: Integer;
Idx, Count: Integer;
begin
WriteLN('[GetOutput] Enter');
WriteLN('[TCmdLineDebugger.GetOutput] Enter');
if (FTargetProcess = nil)
then OutHandle := 0
@ -261,7 +300,7 @@ begin
WaitSet := WaitForHandles([FDbgProcess.Output.Handle, OutHandle]);
if WaitSet = 0
then begin
WriteLN('[Getoutput] Error waiting ');
WriteLN('[TCmdLineDebugger.Getoutput] Error waiting ');
SetState(dsError);
Break;
end;
@ -273,7 +312,18 @@ begin
then while True do
begin
Line := GetLine(OutputBuf);
if Line = '' then Break;
if Line = ''
then begin
Idx := Pos(WaitPrompt, OutputBuf) - 1;
if (Idx > 0)
and (Idx = Length(OutputBuf) - Length(WaitPrompt))
then begin
// Waitpropmt at end of line, no newline found
Line := Copy(OutputBuf, 1, idx);
Delete(OutputBuf, 1, idx);
end
else Break;
end;
Line := StripLN(Line);
if Line <> '' then FOutputLines.Add(Line);
DoDbgOutput(Line);
@ -293,7 +343,7 @@ begin
end;
until OutputBuf = WaitPrompt;
WriteLN('[GetOutput] Leave');
WriteLN('[TCmdLineDebugger.GetOutput] Leave');
end;
procedure TCmdLineDebugger.KillTargetProcess;
@ -315,7 +365,9 @@ begin
if FDbgProcess <> nil
then begin
WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
DoDbgOutput('<' + ACommand + '>');
if ACommand <> ''
then FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
FDbgProcess.Input.Write(LF, 1);
if AGetOutput
then GetOutput;
@ -335,6 +387,10 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.4 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.3 2001/11/07 00:17:33 lazarus
MWE: Added IFDEFs so non linux targetswill compile

165
debugger/dbgbreakpoint.pp
View File

@ -37,6 +37,7 @@ type
TDBGBreakPoint = class(TCollectionItem)
private
FDebugger: TObject; // reference to our debugger
FGroup: TDBGBreakPointGroup;
FValid: Boolean;
FEnabled: Boolean;
FHitCount: Integer;
@ -47,19 +48,26 @@ type
procedure SetActions(const AValue: TDBGBreakPointActions);
procedure SetEnabled(const AValue: Boolean);
procedure SetExpression(const AValue: String);
procedure SetGroup(const AValue: TDBGBreakPointGroup);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure DoActionChange; virtual;
procedure DoEnableChange; virtual;
procedure DoExpressionChange; virtual;
procedure DoStateChange; virtual;
procedure SetHitCount(const AValue: Integer);
procedure SetLocation(const ASource: String; const ALine: Integer); virtual;
procedure SetValid(const AValue: Boolean);
property Debugger: TObject read FDebugger;
public
procedure AddDisableGroup(const AGroup: TDBGBreakPointGroup);
procedure AddEnableGroup(const AGroup: TDBGBreakPointGroup);
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
procedure RemoveEnableGroup(const AGroup: TDBGBreakPointGroup);
property Actions: TDBGBreakPointActions read FActions write SetActions;
property Enabled: Boolean read FEnabled write SetEnabled;
property Group: TDBGBreakPointGroup read FGroup write SetGroup;
property HitCount: Integer read FHitCount;
property Expression: String read FExpression write SetExpression;
property Source: String read FSource;
@ -73,36 +81,42 @@ type
function GetItem(const AnIndex: Integer): TDBGBreakPoint;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPoint);
protected
procedure DoStateChange;
public
constructor Create(const ADebugger: TObject);
constructor Create(const ADebugger: TObject; const ABreakPointClass: TDBGBreakPointClass);
function Add(const ASource: String; const ALine: Integer): TDBGBreakPoint;
function Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
property Items[const AnIndex: Integer]: TDBGBreakPoint read GetItem write SetItem; default;
end;
TDBGBreakPointGroup = class(TCollectionItem)
private
FEnabled: Boolean;
FName: String;
FBreakpoints: TDBGBreakPoints;
FBreakpoints: TList;
function GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
procedure SetEnabled(const AValue: Boolean);
procedure SetName(const AValue: String);
protected
public
function Add(const ABreakPoint: TDBGBreakPoint): Integer;
function Count: Integer;
constructor Create(ACollection: TCollection); override;
procedure Delete(const AIndex: Integer);
destructor Destroy; override;
property Breakpoints: TDBGBreakPoints read FBreakpoints;
function Remove(const ABreakPoint: TDBGBreakPoint): Integer;
property Breakpoints[const AIndex: Integer]: TDBGBreakPoint read GetBreakpoint;
property Enabled: Boolean read FEnabled write SetEnabled;
property Name: String read FName write SetName;
end;
TDBGBreakPointGroups = class(TCollection)
private
FDebugger: TObject;
function GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGBreakPointGroup);
protected
public
constructor Create(const ADebugger: TObject);
constructor Create;
property Items[const AnIndex: Integer]: TDBGBreakPointGroup read GetItem write SetItem; default;
end;
@ -122,6 +136,18 @@ procedure TDBGBreakPoint.AddEnableGroup(const AGroup: TDBGBreakPointGroup);
begin
end;
procedure TDBGBreakPoint.AssignTo(Dest: TPersistent);
begin
if Dest is TDBGBreakPoint
then begin
TDBGBreakPoint(Dest).SetLocation(FSource, FLine);
TDBGBreakPoint(Dest).SetExpression(FExpression);
TDBGBreakPoint(Dest).SetActions(FActions);
TDBGBreakPoint(Dest).SetEnabled(FEnabled);
end
else inherited;
end;
constructor TDBGBreakPoint.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
@ -131,14 +157,24 @@ begin
FEnabled := False;
FHitCount := 0;
FExpression := '';
FGroup := nil;
FDebugger := TDBGBreakPoints(ACollection).FDebugger;
end;
destructor TDBGBreakPoint.Destroy;
procedure TDBGBreakPoint.DoActionChange;
begin
end;
procedure TDBGBreakPoint.DoEnableChange;
begin
end;
procedure TDBGBreakPoint.DoExpressionChange;
begin
end;
procedure TDBGBreakPoint.DoStateChange;
begin
TInternalDebugger(FDebugger).BreakRemove(Self);
inherited Destroy;
end;
procedure TDBGBreakPoint.RemoveDisableGroup(const AGroup: TDBGBreakPointGroup);
@ -154,7 +190,7 @@ begin
if FActions <> AValue
then begin
FActions := AValue;
TInternalDebugger(FDebugger).BreakActionChange(Self);
DoActionChange;
end;
end;
@ -163,7 +199,7 @@ begin
if FEnabled <> AValue
then begin
FEnabled := AValue;
TInternalDebugger(FDebugger).BreakEnableChange(Self);
DoEnableChange;
end;
end;
@ -172,7 +208,28 @@ begin
if FExpression <> AValue
then begin
FExpression := AValue;
TInternalDebugger(FDebugger).BreakExpressionChange(Self);
DoExpressionChange;
end;
end;
procedure TDBGBreakPoint.SetGroup(const AValue: TDBGBreakPointGroup);
var
Grp: TDBGBreakPointGroup;
begin
if FGroup <> AValue
then begin
if FGroup <> nil
then begin
Grp := FGroup;
FGroup := nil; // avoid second entrance
Grp.Remove(Self);
end;
FGroup := AValue;
if FGroup <> nil
then begin
FGroup.Add(Self);
end;
end;
end;
@ -185,7 +242,6 @@ procedure TDBGBreakPoint.SetLocation(const ASource: String; const ALine: Integer
begin
FSource := ASource;
FLine := ALine;
TInternalDebugger(FDebugger).BreakAdd(Self);
end;
procedure TDBGBreakPoint.SetValid(const AValue: Boolean);
@ -201,12 +257,34 @@ begin
Result.SetLocation(ASource, ALine);
end;
constructor TDBGBreakPoints.Create(const ADebugger: TObject);
constructor TDBGBreakPoints.Create(const ADebugger: TObject; const ABreakPointClass: TDBGBreakPointClass);
begin
inherited Create(TDBGBreakPoint);
inherited Create(ABreakPointClass);
FDebugger := ADebugger;
end;
procedure TDBGBreakPoints.DoStateChange;
var
n: Integer;
begin
for n := 0 to Count - 1 do
GetItem(n).DoStateChange;
end;
function TDBGBreakPoints.Find(const ASource: String; const ALine: Integer): TDBGBreakPoint;
var
n: Integer;
begin
for n := 0 to Count - 1 do
begin
Result := GetItem(n);
if (Result.Line = ALine)
and (Result.Source = ASource)
then Exit;
end;
Result := nil;
end;
function TDBGBreakPoints.GetItem(const AnIndex: Integer): TDBGBreakPoint;
begin
Result := TDBGBreakPoint(inherited GetItem(AnIndex));
@ -219,10 +297,31 @@ end;
{ TDBGBreakPointGroup }
function TDBGBreakPointGroup.Add(const ABreakPoint: TDBGBreakPoint): Integer;
begin
Result := FBreakpoints.IndexOf(ABreakPoint); //avoid dups
if Result = -1
then begin
Result := FBreakpoints.Add(ABreakPoint);
ABreakpoint.Group := Self;
end;
end;
function TDBGBreakPointGroup.Count: Integer;
begin
Result := FBreakpoints.Count;
end;
constructor TDBGBreakPointGroup.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FBreakpoints := TDBGBreakPoints.Create(TDBGBreakPointGroups(ACollection).FDebugger);
FBreakpoints := TList.Create;
FEnabled := True;
end;
procedure TDBGBreakPointGroup.Delete(const AIndex: Integer);
begin
Remove(TDBGBreakPoint(FBreakPoints[AIndex]));
end;
destructor TDBGBreakPointGroup.Destroy;
@ -231,9 +330,28 @@ begin
inherited Destroy;
end;
procedure TDBGBreakPointGroup.SetEnabled(const AValue: Boolean);
function TDBGBreakPointGroup.GetBreakpoint(const AIndex: Integer): TDBGBreakPoint;
begin
FEnabled := AValue;
Result := TDBGBreakPoint(FBreakPoints[AIndex]);
end;
function TDBGBreakPointGroup.Remove(const ABreakPoint: TDBGBreakPoint): Integer;
begin
Result := FBreakpoints.Remove(ABreakPoint);
if ABreakpoint.Group = Self
then ABreakpoint.Group := nil;
end;
procedure TDBGBreakPointGroup.SetEnabled(const AValue: Boolean);
var
n: Integer;
begin
if FEnabled <> AValue
then begin
FEnabled := AValue;
for n := 0 to FBreakPoints.Count - 1 do
TDBGBreakpoint(FBreakPoints[n]).Enabled := FEnabled;
end;
end;
procedure TDBGBreakPointGroup.SetName(const AValue: String);
@ -243,10 +361,9 @@ end;
{ TDBGBreakPointGroups }
constructor TDBGBreakPointGroups.Create(const ADebugger: TObject);
constructor TDBGBreakPointGroups.Create;
begin
inherited Create(TDBGBreakPointGroup);
FDebugger := ADebugger;
end;
function TDBGBreakPointGroups.GetItem(const AnIndex: Integer): TDBGBreakPointGroup;
@ -262,6 +379,10 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.6 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.5 2001/11/06 23:59:12 lazarus
MWE: + Initial breakpoint support
+ Added exeption handling on process.free

10
debugger/dbgoutputform.lrc
View File

@ -1,7 +1,7 @@
LazarusResources.Add('TDbgOutputForm','FORMDATA',
'TPF0'#14'TDbgOutputForm'#13'DbgOutputForm'#7'CAPTION'#6#12'Debug output'#8
+'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#4'LEFT'#3#239#0
+#6'HEIGHT'#3#150#0#3'TOP'#3#161#0#5'WIDTH'#3','#1#0#5'TMemo'#9'txtOutput'
+#4'Left'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'a'
+'lClient'#0#0#0
'TPF0'#14'TDbgOutputForm'#14'DbgOutputForm1'#7'CAPTION'#6#12'Debug output'
+#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#3'TOP'#2#10#4
+'LEFT'#2#10#6'HEIGHT'#3#150#0#5'WIDTH'#3'-'#1#0#5'TMemo'#9'txtOutput'#4'L'
+'eft'#2#8#3'Top'#2'h'#5'Width'#3'X'#2#6'Height'#3#150#0#5'Align'#7#8'alCl'
+'ient'#0#0#0
);

66
debugger/dbgwatch.pp
View File

@ -29,18 +29,25 @@ uses
Classes;
type
TDBGWatchClass = class of TDBGWatch;
TDBGWatch = class(TCollectionItem)
private
FDebugger: TObject; // reference to our debugger
FEnabled: Boolean;
FExpression: String;
FValue: String;
FOnChange: TNotifyEvent;
function GetValid: Boolean;
function GetValue: String;
procedure SetEnabled(const AValue: Boolean);
procedure SetExpression(const AValue: String);
procedure SetValue(const AValue: String);
protected
procedure DoEnableChange; virtual;
procedure DoStateChange; virtual;
function GetValue: String; virtual;
function GetValid: Boolean; virtual;
procedure SetExpression(const AValue: String); virtual;
procedure SetValue(const AValue: String); virtual;
property Debugger: TObject read FDebugger;
public
constructor Create(ACollection: TCollection); override;
property Enabled: Boolean read FEnabled write SetEnabled;
property Expression: String read FExpression write SetExpression;
property Valid: Boolean read GetValid;
@ -50,18 +57,38 @@ type
TDBGWatches = class(TCollection)
private
FDebugger: TObject; // reference to our debugger
function GetItem(const AnIndex: Integer): TDBGWatch;
procedure SetItem(const AnIndex: Integer; const AValue: TDBGWatch);
protected
procedure DoStateChange;
public
constructor Create;
constructor Create(const ADebugger: TObject; const AWatchClass: TDBGWatchClass);
property Items[const AnIndex: Integer]: TDBGWatch read GetItem write SetItem; default;
end;
implementation
implementation
uses
Debugger;
{ TDBGWatch }
constructor TDBGWatch.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FEnabled := False;
FDebugger := TDBGWatches(ACollection).FDebugger;
end;
procedure TDBGWatch.DoEnableChange;
begin
end;
procedure TDBGWatch.DoStateChange;
begin
end;
function TDBGWatch.GetValid: Boolean;
begin
Result := False;
@ -70,19 +97,21 @@ end;
function TDBGWatch.GetValue: String;
begin
if Valid
then begin
end
then Result := '<unknown>'
else Result := '<invalid>';
end;
procedure TDBGWatch.SetEnabled(const AValue: Boolean);
begin
FEnabled := AValue;
if FEnabled <> AValue
then begin
FEnabled := AValue;
DoEnableChange;
end;
end;
procedure TDBGWatch.SetExpression(const AValue: String);
begin
FExpression := AValue;
end;
procedure TDBGWatch.SetValue(const AValue: String);
@ -91,9 +120,18 @@ end;
{ TDBGWatches }
constructor TDBGWatches.Create;
constructor TDBGWatches.Create(const ADebugger: TObject; const AWatchClass: TDBGWatchClass);
begin
inherited Create(TDBGWatch);
FDebugger := ADebugger;
inherited Create(AWatchClass);
end;
procedure TDBGWatches.DoStateChange;
var
n: Integer;
begin
for n := 0 to Count - 1 do
GetItem(n).DoStateChange;
end;
function TDBGWatches.GetItem(const AnIndex: Integer): TDBGWatch;
@ -109,6 +147,10 @@ end;
end.
{ =============================================================================
$Log$
Revision 1.6 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.5 2001/11/06 23:59:13 lazarus
MWE: + Initial breakpoint support
+ Added exeption handling on process.free

143
debugger/debugger.pp
View File

@ -37,9 +37,40 @@ type
SrcLine: Integer;
end;
TDBGCommand = (dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak);
TDBGCommand = (dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch);
TDBGCommands = set of TDBGCommand;
TDBGState = (dsNone, dsIdle, dsStop, dsPause, dsRun, dsError);
(*
Debugger states
--------------------------------------------------------------------------
dsNone:
The debug object is created, but no instance of an external debugger
exists.
Initial state, leave with Init, enter with Done
dsIdle:
The external debugger is started, but no filename (or no other params
requred to start) were given.
dsStop:
(Optional) The execution of the target is stopped
The external debugger is loaded and ready to (re)start the execution
of the target.
Breakpoints, wathes etc can be defined
dsPause:
De debugger has paused the target. Targer variables canbe examined
dsRun:
The target is running.
dsError:
Something unforseen has happened. A shutdown of the debugger is in
most cases needed.
--------------------------------------------------------------------------
*)
TDBGOutputEvent = procedure(Sender: TObject; const AText: String) of object;
TDBGCurrentLineEvent = procedure(Sender: TObject; const ALocation: TDBGLocationRec) of object;
@ -47,6 +78,7 @@ type
TDebugger = class(TObject)
private
FArguments: String;
FBreakPoints: TDBGBreakPoints;
FBreakPointGroups: TDBGBreakPointGroups;
FFileName: String;
FState: TDBGState;
@ -57,17 +89,20 @@ type
FOnState: TNotifyEvent;
function GetState: TDBGState;
function ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
protected
protected
function CreateBreakPoints: TDBGBreakPoints; virtual;
function CreateWatches: TDBGWatches; virtual;
procedure DoCurrent(const ALocation: TDBGLocationRec);
procedure DoDbgOutput(const AText: String);
procedure DoOutput(const AText: String);
procedure DoState;
function GetFlags: TDBGCommands; virtual;
function GetCommands: TDBGCommands;
function GetSupportedCommands: TDBGCommands; virtual;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; virtual; abstract; // True if succesful
procedure SetFileName(const Value: String); virtual;
procedure SetState(const Value: TDBGState);
procedure SetFileName(const AValue: String); virtual;
procedure SetState(const AValue: TDBGState);
public
constructor Create;
constructor Create; virtual;
destructor Destroy; override;
procedure Init; virtual; // Initializes the debugger
@ -79,10 +114,12 @@ type
procedure StepInto;
procedure RunTo(const ASource: String; const ALine: Integer); virtual; // Executes til a certain point
procedure JumpTo(const ASource: String; const ALine: Integer); virtual; // No execute, only set exec point
property SupportedCommands: TDBGCommands read GetSupportedCommands; // All available commands of the debugger
property Arguments: String read FArguments write FArguments; // Arguments feed to the program
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpoints
property BreakPoints: TDBGBreakPoints read FBreakPoints; // list of all breakpoints
property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpointgroups
property Commands: TDBGCommands read GetCommands; // All current available commands of the debugger
property FileName: String read FFileName write SetFileName; // The name of the exe to be debugged
property Flags: TDBGCommands read GetFlags; // All available commands of the debugger
property State: TDBGState read FState; // The current stete of the debugger
property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
property OnCurrent: TDBGCurrentLineEvent read FOnCurrent write FOnCurrent; // Passes info about the current line being debugged
@ -91,17 +128,6 @@ type
property OnDbgOutput: TDBGOutputEvent read FOnDbgOutput write FOnDbgOutput;// Passes all debuggeroutput
end;
TInternalDebugger = class(TDebugger)
private
protected
public
procedure BreakActionChange(const ABreakPoint: TDBGBreakpoint); virtual;
procedure BreakAdd(const ABreakPoint: TDBGBreakpoint); virtual;
procedure BreakEnableChange(const ABreakPoint: TDBGBreakpoint); virtual;
procedure BreakExpressionChange(const ABreakPoint: TDBGBreakpoint); virtual;
procedure BreakRemove(const ABreakPoint: TDBGBreakpoint); virtual;
end;
implementation
uses
@ -109,11 +135,11 @@ uses
const
COMMANDMAP: array[TDBGState] of TDBGCommands = (
{dsNone } [dcBreak],
{dsIdle } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak],
{dsRun } [dcPause, dcStop, dcBreak],
{dsNone } [],
{dsIdle } [],
{dsStop } [dcRun, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch],
{dsPause} [dcRun, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch],
{dsRun } [dcPause, dcStop, dcBreak, dcWatch],
{dsError} []
);
@ -129,8 +155,19 @@ begin
FState := dsNone;
FArguments := '';
FFilename := '';
FBreakPointGroups := TDBGBreakPointGroups.Create(Self);
FWatches := TDBGWatches.Create;
FBreakPoints := CreateBreakPoints;
FWatches := CreateWatches;
FBreakPointGroups := TDBGBreakPointGroups.Create;
end;
function TDebugger.CreateBreakPoints: TDBGBreakPoints;
begin
Result := TDBGBreakPoints.Create(Self, TDBGBreakPoint);
end;
function TDebugger.CreateWatches: TDBGWatches;
begin
Result := TDBGWatches.Create(Self, TDBGWatch);
end;
destructor TDebugger.Destroy;
@ -174,12 +211,17 @@ begin
if Assigned(FOnState) then FOnState(Self);
end;
function TDebugger.GetCommands: TDBGCommands;
begin
Result := COMMANDMAP[State] * GetSupportedCommands;
end;
function TDebugger.GetState: TDBGState;
begin
Result := FState;
end;
function TDebugger.GetFlags: TDBGCommands;
function TDebugger.GetSupportedCommands: TDBGCommands;
begin
Result := [];
end;
@ -202,7 +244,7 @@ end;
function TDebugger.ReqCmd(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
begin
if FState = dsNone then Init;
if ACommand in (COMMANDMAP[FState] * Flags)
if ACommand in Commands
then Result := RequestCommand(ACommand, AParams)
else Result := False;
end;
@ -217,16 +259,24 @@ begin
ReqCmd(dcRunTo, [ASource, ALine]);
end;
procedure TDebugger.SetFileName(const Value: String);
procedure TDebugger.SetFileName(const AValue: String);
begin
FFileName := Value;
if FFileName <> AValue
then begin
if FState in [dsRun, dsPause]
then Stop;
FFileName := AValue;
if FFilename = ''
then SetState(dsIdle)
else SetState(dsStop);
end;
end;
procedure TDebugger.SetState(const Value: TDBGState);
procedure TDebugger.SetState(const AValue: TDBGState);
begin
if Value <> FState
if AValue <> FState
then begin
FState := Value;
FState := AValue;
DoState;
end;
end;
@ -246,32 +296,13 @@ begin
ReqCmd(dcStop, []);
end;
{ TInternalDebugger }
procedure TInternalDebugger.BreakActionChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TInternalDebugger.BreakAdd(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TInternalDebugger.BreakEnableChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TInternalDebugger.BreakExpressionChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TInternalDebugger.BreakRemove(const ABreakPoint: TDBGBreakpoint);
begin
end;
end.
{ =============================================================================
$Log$
Revision 1.6 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.5 2001/11/12 19:28:23 lazarus
MG: fixed create, virtual constructors makes no sense

306
debugger/gdbdebugger.pp
View File

@ -28,33 +28,33 @@ unit GDBDebugger;
interface
uses
Classes, Process, Debugger, CmdLineDebugger, DBGBreakPoint;
Classes, Process, Debugger, CmdLineDebugger, DBGBreakPoint, DBGWatch;
type
TGDBDebugger = class(TCmdLineDebugger)
private
FHasSymbols: Boolean;
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 SendCommand(const ACommand: String; Values: array of const): TStrings; // internally used by breakpoits and watches
procedure RunCommand(const ACommand: String);
function GetGDBState: TDBGState;
function GetLocation: TDBGLocationRec;
function GetGDBState: TDBGState;
protected
procedure BreakActionChange(const ABreakPoint: TDBGBreakpoint); override;
procedure BreakAdd(const ABreakPoint: TDBGBreakpoint); override;
procedure BreakEnableChange(const ABreakPoint: TDBGBreakpoint); override;
procedure BreakExpressionChange(const ABreakPoint: TDBGBreakpoint); override;
procedure BreakRemove(const ABreakPoint: TDBGBreakpoint); override;
function GetFlags: TDBGCommands; override;
function CreateBreakPoints: TDBGBreakPoints; override;
function CreateWatches: TDBGWatches; override;
function GetSupportedCommands: TDBGCommands; override;
procedure SetFileName(const AValue: String); override;
function RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean; override;
public
constructor Create;
constructor Create; override;
destructor Destroy; override;
procedure Init; override; // Initializes external debugger
@ -69,33 +69,48 @@ implementation
uses
SysUtils;
type
TGDBBreakPoint = class(TDBGBreakPoint)
private
FBreakID: Integer;
protected
procedure DoActionChange; override;
procedure DoEnableChange; override;
procedure DoExpressionChange; override;
procedure SetLocation(const ASource: String; const ALine: Integer); override;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
end;
TGDBWatch = 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;
{ TGDBDebugger }
procedure TGDBDebugger.BreakActionChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TGDBDebugger.BreakAdd(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TGDBDebugger.BreakEnableChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TGDBDebugger.BreakExpressionChange(const ABreakPoint: TDBGBreakpoint);
begin
end;
procedure TGDBDebugger.BreakRemove(const ABreakPoint: TDBGBreakpoint);
begin
end;
constructor TGDBDebugger.Create;
begin
inherited Create;
end;
function TGDBDebugger.CreateBreakPoints: TDBGBreakPoints;
begin
Result := TDBGBreakPoints.Create(Self, TGDBBreakPoint);
end;
function TGDBDebugger.CreateWatches: TDBGWatches;
begin
Result := TDBGWatches.Create(Self, TGDBWatch);
end;
destructor TGDBDebugger.Destroy;
begin
inherited;
@ -117,28 +132,22 @@ begin
SendBreak(TargetProcess.Handle);
end;
procedure TGDBDebugger.GDBRun;
procedure TGDBDebugger.GDBRun;
var
loc: TDBGLocationRec;
dState: TDBGState;
begin
case State of
dsIdle, dsStop: begin
CreateTargetProcess(FileName);
SendCmdLn('file %s', [FileName], True);
SendCmdLn('attach %d', [TargetProcess.Handle], True);
TargetProcess.Resume;
SetState(dsRun);
repeat
SendCmdLn('cont', True);
loc := GetLocation;
dState := GetGDBState;
until ((loc.FuncName <> 'HEAP') and (loc.FuncName <> '_start')) or (dState <> dsPause);
DoCurrent(loc);
SetState(dState);
GDBStart;
dState := GetGDBState;
if dState = dsPause
then begin
RunCommand('cont');
end
else begin
DoCurrent(GetLocation);
SetState(dState);
end;
end;
dsPause: begin
RunCommand('cont');
@ -148,16 +157,92 @@ end;
procedure TGDBDebugger.GDBRunTo(const ASource: String; const ALine: Integer);
begin
if State in [dsRun, dsError] then Exit;
SendCmdLn('tbreak %s:%d', [ASource, ALine], True);
GDBRun;
end;
procedure TGDBDebugger.GDBStart;
var
loc: TDBGLocationRec;
dState: TDBGState;
StopAdress: Integer;
idx: Integer;
S: String;
begin
if State in [dsIdle, dsStop]
then begin
CreateTargetProcess(FileName);
SendCommand('attach %d', [TargetProcess.Handle]);
TargetProcess.Resume;
SendCmdLn('cont', True);
S := SendCommand('tbreak main', [TargetProcess.Handle]).Text;
if Pos('Breakpoint', S) > 0
then begin
// TargetProcess.Resume;
SetState(dsRun);
StopAdress := -1;
end
else begin
// No symbols or no main
// Try to set a TBreak at first adress
S := SendCommand('info files', [TargetProcess.Handle]).Text;
StopAdress := StrToIntDef(StripLN('$' + GetPart('Entry point: 0x', '', S)), -1);
if StopAdress <> -1
then begin
S := SendCommand('x/2i 0x%x', [StopAdress]).Text;
GetLine(S); //ignore first line
S := GetPart('0x', ':', S);
StopAdress := StrToIntDef(StripLN('$' + GetPart('', ' ', S)), -1);
if StopAdress <> -1
then begin
SendCommand('tbreak *0x%x', [StopAdress]);
end;
end;
// TargetProcess.Resume;
SetState(dsRun);
end;
repeat
SendCmdLn('cont', True);
loc := GetLocation;
dState := GetGDBState;
until (loc.FuncName = 'main') or (Integer(loc.Adress) = StopAdress) or (dState <> dsPause);
end;
end;
procedure TGDBDebugger.GDBStepInto;
begin
RunCommand('step');
case State of
dsIdle, dsStop: begin
GDBStart;
DoCurrent(GetLocation);
SetState(GetGDBState);
end;
dsPause: begin
RunCommand('step');
end;
end;
end;
procedure TGDBDebugger.GDBStepOver;
begin
RunCommand('next');
case State of
dsIdle, dsStop: begin
GDBStart;
DoCurrent(GetLocation);
SetState(GetGDBState);
end;
dsPause: begin
RunCommand('next');
end;
end;
end;
procedure TGDBDebugger.GDBStop;
@ -183,18 +268,12 @@ begin
SetState(dState);
end;
function TGDBDebugger.GetFlags: TDBGCommands;
begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak]
end;
function TGDBDebugger.GetGDBState: TDBGState;
var
S: String;
begin
SendCmdLn('info program', True);
S := OutputLines.Text;
WriteLn('Info: ',S);
if Pos('stopped', S) > 0
then Result := dsPause
else if Pos('not being run', S) > 0
@ -247,6 +326,11 @@ begin
end;
end;
function TGDBDebugger.GetSupportedCommands: TDBGCommands;
begin
Result := [dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak{, dcWatch}]
end;
procedure TGDBDebugger.Init;
begin
WaitPrompt := '(gdb) ';
@ -281,6 +365,29 @@ begin
SetState(GetGDBState);
end;
function TGDBDebugger.SendCommand(const ACommand: String; Values: array of const): TStrings;
begin
SendCmdLn(ACommand, Values, True);
Result := OutputLines;
end;
procedure TGDBDebugger.SetFileName(const AValue: String);
begin
if AValue <> FileName
then begin
GDBStop;
inherited;
if FileName <> ''
then begin
SendCmdLn('file %s', [FileName], True);
FHasSymbols := Pos('no debugging symbols', OutputLines.Text) = 0;
if not FHasSymbols
then WriteLN('WARNING: File ''',FileName, ''' has no debug symbols');
end;
end;
end;
procedure TGDBDebugger.TestCmd(const ACommand: String);
begin
SetState(dsRun);
@ -289,9 +396,98 @@ begin
SetState(GetGDBState);
end;
{ TGDBBreakPoint }
constructor TGDBBreakPoint.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
FBreakID := 0;
end;
destructor TGDBBreakPoint.Destroy;
begin
if FBreakID <> 0
then begin
TGDBDebugger(Debugger).SendCommand('delete %d', [FBreakID]);
end;
inherited Destroy;
end;
procedure TGDBBreakPoint.DoActionChange;
begin
end;
procedure TGDBBreakPoint.DoEnableChange;
const
CMD: array[Boolean] of String = ('disable', 'enable');
begin
if FBreakID = 0 then Exit;
TGDBDebugger(Debugger).SendCommand('%s %d', [CMD[Enabled], FBreakID]);
end;
procedure TGDBBreakPoint.DoExpressionChange;
begin
end;
procedure TGDBBreakPoint.SetLocation(const ASource: String; const ALine: Integer);
var
idx: Integer;
S: String;
begin
if TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle]
then begin
S := TGDBDebugger(Debugger).SendCommand('break %s:%d', [ASource, ALine])[0];
idx := Pos(' at', S);
if idx >0
then begin
FBreakID := StrToIntDef(Copy(S, 12, idx - 12), 0);
end;
SetValid(FBreakID <> 0);
DoEnableChange;
end;
end;
{ TGDBWatch }
procedure TGDBWatch.DoEnableChange;
begin
end;
function TGDBWatch.GetValue: String;
begin
if (TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle])
and Valid
then begin
end
else Result := inherited GetValue;
end;
function TGDBWatch.GetValid: Boolean;
begin
end;
procedure TGDBWatch.SetExpression(const AValue: String);
begin
if (AValue <> Expression)
and (TGDBDebugger(Debugger).State in [dsStop, dsPause, dsIdle])
then begin
//TGDBDebugger(Debugger).SendCmdLn('', True);
end;
end;
procedure TGDBWatch.SetValue(const AValue: String);
begin
end;
end.
{ =============================================================================
$Log$
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

8
debugger/tdbgoutputform.lfm
View File

@ -1,11 +1,11 @@
object DbgOutputForm: TDbgOutputForm
object DbgOutputForm1: TDbgOutputForm
CAPTION = 'Debug output'
OnCreate = FormCreate
OnDestroy = FormDestroy
LEFT = 239
TOP = 10
LEFT = 10
HEIGHT = 150
TOP = 161
WIDTH = 300
WIDTH = 301
object txtOutput: TMemo
Left = 8
Top = 104

31
debugger/test/debugtestform.lrc
View File

@ -1,10 +1,10 @@
LazarusResources.Add('TDebugTestForm','FORMDATA',
'TPF0'#14'TDebugTestForm'#13'DebugTestForm'#7'CAPTION'#6#13'DebugTestForm'
+#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#4'LEFT'#3#239
+#0#6'HEIGHT'#3','#1#3'TOP'#3#161#0#5'WIDTH'#3'l'#2#0#7'TBUTTON'#7'cmdInit'
+#7'CAPTION'#6#4'Init'#4'LEFT'#2#10#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2
+'2'#7'OnClick'#7#12'cmdInitClick'#0#0#7'TBUTTON'#7'cmdDone'#7'CAPTION'#6#4
+'Done'#4'LEFT'#2'F'#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7
'TPF0'#14'TDebugTestForm'#14'DebugTestForm1'#7'CAPTION'#6#13'DebugTestForm'
+#4'LEFT'#2#25#6'HEIGHT'#3'@'#1#3'TOP'#2#25#5'WIDTH'#3'l'#2#8'OnCreate'#7
+#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#0#7'TBUTTON'#7'cmdInit'#7
+'CAPTION'#6#4'Init'#4'LEFT'#2#10#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'
+#7'OnClick'#7#12'cmdInitClick'#0#0#7'TBUTTON'#7'cmdDone'#7'CAPTION'#6#4'D'
+'one'#4'LEFT'#2'F'#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7
+#12'cmdDoneClick'#0#0#7'TBUTTON'#6'cmdRun'#7'CAPTION'#6#3'Run'#4'LEFT'#3
+#130#0#6'HEIGHT'#2#25#3'TOP'#2''''#5'WIDTH'#2'2'#7'OnClick'#7#11'cmdRunCl'
+'ick'#0#0#7'TBUTTON'#8'cmdPause'#7'CAPTION'#6#5'Pause'#4'LEFT'#3#190#0#6
@ -19,14 +19,23 @@
+'Left'#2':'#3'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#9'lblSource'#4'Left'#3
+#166#0#3'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblLine'#4'Left'#3#18#1#3
+'Top'#2'h'#5'WIDTH'#2'd'#0#0#6'TLabel'#7'lblFunc'#4'Left'#3'~'#1#3'Top'#2
+'h'#5'WIDTH'#2'd'#0#0#5'TMemo'#6'txtLog'#4'Left'#2#8#3'Top'#3#132#0#5'Wid'
+'h'#5'WIDTH'#2'd'#0#0#5'TMemo'#6'txtLog'#4'Left'#2#8#3'Top'#3#165#0#5'Wid'
+'th'#3'X'#2#6'Height'#3#150#0#0#0#7'TButton'#10'cmdCommand'#4'Left'#3#252
+#0#3'Top'#2'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#3'CMD'#7'OnClick'
+#7#15'cmdCommandClick'#0#0#7'TButton'#8'cmdCLear'#4'Left'#3'9'#1#3'Top'#2
+'G'#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#5'Clear'#7'OnClick'#7#13'cm'
+'dClearClick'#0#0#5'TEdit'#10'txtCommand'#4'Left'#2#8#3'Top'#2'H'#5'Width'
+#3#237#0#6'Height'#2#24#4'Text'#6#0#0#0#6'TLabel'#11'lblFileName'#4'Left'
+#2#8#3'Top'#2#8#5'WIDTH'#2'F'#7'Caption'#6#9'Filename:'#0#0#5'TEdit'#11't'
+'xtFileName'#4'Left'#2'F'#3'Top'#2#8#5'Width'#3'%'#1#6'Height'#2#24#4'Tex'
+'t'#6#0#0#0#0
+#3#237#0#6'Height'#2#24#4'Text'#6#0#0#0#7'TButton'#11'cmdSetBreak'#4'Left'
+#3#252#0#3'Top'#3#132#0#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#5'Set B'
+#7'OnClick'#7#16'cmdSetBreakClick'#0#0#7'TButton'#13'cmdResetBreak'#4'Lef'
+'t'#3'9'#1#3'Top'#3#132#0#5'Width'#2'2'#6'Height'#2#25#7'Caption'#6#5'Del'
+' B'#7'OnClick'#7#18'cmdResetBreakClick'#0#0#9'TCheckBox'#14'chkBreakEnab'
+'le'#4'Left'#3'v'#1#3'Top'#3#132#0#5'Width'#2'd'#6'Height'#2#25#7'Caption'
+#6#12'Enable break'#7'OnClick'#7#19'chkBreakEnableClick'#0#0#5'TEdit'#12
+'txtBreakFile'#4'Left'#2#8#3'Top'#3#132#0#5'Width'#3#150#0#6'Height'#2#24
+#4'Text'#6#11'testcntr.pp'#0#0#5'TEdit'#12'txtBreakLine'#4'Left'#3#165#0#3
+'Top'#3#132#0#5'Width'#2'P'#6'Height'#2#24#4'Text'#6#1'1'#0#0#6'TLabel'#11
+'lblFileName'#4'Left'#2#8#3'Top'#2#8#5'WIDTH'#2'F'#7'Caption'#6#8'FileNam'
+'e'#0#0#5'TEdit'#11'txtFileName'#4'Left'#2'F'#3'Top'#2#8#5'Width'#3'%'#1#6
+'Height'#2#24#4'Text'#6#17'examples/testcntr'#0#0#0
);

37
debugger/test/debugtestform.pp
View File

@ -36,6 +36,8 @@ type
cmdStop : TButton;
cmdStep : TButton;
cmdStepInto : TButton;
cmdSetBreak : TButton;
cmdResetBreak : TButton;
lblFileName: TLabel;
lblAdress: TLabel;
lblSource: TLabel;
@ -47,6 +49,9 @@ type
cmdClear: TButton;
txtCommand: TEdit;
txtFileName: TEdit;
txtBreakFile: TEdit;
txtBreakLine: TEdit;
chkBreakEnable: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure cmdInitClick(Sender: TObject);
@ -58,6 +63,9 @@ type
procedure cmdStepIntoClick(Sender: TObject);
procedure cmdCommandClick(Sender: TObject);
procedure cmdClearClick(Sender: TObject);
procedure cmdSetBreakClick(Sender: TObject);
procedure cmdResetBreakClick(Sender: TObject);
procedure chkBreakEnableClick(Sender: TObject);
private
FDebugger: TDebugger;
FOutputForm: TDBGOutputForm;
@ -79,7 +87,7 @@ implementation
uses
SysUtils,
GDBDebugger;
GDBDebugger, DBGBreakPoint;
procedure TDebugTestForm.Loaded;
begin
@ -116,16 +124,18 @@ begin
FDebugger.OnDbgOutput := @DBGOutput;
FDebugger.OnOutput := @DBGTargetOutput;
FDebugger.OnCurrent := @DBGCurrent;
FDebugger.OnState := @DBGState;
FDebugger.OnState := @DBGState;
TDBGBreakPointGroup(FDebugger.BreakPointGroups.Add).Name := 'Default';
// Something strange going on here,
// sometimes the form crashes during load with Application as owner
// sometimes the form crashes during load with nil as owner
FOutputForm := TDBGOutputForm.Create(Application);
FOutputForm := TDBGOutputForm.Create(nil);
FOutputForm.OnDestroy := @OutputFormDestroy;
FOutputForm.Show;
end;
FDebugger.Init;
FDebugger.FileName := txtFileName.Text;
end;
procedure TDebugTestForm.cmdDoneClick(Sender: TObject);
@ -189,6 +199,23 @@ begin
txtLog.Lines.Clear;
end;
procedure TDebugTestForm.cmdSetBreakClick(Sender: TObject);
begin
FDebugger.Breakpoints.Add(txtBreakFile.Text, StrToIntDef(txtBreakLine.Text, 1));
end;
procedure TDebugTestForm.cmdResetBreakClick(Sender: TObject);
begin
if FDebugger.Breakpoints.Count > 0
then FDebugger.Breakpoints[0].Free;
end;
procedure TDebugTestForm.chkBreakEnableClick(Sender: TObject);
begin
if FDebugger.Breakpoints.Count > 0
then FDebugger.Breakpoints[0].Enabled := chkBreakEnable.Checked;
end;
procedure TDebugTestForm.OutputFormDestroy(Sender: TObject);
begin
FOutputForm := nil;
@ -233,6 +260,10 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.3 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.2 2001/11/06 23:59:13 lazarus
MWE: + Initial breakpoint support
+ Added exeption handling on process.free

5
debugger/test/examples/testcntr.pp
View File

@ -1,11 +1,11 @@
program testcntr;
uses
TestWait,
SysUtils;
var
m, n, x : Cardinal;
time: TDateTime;
begin
m :=0;
x := 0;
@ -17,8 +17,7 @@ begin
for n := 0 to 79 do Write('.');
WriteLN;
until m mod 10 = 0;
time := now;
while (now - time) * SecsPerDay < 10 do;
Wait(10);
inc(x);
end;
end.

26
debugger/test/examples/testwait.pp Normal file
View File

@ -0,0 +1,26 @@
unit TestWait;
interface
procedure Wait(const ATime: Integer);
implementation
uses
SysUtils;
procedure Wait(const ATime: Integer);
var
time: TDateTime;
begin
time := now;
while (now - time) * SecsPerDay < ATime do;
end;
var
n: Integer;
begin
n := 0;
while n < 1001 do Inc(n); //something useles
end.

54
debugger/test/tdebugtesttorm.lfm
View File

@ -1,11 +1,11 @@
object DebugTestForm: TDebugTestForm
object DebugTestForm1: TDebugTestForm
CAPTION = 'DebugTestForm'
LEFT = 25
HEIGHT = 320
TOP = 25
WIDTH = 620
OnCreate = FormCreate
OnDestroy = FormDestroy
LEFT = 239
HEIGHT = 300
TOP = 161
WIDTH = 620
object cmdInit: TBUTTON
CAPTION = 'Init'
LEFT = 10
@ -89,7 +89,7 @@ object DebugTestForm: TDebugTestForm
end
object txtLog: TMemo
Left = 8
Top = 132
Top = 165
Width = 600
Height = 150
end
@ -116,17 +116,55 @@ object DebugTestForm: TDebugTestForm
Height = 24
Text = ''
end
object cmdSetBreak: TButton
Left = 252
Top = 132
Width = 50
Height = 25
Caption = 'Set B'
OnClick = cmdSetBreakClick
end
object cmdResetBreak: TButton
Left = 313
Top = 132
Width = 50
Height = 25
Caption = 'Del B'
OnClick = cmdResetBreakClick
end
object chkBreakEnable: TCheckBox
Left = 374
Top = 132
Width = 100
Height = 25
Caption = 'Enable break'
OnClick = chkBreakEnableClick
end
object txtBreakFile: TEdit
Left = 8
Top = 132
Width = 150
Height = 24
Text = 'testcntr.pp'
end
object txtBreakLine: TEdit
Left = 165
Top = 132
Width = 80
Height = 24
Text = '1'
end
object lblFileName: TLabel
Left = 8
Top = 8
WIDTH = 70
Caption = 'Filename:'
Caption = 'FileName'
end
object txtFileName: TEdit
Left = 70
Top = 8
Width = 293
Height = 24
Text = ''
Text = 'examples/testcntr'
end
end

32
examples/edittest.pp
View File

@ -30,11 +30,12 @@ program edittest;
{$mode objfpc}
uses
buttons, classes, forms, controls, sysutils, Graphics, SynEdit, SynHighlighterPas;
StdCtrls, buttons, classes, forms, controls, sysutils, Graphics, synedit, synhighlighterpas;
type
TEditTestForm = class(TForm)
public
FText: TEdit;
FEdit: TSynEdit;
FHighlighter: TSynPasSyn;
constructor Create(AOwner: TComponent); override;
@ -50,18 +51,15 @@ constructor TEditTestForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 300;
Height := 200;
Height := 250;
Left := 200;
Top := 200;
Caption := 'Editor tester';
if FHighlighter = nil
then begin
FHighlighter := TSynPasSyn.Create(Self);
FHighlighter.CommentAttri.Foreground := clNavy;
FHighlighter.NumberAttri.Foreground := clRed;
FHighlighter.KeyAttri.Foreground := clGreen;
end;
FHighlighter := TSynPasSyn.Create(Self);
FHighlighter.CommentAttri.Foreground := clNavy;
FHighlighter.NumberAttri.Foreground := clRed;
FHighlighter.KeyAttri.Foreground := clGreen;
FEdit := TSynEdit.Create(Self);
with FEdit
@ -77,6 +75,18 @@ begin
Font.Size := 12;
HighLighter := Self.FHighLighter;
end;
FText := TEdit.Create(Self);
with FText do
begin
Parent := Self;
Top := 208;
Width := 300;
Height := 25;
Visible := True;
Font.Name := 'courier';
Font.Size := 12;
end;
end;
begin
@ -87,6 +97,10 @@ end.
{
$Log$
Revision 1.3 2002/02/05 23:16:48 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.2 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32

557
ide/main.pp
View File

@ -38,9 +38,9 @@ uses
IDEComp, AbstractFormEditor, FormEditor, CustomFormEditor, ObjectInspector,
PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions,
EnvironmentOpts, TransferMacros, KeyMapping, ProjectOpts, IDEProcs, Process,
UnitInfoDlg, Debugger, DBGWatch, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter,
BuildLazDialog, MiscOptions;
UnitInfoDlg, Debugger, DBGBreakpoint, DBGWatch, GDBDebugger, RunParamsOpts, ExtToolDialog,
MacroPromptDlg, LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg,
OutputFilter, BuildLazDialog, MiscOptions;
const
Version_String = '0.8.2 alpha';
@ -312,7 +312,10 @@ type
MacroList: TTransferMacroList;
FMessagesViewBoundsRectValid: boolean;
FOpenEditorsOnCodeToolChange: boolean;
TheDebugger: TDebugger;
FBreakPoints: TDBGBreakPoints; // Points to debugger breakpoints if available
// Else to own objet
FDebugger: TDebugger;
FRunProcess: TProcess; // temp solution, will be replaced by dummydebugger
TheCompiler: TCompiler;
TheOutputFilter: TOutputFilter;
@ -354,6 +357,7 @@ type
function DoAddActiveUnitToProject: TModalResult;
function DoRemoveFromProjectDialog: TModalResult;
function DoBuildProject(BuildAll: boolean): TModalResult;
function DoInitProjectRun: TModalResult;
function DoRunProject: TModalResult;
function DoPauseProject: TModalResult;
function DoStepIntoProject: TModalResult;
@ -769,7 +773,9 @@ begin
//TBreakPointsDlg
BreakPoints_Dlg := TBreakPointsDlg.Create(Self);
TheDebugger := TDebugger.Create;
FDebugger := nil;
FBreakPoints := TDBGBreakPoints.Create(nil, TDBGBreakPoint);
// control selection (selected components on edited form)
TheControlSelection:=TControlSelection.Create;
TheControlSelection.OnChange:=@OnControlSelectionChanged;
@ -808,8 +814,9 @@ writeln('[TMainIDE.Destroy] A');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
{$ENDIF}
TheDebugger.Free;
TheDebugger:=nil;
if FDebugger <> nil
then FDebugger.Done;
if Project<>nil then begin
Project.Free;
Project:=nil;
@ -834,8 +841,9 @@ CheckHeap(IntToStr(GetMem_Cnt));
HIntTimer1.Free;
HintWindow1.Free;
Watches_Dlg.Free;
FDebugger.Free;
FDebugger := nil;
TheDebugger.Free;
writeln('[TMainIDE.Destroy] B -> inherited Destroy...');
{$IFDEF IDE_MEM_CHECK}
CheckHeap(IntToStr(GetMem_Cnt));
@ -1767,50 +1775,15 @@ Procedure TMainIDE.OnSrcNotebookProcessCommand(Sender: TObject;
begin
Handled:=true;
case Command of
ecBuild, ecBuildAll:
DoBuildProject(Command=ecBuildAll);
ecBuild,
ecBuildAll: DoBuildProject(Command=ecBuildAll);
ecRun:
begin
if DoBuildProject(false)<>mrOk then exit;
DoRunProject;
end;
ecPause:
DoPauseProject;
ecStepInto:
begin
if ToolStatus=itNone then
if DoBuildProject(false)<>mrOk then begin
Handled:=false;
exit;
end;
DoStepIntoProject;
end;
ecStepOver:
begin
if ToolStatus=itNone then
if DoBuildProject(false)<>mrOk then begin
Handled:=false;
exit;
end;
DoStepOverProject;
end;
ecRunToCursor:
begin
if ToolStatus=itNone then
if DoBuildProject(false)<>mrOk then begin
Handled:=false;
exit;
end;
DoRunToCursor;
end;
ecStopProgram:
DoStopProject;
ecRun: DoRunProject;
ecPause: DoPauseProject;
ecStepInto: DoStepIntoProject;
ecStepOver: DoStepOverProject;
ecRunToCursor: DoRunToCursor;
ecStopProgram: DoStopProject;
ecFindProcedureDefinition,ecFindProcedureMethod:
DoJumpToProcedureSection;
@ -2094,7 +2067,6 @@ end;
Procedure TMainIDE.mnuRunProjectClicked(Sender : TObject);
begin
if DoBuildProject(false)<>mrOk then exit;
DoRunProject;
end;
@ -3998,217 +3970,289 @@ begin
end;
end;
function TMainIDE.DoInitProjectRun: TModalResult;
var
ProgramFilename: String;
begin
if ToolStatus = itDebugger
then begin
// already running so no initialization needed
Result := mrOk;
Exit;
end;
Result := mrCancel;
// Check if we can run this project
if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
or (Project.MainUnit < 0)
or (ToolStatus <> itNone)
then Exit;
// Check project build
ProgramFilename := GetProjectTargetFilename;
if not FileExists(ProgramFilename)
then begin
MessageDlg('File not found', Format('No program file "%s" found!', [ProgramFilename]), mtError, [mbCancel], 0);
Exit;
end;
// Build project first
if DoBuildProject(false) <> mrOk
then Exit;
// Setup debugger
case EnvironmentOptions.DebuggerType of
dtGnuDebugger: begin
if (FDebugger = nil)
and (DoInitDebugger <> mrOk)
then Exit;
FDebugger.FileName := ProgramFilename;
FDebugger.Arguments := ''; //TODO: get arguments
FDebugger.Run;
end;
else
// Temp solution, in futer it will be run by dummy debugger
try
CheckIfFileIsExecutable(ProgramFilename);
FRunProcess := TProcess.Create(nil);
FRunProcess.CommandLine := ProgramFilename;
FRunProcess.Options:= [poUsePipes, poNoConsole];
FRunProcess.ShowWindow := swoNone;
FRunProcess.Execute;
except
on e: Exception do
MessageDlg(Format('Error initializing program'#13 +
'"%s"'#13 +
'Error: %s', [ProgramFilename, e.Message]), mterror, [mbok], 0);
end;
end;
Result := mrOK;
ToolStatus := itDebugger;
end;
function TMainIDE.DoRunProject: TModalResult;
// ToDo:
// -implement a better messages-form for vast amount of output
// -command line parameters
var
TheProcess : TProcess;
ProgramFilename, AText : String;
begin
Result:=mrCancel;
writeln('[TMainIDE.DoRunProject] A');
if not (ToolStatus in [itNone,itDebugger]) then begin
Result:=mrAbort;
exit;
Writeln('[TMainIDE.DoRunProject] A');
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
then begin
Result := mrAbort;
Exit;
end;
if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
or (Project.MainUnit<0) then
exit;
//MainUnitInfo:=Project.Units[Project.MainUnit];
ProgramFilename:=GetProjectTargetFilename;
if not FileExists(ProgramFilename) then begin
AText:='No program file "'+ProgramFilename+'" found!';
MessageDlg('File not found',AText,mtError,[mbCancel],0);
exit;
end;
Result := mrCancel;
case EnvironmentOptions.DebuggerType of
dtGnuDebugger:
begin
if TheDebugger=nil then begin
Result:=DoInitDebugger;
if Result<>mrOk then exit;
Result:=mrCancel;
end;
ToolStatus:=itDebugger;
TheDebugger.Run;
end;
dtGnuDebugger: begin
if FDebugger = nil then Exit;
FDebugger.Run;
Result := mrOK;
end;
else
begin
try
writeln(' EXECUTING "',ProgramFilename,'"');
CheckIfFileIsExecutable(ProgramFilename);
TheProcess := TProcess.Create(nil);
TheProcess.CommandLine := ProgramFilename;
TheProcess.Options:= [poUsePipes, poNoConsole];
TheProcess.ShowWindow := swoNone;
TheProcess.Execute;
except
on e: Exception do begin
AText:='Error running program'#13'"'+ProgramFilename+'"'#13
+'Error: '+e.Message;
MessageDlg(AText,mterror,[mbok], 0);
end;
end;
end;
if FRunProcess = nil then Exit;
try
Writeln(' EXECUTING "',FRunProcess.CommandLine,'"');
FRunProcess.Execute;
Result := mrOk;
except
on e: Exception do
MessageDlg(Format('Error initializing program'#13 +
'"%s"'#13 +
'Error: %s', [FRunProcess.CommandLine, e.Message]), mterror, [mbok], 0);
end;
end;
Result:=mrOk;
writeln('[TMainIDE.DoRunProject] END');
Writeln('[TMainIDE.DoRunProject] END');
end;
function TMainIDE.DoPauseProject: TModalResult;
begin
Result:=mrCancel;
if (ToolStatus<>itDebugger) or (TheDebugger=nil) then exit;
TheDebugger.Pause;
Result:=mrOk;
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger = nil)
then Exit;
FDebugger.Pause;
Result := mrOk;
end;
function TMainIDE.DoStepIntoProject: TModalResult;
begin
Result:=mrCancel;
if ToolStatus=itNone then begin
Result:=DoInitDebugger;
if Result<>mrOk then exit;
Result:=mrCancel;
ToolStatus:=itDebugger;
end;
if (ToolStatus<>itDebugger) or (TheDebugger=nil) then
exit
else begin
TheDebugger.StepInto;
Result:=mrOk;
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepInto;
Result := mrOk;
end;
function TMainIDE.DoStepOverProject: TModalResult;
begin
Result:=mrCancel;
if ToolStatus=itNone then begin
Result:=DoInitDebugger;
if Result<>mrOk then exit;
Result:=mrCancel;
ToolStatus:=itDebugger;
end;
if (ToolStatus<>itDebugger) or (TheDebugger=nil) then
exit
else begin
TheDebugger.StepOver;
Result:=mrOk;
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
FDebugger.StepOver;
Result := mrOk;
end;
function TMainIDE.DoStopProject: TModalResult;
begin
Result:=mrCancel;
if (ToolStatus<>itDebugger) or (TheDebugger=nil) then exit;
TheDebugger.Stop;
Result:=mrOk;
Result := mrCancel;
if (ToolStatus <> itDebugger)
or (FDebugger=nil)
then Exit;
FDebugger.Stop;
Result := mrOk;
end;
function TMainIDE.DoRunToCursor: TModalResult;
var ActiveSrcEdit: TSourceEditor;
var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
UnitFilename: string;
begin
Result:=mrCancel;
if ToolStatus=itNone then begin
Result:=DoInitDebugger;
if Result<>mrOk then exit;
Result:=mrCancel;
ToolStatus:=itDebugger;
if (DoInitProjectRun <> mrOK)
or (ToolStatus <> itDebugger)
or (FDebugger = nil)
then begin
Result := mrAbort;
Exit;
end;
if ToolStatus<>itDebugger then exit;
GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil) then begin
Result := mrCancel;
GetCurrentUnit(ActiveSrcEdit, ActiveUnitInfo);
if (ActiveSrcEdit=nil) or (ActiveUnitInfo=nil)
then begin
MessageDlg('Run to failed','Please open a unit before run.',mtError,
[mbCancel],0);
exit;
Exit;
end;
if not ActiveUnitInfo.Source.IsVirtual then
UnitFilename:=ActiveUnitInfo.Filename
else
UnitFilename:=GetTestUnitFilename(ActiveUnitInfo);
TheDebugger.RunTo(UnitFilename,ActiveSrcEdit.EditorComponent.CaretY);
if not ActiveUnitInfo.Source.IsVirtual
then UnitFilename:=ActiveUnitInfo.Filename
else UnitFilename:=GetTestUnitFilename(ActiveUnitInfo);
FDebugger.RunTo(UnitFilename, ActiveSrcEdit.EditorComponent.CaretY);
Result := mrOK;
end;
function TMainIDE.DoInitDebugger: TModalResult;
var ProgramFilename: string;
// MainUnitInfo: TUnitInfo;
var
OldBreakpoints: TDBGBreakpoints;
begin
Result:=mrCancel;
if Project.MainUnit<0 then exit;
WriteLN('[TMainIDE.DoInitDebugger] A');
Result:=mrCancel;
if Project.MainUnit < 0 then Exit;
OldBreakpoints := nil;
case EnvironmentOptions.DebuggerType of
dtGnuDebugger:
begin
MessageDlg('Sorry, not implemented yet',
'The GNU debugger support is not yet implemented.'#13
+'The IDE can already handle the abstract debugger'#13
+'(see directory debugger), so that anyone can write a unit for their'#13
+'favourite debugger.'#13
+'Please set the debugger in the environment options to none to'#13
+'just start the program without debugging.',mtInformation,[mbOk],0);
exit;
{ ToDo: GnuDebugger
if (TheDebugger<>nil) and (not (TheDebugger is TGnuDebugger)) then begin
TheDebugger.Free;
TheDebugger:=nil;
end;
TheDebugger:=TGnuDebugger.Create;}
dtGnuDebugger: begin
if (FDebugger <> nil)
and not (FDebugger is TGDBDebugger)
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
FBreakPoints := nil;
FDebugger.Free;
FDebugger := nil;
end;
else
begin
TheDebugger.Free;
TheDebugger:=nil;
exit;
if FDebugger = nil
then begin
if FBreakPoints <> nil
then begin
OldBreakpoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
OldBreakpoints.Assign(FBreakPoints);
end;
FDebugger := TGDBDebugger.Create;
FBreakPoints := FDebugger.BreakPoints;
end;
if OldBreakpoints <> nil
then FBreakPoints.Assign(OldBreakpoints);
end;
else
OldBreakpoints := FBreakPoints;
FBreakPoints := TDBGBreakpoints.Create(nil, TDBGBreakpoint);
FBreakPoints.Assign(OldBreakpoints);
FDebugger.Free;
FDebugger := nil;
Exit;
end;
//MainUnitInfo:=Project.Units[Project.MainUnit];
ProgramFilename:=GetProjectTargetFilename;
TheDebugger.Filename:=ProgramFilename;
TheDebugger.OnState:=@OnDebuggerChangeState;
TheDebugger.OnCurrent:=@OnDebuggerCurrentLine;
FDebugger.OnState:=@OnDebuggerChangeState;
FDebugger.OnCurrent:=@OnDebuggerCurrentLine;
if FDebugger.State = dsNone
then FDebugger.Init;
//TODO: Show/hide debug menuitems based on FDebugger.SupportedCommands
// property BreakPointGroups: TDBGBreakPointGroups read FBreakPointGroups; // list of all breakpoints
// property Watches: TDBGWatches read FWatches; // list of all watches localvars etc
Result:=mrOk;
Result := mrOk;
WriteLN('[TMainIDE.DoInitDebugger] END');
end;
procedure TMainIDE.OnDebuggerChangeState(Sender: TObject);
const
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
// dsNone, dsIdle, dsStop, dsPause, dsRun, dsError
itNone, itNone, itNone, itDebugger, itDebugger, itDebugger
);
STATENAME: array[TDBGState] of string = (
'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsRun', 'dsError'
);
begin
if (Sender<>TheDebugger) or (Sender=nil) then exit;
RunSpeedButton.Enabled:=(TheDebugger.State in [dsStop,dsPause,dsError]);
PauseSpeedButton.Enabled:=(TheDebugger.State in [dsRun]);
itmProjectRun.Enabled:=RunSpeedButton.Enabled;
itmProjectPause.Enabled:=PauseSpeedButton.Enabled;
case TheDebugger.State of
dsStop:
begin
// program stopped -> end debugging session
TheDebugger.Free;
TheDebugger:=nil;
ToolStatus:=itNone;
end;
dsPause:
begin
// program paused
ToolStatus:=itDebugger;
end;
dsRun:
begin
// program is running
ToolStatus:=itDebugger;
end;
dsError:
begin
// ???
ToolStatus:=itDebugger;
end;
// Is the next line needed ???
if (Sender<>FDebugger) or (Sender=nil) then exit;
WriteLN('[TMainIDE.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]);
// All conmmands
// -------------------
// dcRun, dcPause, dcStop, dcStepOver, dcStepInto, dcRunTo, dcJumpto, dcBreak, dcWatch
// -------------------
RunSpeedButton.Enabled := dcRun in FDebugger.Commands;
itmProjectRun.Enabled := RunSpeedButton.Enabled;
PauseSpeedButton.Enabled := dcPause in FDebugger.Commands;
itmProjectPause.Enabled := PauseSpeedButton.Enabled;
StepIntoSpeedButton.Enabled := dcStepInto in FDebugger.Commands;
itmProjectStepInto.Enabled := StepIntoSpeedButton.Enabled;
StepOverSpeedButton.Enabled := dcStepOver in FDebugger.Commands;
itmProjectStepOver.Enabled := StepOverSpeedButton.Enabled;
itmProjectRunToCursor.Enabled := dcRunTo in FDebugger.Commands;
itmProjectStop.Enabled := dcStop in FDebugger.Commands;;
// TODO: add other debugger menuitems
// TODO: implement by actions
ToolStatus := TOOLSTATEMAP[FDebugger.State];
if FDebugger.State = dsError
then begin
WriteLN('Ooops, the debugger entered the error state');
end;
end;
@ -4220,7 +4264,7 @@ procedure TMainIDE.OnDebuggerCurrentLine(Sender: TObject;
var
ActiveSrcEdit: TSourceEditor;
begin
if (Sender<>TheDebugger) or (Sender=nil) then exit;
if (Sender<>FDebugger) or (Sender=nil) then exit;
//TODO: Show assembler window if no source can be found.
if ALocation.SrcLine = -1 then Exit;
if DoOpenEditorFile(ALocation.SrcFile, false) <> mrOk then exit;
@ -5600,23 +5644,22 @@ begin
end;
//This adds the watch to the TWatches TCollection and to the watches dialog
Procedure TMainIDE.AddWatch(AnExpression : String);
Var
procedure TMainIDE.AddWatch(AnExpression : String);
var
NewWatch : TdbgWatch;
begin
if FDebugger = nil then Exit;
if not Watches_Dlg.Visible then Watches_Dlg.Show;
if not Watches_Dlg.Visible then Watches_Dlg.Show;
NewWatch := TdbgWatch(TheDebugger.watches.Add);
NewWatch := TdbgWatch(FDebugger.watches.Add);
with NewWatch do
Begin
Expression := AnExpression;
OnChange := @OnDebuggerWatchChanged;
Enabled := True;
end;
begin
Expression := AnExpression;
OnChange := @OnDebuggerWatchChanged;
Enabled := True;
end;
Watches_Dlg.AddWatch(NewWatch.Expression+':'+NewWatch.Value);
end;
@ -5630,7 +5673,7 @@ begin
if Pos(':',AnExpression) > 0 then
AnExpression := Copy(AnExpression,1,pos(':',AnExpression)-1);
NewWatch := TdbgWatch(TheDebugger.watches.Add);
NewWatch := TdbgWatch(FDebugger.watches.Add);
with NewWatch do
Begin
Expression := AnExpression;
@ -5657,7 +5700,7 @@ begin
if SourceNotebook.Notebook = nil then Exit;
Breakpoints_Dlg.AddBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
FBreakPoints.Add(TSourceNotebook(sender).GetActiveSe.FileName, Line);
end;
Procedure TMainIDE.OnSrcNotebookDeleteBreakPoint(Sender : TObject;
@ -5666,6 +5709,7 @@ begin
if SourceNotebook.Notebook = nil then Exit;
Breakpoints_Dlg.DeleteBreakPoint(TSourceNotebook(sender).GetActiveSe.FileName,Line);
FBreakPoints.Find(TSourceNotebook(sender).GetActiveSe.FileName, Line).Free;
end;
procedure TMainIDE.OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
@ -5710,10 +5754,11 @@ end.
{ =============================================================================
<<<<<<< main.pp
=======
$Log$
Revision 1.209 2002/02/05 23:16:47 lazarus
MWE: * Updated tebugger
+ Added debugger to IDE
Revision 1.208 2002/02/03 00:23:54 lazarus
TPanel implemented.
Basic graphic primitives split into GraphType package, so that we can
@ -5773,78 +5818,12 @@ end.
Revision 1.191 2001/12/19 20:28:50 lazarus
Enabled Alignment of columns in a TListView.
Shane
>>>>>>> 1.191
<<<<<<< main.pp
$Log$
Revision 1.208 2002/02/03 00:23:54 lazarus
TPanel implemented.
Basic graphic primitives split into GraphType package, so that we can
reference it from interface (GTK, Win32) units.
New Frame3d canvas method that uses native (themed) drawing (GTK only).
New overloaded Canvas.TextRect method.
LCLLinux and Graphics was split, so a bunch of files had to be modified.
Revision 1.207 2002/01/27 19:08:43 lazarus
MWE: Removed ^M
Revision 1.206 2002/01/24 14:12:52 lazarus
MG: added build lazarus feature and config dialog
Revision 1.205 2002/01/23 22:12:54 lazarus
MG: external tool output parsing for fpc and make messages
Revision 1.204 2002/01/23 20:07:20 lazarus
MG: added outputfilter
Revision 1.203 2002/01/21 14:17:44 lazarus
MG: added find-block-start and renamed find-block-other-end
Revision 1.202 2002/01/17 11:00:00 lazarus
MG: increased IDE version to 0.8.2 alpha
Revision 1.201 2002/01/15 20:21:37 lazarus
MG: jump history for find declaration
Revision 1.200 2002/01/13 12:46:17 lazarus
MG: fixed linker options, compiler options dialog
Revision 1.199 2002/01/11 20:41:52 lazarus
MG: added guess unclosed block
Revision 1.197 2002/01/02 13:32:52 lazarus
MG: fixed clean abort of project loading
Revision 1.196 2001/12/31 22:45:41 lazarus
Took out some test code.
Shane
Revision 1.195 2001/12/31 22:42:59 lazarus
Added a TViewColumn editor to be used in the object inspector as TViewColumn's property editor.
Shane
Revision 1.194 2001/12/28 11:01:20 lazarus
MG: fixed save as with lfm and lrs files
Revision 1.193 2001/12/20 19:11:22 lazarus
Changed the delay for the hints from 100 miliseconds to 500. I'm hoping this reduces the crashing for some people until I determine the problem.
Shane
Revision 1.192 2001/12/19 22:09:13 lazarus
MG: added GUID and alias parsing, added DoJumpToCodeToolBossError
Revision 1.190 2001/12/18 21:09:58 lazarus
MOre additions for breakpoints dialog
Added a TSynEditPlugin in SourceEditor to get notified of lines inserted and deleted from the source.
Shane
=======
Revision 1.190 2001/12/18 21:09:58 lazarus
MOre additions for breakpoints dialog
Added a TSynEditPlugin in SourceEditor to get notified of lines inserted and deleted from the source.
Shane
>>>>>>> 1.191
Revision 1.189 2001/12/18 21:00:59 lazarus
MG: compiler, fpc source and lazarus src can now be changed without restart