mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-28 21:41:01 +02:00
DBG: Fixed a possible bad memory access / Fixed line from source 1 vs 0 based
git-svn-id: trunk@32718 -
This commit is contained in:
martin
parent
b9e15403ed
commit
afc9b17919
@ -208,9 +208,21 @@ type
|
||||
property DlgWatchesConfig: TDebuggerWatchesDlgConfig read FTDebuggerWatchesDlgConfig;
|
||||
end;
|
||||
|
||||
{ TFreeNotifyingObject }
|
||||
|
||||
TFreeNotifyingObject = class
|
||||
private
|
||||
FFreeNotificationList: TMethodList;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure AddFreeeNotification(ANotification: TNotifyEvent);
|
||||
procedure RemoveFreeeNotification(ANotification: TNotifyEvent);
|
||||
end;
|
||||
|
||||
{ TRefCountedObject }
|
||||
|
||||
TRefCountedObject = class(TObject)
|
||||
TRefCountedObject = class(TFreeNotifyingObject)
|
||||
private
|
||||
FRefCount: Integer;
|
||||
protected
|
||||
@ -230,7 +242,7 @@ type
|
||||
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
|
||||
end;
|
||||
|
||||
procedure ReleaseAndNil(var ARefCountedObject);
|
||||
procedure ReleaseRefAndNil(var ARefCountedObject);
|
||||
|
||||
type
|
||||
|
||||
@ -1030,7 +1042,7 @@ type
|
||||
|
||||
{ TWatchValue }
|
||||
|
||||
TWatchValue = class
|
||||
TWatchValue = class(TFreeNotifyingObject)
|
||||
private
|
||||
FDisplayFormat: TWatchDisplayFormat;
|
||||
FStackFrame: Integer;
|
||||
@ -1172,14 +1184,9 @@ type
|
||||
FSnapShot: TWatchValue;
|
||||
procedure SetSnapShot(const AValue: TWatchValue);
|
||||
protected
|
||||
FFreeNotificationList: TMethodList;
|
||||
procedure RequestData; override;
|
||||
procedure ValidityChanged; override;
|
||||
public
|
||||
constructor Create; override; overload;
|
||||
destructor Destroy; override;
|
||||
procedure AddFreeeNotification(ANotification: TNotifyEvent);
|
||||
procedure RemoveFreeeNotification(ANotification: TNotifyEvent);
|
||||
property SnapShot: TWatchValue read FSnapShot write SetSnapShot;
|
||||
public
|
||||
procedure SetTypeInfo(const AValue: TDBGType);
|
||||
@ -1682,7 +1689,7 @@ type
|
||||
|
||||
{ TCallStack }
|
||||
|
||||
TCallStack = class(TObject)
|
||||
TCallStack = class(TFreeNotifyingObject)
|
||||
private
|
||||
FThreadId: Integer;
|
||||
FCurrent: Integer;
|
||||
@ -2922,9 +2929,9 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure ReleaseAndNil(var ARefCountedObject);
|
||||
procedure ReleaseRefAndNil(var ARefCountedObject);
|
||||
begin
|
||||
Assert((Pointer(ARefCountedObject) = nil) or (TObject(ARefCountedObject) is TRefCountedObject), 'ReleaseAndNil requires TRefCountedObject');
|
||||
Assert((Pointer(ARefCountedObject) = nil) or (TObject(ARefCountedObject) is TRefCountedObject), 'ReleaseRefAndNil requires TRefCountedObject');
|
||||
if Pointer(ARefCountedObject) <> nil
|
||||
then TRefCountedObject(ARefCountedObject).ReleaseReference;
|
||||
Pointer(ARefCountedObject) := nil;
|
||||
@ -2951,6 +2958,31 @@ begin
|
||||
Result:=bpaStop;
|
||||
end;
|
||||
|
||||
{ TFreeNotifyingObject }
|
||||
|
||||
constructor TFreeNotifyingObject.Create;
|
||||
begin
|
||||
FFreeNotificationList := TMethodList.Create;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TFreeNotifyingObject.Destroy;
|
||||
begin
|
||||
FFreeNotificationList.CallNotifyEvents(Self);
|
||||
inherited Destroy;
|
||||
FreeAndNil(FFreeNotificationList);
|
||||
end;
|
||||
|
||||
procedure TFreeNotifyingObject.AddFreeeNotification(ANotification: TNotifyEvent);
|
||||
begin
|
||||
FFreeNotificationList.Add(TMethod(ANotification));
|
||||
end;
|
||||
|
||||
procedure TFreeNotifyingObject.RemoveFreeeNotification(ANotification: TNotifyEvent);
|
||||
begin
|
||||
FFreeNotificationList.Remove(TMethod(ANotification));
|
||||
end;
|
||||
|
||||
{ TDebuggerWatchesDlgConfig }
|
||||
|
||||
constructor TDebuggerWatchesDlgConfig.Create;
|
||||
@ -3601,7 +3633,7 @@ procedure TSnapshotManager.CreateHistoryEntry;
|
||||
var
|
||||
t: LongInt;
|
||||
begin
|
||||
ReleaseAndNil(FCurrentSnapshot); // should be nil already
|
||||
ReleaseRefAndNil(FCurrentSnapshot); // should be nil already
|
||||
FCurrentSnapshot := TSnapshot.Create(Self);
|
||||
FCurrentSnapshot.Location := Debugger.GetLocation;
|
||||
|
||||
@ -3691,7 +3723,7 @@ end;
|
||||
destructor TSnapshotManager.Destroy;
|
||||
begin
|
||||
FNotificationList.Clear;
|
||||
ReleaseAndNil(FCurrentSnapshot);
|
||||
ReleaseRefAndNil(FCurrentSnapshot);
|
||||
Clear;
|
||||
inherited Destroy;
|
||||
FreeAndNil(FHistoryList);
|
||||
@ -3727,7 +3759,7 @@ begin
|
||||
else begin
|
||||
if (FCurrentSnapshot <> nil) and (FActive or (AOldState = dsInternalPause)) then begin
|
||||
HistoryIndex := FHistoryList.Add(FCurrentSnapshot);
|
||||
ReleaseAndNil(FCurrentSnapshot);
|
||||
ReleaseRefAndNil(FCurrentSnapshot);
|
||||
while FHistoryList.Count > HistoryCapacity do RemoveHistoryEntry(0);
|
||||
DoChanged;
|
||||
end;
|
||||
@ -4230,29 +4262,6 @@ begin
|
||||
then FSnapShot.Assign(self);
|
||||
end;
|
||||
|
||||
constructor TCurrentWatchValue.Create;
|
||||
begin
|
||||
FFreeNotificationList := TMethodList.Create;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TCurrentWatchValue.Destroy;
|
||||
begin
|
||||
FFreeNotificationList.CallNotifyEvents(Self);
|
||||
inherited Destroy;
|
||||
FreeAndNil(FFreeNotificationList);
|
||||
end;
|
||||
|
||||
procedure TCurrentWatchValue.AddFreeeNotification(ANotification: TNotifyEvent);
|
||||
begin
|
||||
FFreeNotificationList.Add(TMethod(ANotification));
|
||||
end;
|
||||
|
||||
procedure TCurrentWatchValue.RemoveFreeeNotification(ANotification: TNotifyEvent);
|
||||
begin
|
||||
FFreeNotificationList.Remove(TMethod(ANotification));
|
||||
end;
|
||||
|
||||
{ TCurrentWatchValueList }
|
||||
|
||||
procedure TCurrentWatchValueList.SetSnapShot(const AValue: TWatchValueList);
|
||||
@ -5555,7 +5564,7 @@ procedure TRefCountedObject.ReleaseReference;
|
||||
begin
|
||||
Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference RefCount > 0');
|
||||
Dec(FRefCount);
|
||||
if FRefCount = 0 then Free;
|
||||
if FRefCount = 0 then DoFree;
|
||||
end;
|
||||
|
||||
(******************************************************************************)
|
||||
|
||||
@ -344,27 +344,27 @@ begin
|
||||
FSnapshotNotification.OnCurrent := nil;
|
||||
end;
|
||||
SetSnapshotManager(nil);
|
||||
ReleaseAndNil(FSnapshotNotification);
|
||||
ReleaseRefAndNil(FSnapshotNotification);
|
||||
|
||||
if FThreadsNotification <> nil then begin;
|
||||
FThreadsNotification.OnChange := nil;
|
||||
FThreadsNotification.OnCurrent := nil;
|
||||
end;
|
||||
SetThreadsMonitor(nil);
|
||||
ReleaseAndNil(FThreadsNotification);
|
||||
ReleaseRefAndNil(FThreadsNotification);
|
||||
|
||||
if FCallStackNotification <> nil then begin;
|
||||
FCallStackNotification.OnChange := nil;
|
||||
FCallStackNotification.OnCurrent := nil;
|
||||
end;
|
||||
SetCallStackMonitor(nil);
|
||||
ReleaseAndNil(FCallStackNotification);
|
||||
ReleaseRefAndNil(FCallStackNotification);
|
||||
|
||||
if FLocalsNotification <> nil then begin;
|
||||
FLocalsNotification.OnChange := nil;
|
||||
end;
|
||||
SetLocalsMonitor(nil);
|
||||
ReleaseAndNil(FLocalsNotification);
|
||||
ReleaseRefAndNil(FLocalsNotification);
|
||||
|
||||
if FWatchesNotification <> nil then begin;
|
||||
FWatchesNotification.OnAdd := nil;
|
||||
@ -372,7 +372,7 @@ begin
|
||||
FWatchesNotification.OnUpdate := nil;
|
||||
end;
|
||||
SetWatchesMonitor(nil);
|
||||
ReleaseAndNil(FWatchesNotification);
|
||||
ReleaseRefAndNil(FWatchesNotification);
|
||||
|
||||
if FBreakpointsNotification <> nil then begin;
|
||||
FBreakpointsNotification.OnAdd := nil;
|
||||
@ -380,7 +380,7 @@ begin
|
||||
FBreakpointsNotification.OnUpdate := nil;
|
||||
end;
|
||||
SetBreakPoints(nil);
|
||||
ReleaseAndNil(FBreakpointsNotification);
|
||||
ReleaseRefAndNil(FBreakpointsNotification);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -1031,6 +1031,8 @@ type
|
||||
{ TGDBMIDebuggerCommandStack }
|
||||
|
||||
TGDBMIDebuggerCommandStack = class(TGDBMIDebuggerCommand)
|
||||
private
|
||||
procedure DoCallstackFreed(Sender: TObject);
|
||||
protected
|
||||
FCallstack: TCurrentCallStack;
|
||||
FThreadChanged: Boolean;
|
||||
@ -1038,6 +1040,7 @@ type
|
||||
procedure UnSelectThread;
|
||||
public
|
||||
constructor Create(AOwner: TGDBMIDebugger; ACallstack: TCurrentCallStack);
|
||||
destructor Destroy; override;
|
||||
property Callstack: TCurrentCallStack read FCallstack;
|
||||
end;
|
||||
|
||||
@ -1675,16 +1678,28 @@ begin
|
||||
Result := Format('%s: NewCurrent=%d', [ClassName, FNewCurrent]);
|
||||
end;
|
||||
|
||||
procedure TGDBMIDebuggerCommandStack.DoCallstackFreed(Sender: TObject);
|
||||
begin
|
||||
{$IFDEF DBGMI_QUEUE_DEBUG}
|
||||
debugln(['DoCallstackFreed: ', DebugText]);
|
||||
{$ENDIF}
|
||||
FCallstack := nil;
|
||||
Cancel;
|
||||
end;
|
||||
|
||||
function TGDBMIDebuggerCommandStack.SelectThread: Boolean;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
t: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
FThreadChanged := False;
|
||||
if FCallstack.ThreadId = FTheDebugger.FCurrentThreadId then exit;
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
|
||||
t := FCallstack.ThreadId;
|
||||
if t = FTheDebugger.FCurrentThreadId then exit;
|
||||
FThreadChanged := True;
|
||||
Result := ExecuteCommand('-thread-select %d', [FCallstack.ThreadId], R);
|
||||
FTheDebugger.FInternalThreadId := FCallstack.ThreadId;
|
||||
Result := ExecuteCommand('-thread-select %d', [t], R);
|
||||
FTheDebugger.FInternalThreadId := t;
|
||||
Result := Result and (R.State <> dsError);
|
||||
end;
|
||||
|
||||
@ -1702,6 +1717,14 @@ constructor TGDBMIDebuggerCommandStack.Create(AOwner: TGDBMIDebugger;
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FCallstack := ACallstack;
|
||||
FCallstack.AddFreeeNotification(@DoCallstackFreed);
|
||||
end;
|
||||
|
||||
destructor TGDBMIDebuggerCommandStack.Destroy;
|
||||
begin
|
||||
if FCallstack <> nil
|
||||
then FCallstack.RemoveFreeeNotification(@DoCallstackFreed);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TGDBMIBreakPoints }
|
||||
@ -1783,6 +1806,7 @@ var
|
||||
begin
|
||||
if Monitor = nil then exit;
|
||||
Cmd := TGDBMIDebuggerCommandThreads(Sender);
|
||||
if CurrentThreads = nil then exit;
|
||||
|
||||
if not Cmd.Success then begin
|
||||
CurrentThreads.SetValidity(ddsInvalid);
|
||||
@ -1790,16 +1814,13 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if CurrentThreads <> nil
|
||||
then begin
|
||||
CurrentThreads.Clear;
|
||||
for i := 0 to Cmd.Count - 1 do
|
||||
CurrentThreads.Add(Cmd.Threads[i]);
|
||||
CurrentThreads.Clear;
|
||||
for i := 0 to Cmd.Count - 1 do
|
||||
CurrentThreads.Add(Cmd.Threads[i]);
|
||||
|
||||
CurrentThreads.SetValidity(ddsValid);
|
||||
CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
|
||||
Debugger.FCurrentThreadId := CurrentThreads.CurrentThreadId;
|
||||
end;
|
||||
CurrentThreads.SetValidity(ddsValid);
|
||||
CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
|
||||
Debugger.FCurrentThreadId := CurrentThreads.CurrentThreadId;
|
||||
end;
|
||||
|
||||
procedure TGDBMIThreads.DoChangeThreadsDestroyed(Sender: TObject);
|
||||
@ -3809,6 +3830,12 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{$IFDEF DBGMI_QUEUE_DEBUG}
|
||||
// results may be prefixed by "verbose" info, so IDE gets confused
|
||||
//ExecuteCommand('set verbose on', []);
|
||||
//ExecuteCommand('set complaints 99', []);
|
||||
{$ENDIF}
|
||||
|
||||
DebugLn(['TGDBMIDebugger.StartDebugging WorkingDir="', FTheDebugger.WorkingDir,'"']);
|
||||
if FTheDebugger.WorkingDir <> ''
|
||||
then begin
|
||||
@ -4027,7 +4054,7 @@ begin
|
||||
if DebuggerState = dsPause
|
||||
then ProcessFrame;
|
||||
finally
|
||||
ReleaseAndNil(FContinueCommand);
|
||||
ReleaseRefAndNil(FContinueCommand);
|
||||
end;
|
||||
|
||||
FSuccess := True;
|
||||
@ -4045,7 +4072,7 @@ end;
|
||||
|
||||
destructor TGDBMIDebuggerCommandStartDebugging.Destroy;
|
||||
begin
|
||||
ReleaseAndNil(FContinueCommand);
|
||||
ReleaseRefAndNil(FContinueCommand);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -5429,37 +5456,45 @@ var
|
||||
Frames: TGDBMINameValueListArray;
|
||||
e: TCallStackEntry;
|
||||
begin
|
||||
CurStartIdx := AStartIdx;
|
||||
SetLength(Args, AEndIdx-AStartIdx+1);
|
||||
PrepareArgs(Args, AStartIdx, AEndIdx, '-stack-list-arguments 1 %d %d', 'stack-args', 'args');
|
||||
try
|
||||
CurStartIdx := AStartIdx;
|
||||
SetLength(Args, AEndIdx-AStartIdx+1);
|
||||
PrepareArgs(Args, AStartIdx, AEndIdx, '-stack-list-arguments 1 %d %d', 'stack-args', 'args');
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
|
||||
|
||||
SetLength(Frames, AEndIdx-AStartIdx+1);
|
||||
PrepareArgs(Frames, AStartIdx, AEndIdx, '-stack-list-frames %d %d', 'stack', '');
|
||||
SetLength(Frames, AEndIdx-AStartIdx+1);
|
||||
PrepareArgs(Frames, AStartIdx, AEndIdx, '-stack-list-frames %d %d', 'stack', '');
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
|
||||
|
||||
if not It.Locate(AStartIdx)
|
||||
then if not It.EOM
|
||||
then IT.Next;
|
||||
while it.Valid and (not It.EOM) do begin
|
||||
e := TCallStackEntry(It.DataPtr^);
|
||||
if e.Index > AEndIdx then break;
|
||||
UpdateEntry(e, Args[e.Index-AStartIdx], Frames[e.Index-AStartIdx]);
|
||||
It.Next;
|
||||
if not It.Locate(AStartIdx)
|
||||
then if not It.EOM
|
||||
then IT.Next;
|
||||
while it.Valid and (not It.EOM) do begin
|
||||
e := TCallStackEntry(It.DataPtr^);
|
||||
if e.Index > AEndIdx then break;
|
||||
UpdateEntry(e, Args[e.Index-AStartIdx], Frames[e.Index-AStartIdx]);
|
||||
It.Next;
|
||||
end;
|
||||
|
||||
finally
|
||||
FreeList(Args);
|
||||
FreeList(Frames);
|
||||
end;
|
||||
|
||||
FreeList(Args);
|
||||
FreeList(Frames);
|
||||
end;
|
||||
|
||||
var
|
||||
StartIdx, EndIdx: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
|
||||
|
||||
It := TMapIterator.Create(FCallstack.RawEntries);
|
||||
try
|
||||
//if It.Locate(AIndex)
|
||||
StartIdx := Max(FCallstack.LowestUnknown, 0);
|
||||
EndIdx := FCallstack.HighestUnknown;
|
||||
while EndIdx >= StartIdx do begin
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then break;
|
||||
{$IFDEF DBG_VERBOSE}
|
||||
debugln(['Callstach.Frames A StartIdx=',StartIdx, ' EndIdx=',EndIdx]);
|
||||
{$ENDIF}
|
||||
@ -5479,6 +5514,7 @@ begin
|
||||
debugln(['Callstach.Frames B StartIdx=',StartIdx, ' EndIdx=',EndIdx]);
|
||||
{$ENDIF}
|
||||
ExecForRange(StartIdx, EndIdx);
|
||||
if (FCallstack = nil) or (dcsCanceled in SeenStates) then break;
|
||||
|
||||
if FCallstack.LowestUnknown < StartIdx
|
||||
then StartIdx := FCallstack.LowestUnknown
|
||||
@ -5488,7 +5524,8 @@ begin
|
||||
end;
|
||||
finally
|
||||
IT.Free;
|
||||
FCallstack.DoEntriesUpdated;
|
||||
if FCallstack <> nil
|
||||
then FCallstack.DoEntriesUpdated;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -7955,7 +7992,7 @@ end;
|
||||
|
||||
destructor TGDBMIDebuggerCommandLocals.Destroy;
|
||||
begin
|
||||
ReleaseAndNil(FLocals);
|
||||
ReleaseRefAndNil(FLocals);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -8415,6 +8452,7 @@ var
|
||||
begin
|
||||
FCommandList.Remove(Sender);
|
||||
Cmd := TGDBMIDebuggerCommandStackDepth(Sender);
|
||||
if Cmd.Callstack = nil then exit;
|
||||
if Cmd.Depth < 0 then begin
|
||||
Cmd.Callstack.SetCountValidity(ddsInvalid);
|
||||
end else begin
|
||||
@ -8489,9 +8527,13 @@ begin
|
||||
end;
|
||||
|
||||
procedure TGDBMICallStack.DoSetIndexCommandExecuted(Sender: TObject);
|
||||
var
|
||||
Cmd: TGDBMIDebuggerCommandStackSetCurrent;
|
||||
begin
|
||||
TGDBMIDebugger(Debugger).FCurrentStackFrame := TGDBMIDebuggerCommandStackSetCurrent(Sender).NewCurrent;
|
||||
TGDBMIDebuggerCommandStackSetCurrent(Sender).Callstack.CurrentIndex := TGDBMIDebuggerCommandStackSetCurrent(Sender).NewCurrent;
|
||||
Cmd := TGDBMIDebuggerCommandStackSetCurrent(Sender);
|
||||
TGDBMIDebugger(Debugger).FCurrentStackFrame := Cmd.NewCurrent;
|
||||
if Cmd.Callstack = nil then exit;
|
||||
Cmd.Callstack.CurrentIndex := Cmd.NewCurrent;
|
||||
end;
|
||||
|
||||
procedure TGDBMICallStack.UpdateCurrentIndex;
|
||||
|
||||
@ -868,6 +868,7 @@ var
|
||||
msg, SrcText: String;
|
||||
Ignore: Boolean;
|
||||
Editor: TSourceEditor;
|
||||
i: Integer;
|
||||
begin
|
||||
if Destroying then
|
||||
begin
|
||||
@ -898,7 +899,9 @@ begin
|
||||
Editor := SourceEditorManager.SourceEditorIntfWithFilename(AExceptionLocation.SrcFullName);
|
||||
if Editor <> nil then begin
|
||||
try
|
||||
SrcText := Trim(Editor.Lines[Editor.DebugToSourceLine(AExceptionLocation.SrcLine)]);
|
||||
i := Editor.DebugToSourceLine(AExceptionLocation.SrcLine);
|
||||
if i > 0
|
||||
then SrcText := Trim(Editor.Lines[i-1]);
|
||||
except
|
||||
end;
|
||||
end;
|
||||
@ -1235,7 +1238,7 @@ begin
|
||||
else
|
||||
SrcLine := -1;
|
||||
|
||||
ReleaseAndNil(CurrentSourceUnitInfo);
|
||||
ReleaseRefAndNil(CurrentSourceUnitInfo);
|
||||
|
||||
// clear old error and execution lines
|
||||
if SourceEditorManager <> nil
|
||||
|
||||
Loading…
Reference in New Issue
Block a user