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

DBG: obey Begin/EndUpdate before attempting to execute brk-point commands

Browse Source 
git-svn-id: trunk@28333 -
This commit is contained in:
martin 2010-11-19 00:09:55 +00:00
parent 0c34856eb9
commit 615a8734ce
2 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
debugger/debugutils.pp
View File

@ -38,6 +38,9 @@ uses
Classes, LCLProc;
type
{ TDelayedUdateItem }
TDelayedUdateItem = class(TCollectionItem)
private
FUpdateCount: Integer;
@ -45,11 +48,13 @@ type
protected
procedure Changed;
procedure DoChanged; virtual;
procedure DoEndUpdate; virtual; // even if not changed
public
procedure Assign(ASource: TPersistent); override;
procedure BeginUpdate;
constructor Create(ACollection: TCollection); override;
procedure EndUpdate;
function IsUpdating: Boolean;
end;
function GetLine(var ABuffer: String): String;
@ -257,10 +262,17 @@ begin
inherited Changed(False);
end;
procedure TDelayedUdateItem.DoEndUpdate;
begin
//
end;
procedure TDelayedUdateItem.EndUpdate;
begin
Dec(FUpdateCount);
if FUpdateCount < 0 then raise EInvalidOperation.Create('TDelayedUdateItem.EndUpdate');
if (FUpdateCount = 0)
then DoEndUpdate;
if (FUpdateCount = 0) and FDoChanged
then begin
DoChanged;
@ -268,6 +280,11 @@ begin
end;
end;
function TDelayedUdateItem.IsUpdating: Boolean;
begin
Result := FUpdateCount > 0;
end;
initialization
LastSmartWritelnCount:=0;

24
debugger/gdbmidebugger.pp
View File

@ -683,7 +683,7 @@ type
procedure DoCommandDestroyed(Sender: TObject);
procedure DoCommandExecuted(Sender: TObject);
protected
//procedure DoChanged; override;
procedure DoEndUpdate; override;
procedure DoEnableChange; override;
procedure DoExpressionChange; override;
procedure DoStateChange(const AOldState: TDBGState); override;
@ -5518,6 +5518,11 @@ end;
procedure TGDBMIBreakPoint.SetBreakpoint;
begin
if Debugger = nil then Exit;
if IsUpdating
then begin
FUpdateFlags := [bufSetBreakPoint];
exit;
end;
if (FCurrentCmd <> nil)
then begin
@ -5608,6 +5613,15 @@ begin
then UpdateProperties(FUpdateFlags);
end;
procedure TGDBMIBreakPoint.DoEndUpdate;
begin
if bufSetBreakPoint in FUpdateFlags
then SetBreakPoint;
if FUpdateFlags * [bufEnabled, bufCondition] <> []
then UpdateProperties(FUpdateFlags);
inherited DoChanged;
end;
procedure TGDBMIBreakPoint.ReleaseBreakPoint;
begin
if Debugger = nil then Exit;
@ -5644,7 +5658,7 @@ procedure TGDBMIBreakPoint.SetLocation(const ASource: String; const ALine: Integ
begin
if (Source = ASource) and (Line = ALine) then exit;
inherited;
if Debugger = nil then Exit;
if (Debugger = nil) or (Source = '') then Exit;
if TGDBMIDebugger(Debugger).State in [dsStop, dsPause, dsRun]
then SetBreakpoint;
end;
@ -5653,6 +5667,12 @@ procedure TGDBMIBreakPoint.UpdateProperties(AFlags: TGDBMIBreakPointUpdateFlags)
begin
if (Debugger = nil) then Exit;
if AFlags * [bufEnabled, bufCondition] = [] then Exit;
if IsUpdating
then begin
if not(bufSetBreakPoint in FUpdateFlags)
then FUpdateFlags := FUpdateFlags + AFlags;
exit;
end;
if (FCurrentCmd <> nil)
then begin