Debugger: prevent Destroy while executing inside debugger object. Issue #17815

git-svn-id: trunk@28128 -

debugger/debugger.pp

@@ -78,7 +78,8 @@ type
     dsPause,
     dsInit,
     dsRun,
-    dsError
+    dsError,
+    dsDestroying
     );
 
   TDBGExceptionType = (
@@ -117,6 +118,11 @@ type
   dsError:
     Something unforseen has happened. A shutdown of the debugger is in
     most cases needed.
+
+  -dsDestroying
+    The debugger is about to be destroyed.
+    Should normally happen immediate on calling Release.
+    But the debugger may be in nested calls, and has to exit them first.
   --------------------------------------------------------------------------
 
 }
@@ -1323,6 +1329,7 @@ type
                              virtual; abstract; // True if succesful
     procedure SetExitCode(const AValue: Integer);
     procedure SetState(const AValue: TDBGState);
+    procedure DoRelease; virtual;
   public
     class function Caption: String; virtual;         // The name of the debugger as shown in the debuggeroptions
     class function ExePaths: String; virtual;        // The default locations of the exe
@@ -1339,6 +1346,7 @@ type
 
     procedure Init; virtual;                         // Initializes the debugger
     procedure Done; virtual;                         // Kills the debugger
+    procedure Release;                               // Free/Destroy self
     procedure Run;                                   // Starts / continues debugging
     procedure Pause;                                 // Stops running
     procedure Stop;                                  // quit debugging
@@ -1413,7 +1421,8 @@ const
     'Pause',
     'Init',
     'Run',
-    'Error'
+    'Error',
+    'Destroying'
     );
 
   DBGBreakPointActionNames: array[TIDEBreakPointAction] of string = (
@@ -1446,7 +1455,8 @@ const
              dcDisassemble],
   {dsInit } [],
   {dsRun  } [dcPause, dcStop, dcBreak, dcWatch, dcEnvironment],
-  {dsError} [dcStop]
+  {dsError} [dcStop],
+  {dsDestroying} []
   );
 
 var
@@ -1654,6 +1664,12 @@ begin
   FCurEnvironment.Clear;
 end;
 
+procedure TDebugger.Release;
+begin
+  if Self <> nil
+  then Self.DoRelease;
+end;
+
 procedure TDebugger.DoCurrent(const ALocation: TDBGLocationRec);
 begin
   if Assigned(FOnCurrent) then FOnCurrent(Self, ALocation);
@@ -1903,6 +1919,17 @@ procedure TDebugger.SetState(const AValue: TDBGState);
 var
   OldState: TDBGState;
 begin
+  // dsDestroying is final, do not unset
+  if FState = dsDestroying
+  then exit;
+
+  // dsDestroying must be silent. The ide believes the debugger is gone already
+  if AValue = dsDestroying
+  then begin
+    FState := AValue;
+    exit;
+  end;
+
   if AValue <> FState
   then begin
     OldState := FState;
@@ -1917,6 +1944,11 @@ begin
   end;
 end;
 
+procedure TDebugger.DoRelease;
+begin
+  Self.Free;
+end;
+
 procedure TDebugger.StepInto;
 begin
   if ReqCmd(dcStepInto, []) then exit;

debugger/gdbmidebugger.pp

@@ -132,6 +132,7 @@ type
     procedure DoUnockQueueExecute; virtual;
     function  DoExecute: Boolean; virtual; abstract;
     procedure DoOnExecuted;
+    procedure DoCancel; virtual;
     procedure DoOnCanceled;
     // ExecuteCommand does execute direct. It does not use the queue
     function  ExecuteCommand(const ACommand: String): Boolean; overload;
@@ -185,6 +186,7 @@ type
     FAsmCache: TTypedMap;
     FAsmCacheIter: TTypedMapIterator;
     FSourceNames: TStringList; // Objects[] -> TMap[Integer|Integer] -> TDbgPtr
+    FReleaseLock: Integer;
 
     // GDB info (move to ?)
     FGDBVersion: String;
@@ -216,6 +218,10 @@ type
                              out ADump, AStatement, AFile: String; out ALine: Integer): Boolean;
     function  GDBSourceAdress(const ASource: String; ALine, AColumn: Integer; out AAddr: TDbgPtr): Boolean;
 
+    // prevent destruction while nested in any call
+    procedure LockRelease;
+    procedure UnlockRelease;
+
     procedure CallStackSetCurrent(AIndex: Integer);
     function  ConvertPascalExpression(var AExpression: String): Boolean;
     // ---
@@ -250,6 +256,7 @@ type
     function  ExecuteCommandFull(const ACommand: String; const AValues: array of const; const AFlags: TGDBMICmdFlags; const ACallback: TGDBMICallback; const ATag: PtrInt; var AResult: TGDBMIExecResult): Boolean; overload;
     procedure QueueCommand(const ACommand: TGDBMIDebuggerCommand);
     procedure UnQueueCommand(const ACommand: TGDBMIDebuggerCommand);
+    procedure CancelAllQueued;
     function  StartDebugging(const AContinueCommand: String): Boolean;
   protected
     procedure QueueExecuteLock;
@@ -277,6 +284,7 @@ type
     property  TargetFlags: TGDBMITargetFlags read FTargetFlags write FTargetFlags;
     property  PauseWaitState: TGDBMIPauseWaitState read FPauseWaitState;
     property  DebuggerFlags: TGDBMIDebuggerFlags read FDebuggerFlags;
+    procedure DoRelease; override;   // Destroy self (or schedule)
   public
     class function CreateProperties: TDebuggerProperties; override; // Creates debuggerproperties
     class function Caption: String; override;
@@ -1594,6 +1602,7 @@ end;
 
 constructor TGDBMIDebugger.Create(const AExternalDebugger: String);
 begin
+  FReleaseLock := 0;
   FBreakErrorBreakID := -1;
   FRunErrorBreakID := -1;
   FExceptionBreakID := -1;
@@ -1653,6 +1662,7 @@ end;
 
 destructor TGDBMIDebugger.Destroy;
 begin
+  LockRelease;
   inherited;
   ClearCommandQueue;
   FreeAndNil(FCommandQueue);
@@ -1664,9 +1674,15 @@ end;
 
 procedure TGDBMIDebugger.Done;
 begin
+  LockRelease;
+  try
+    CancelAllQueued;
     if State = dsRun then GDBPause(True);
     ExecuteCommand('-gdb-exit', []);
     inherited Done;
+  finally
+    UnlockRelease;
+  end;
 end;
 
 procedure TGDBMIDebugger.DoState(const OldState: TDBGState);
@@ -1681,6 +1697,15 @@ begin
   inherited DoState(OldState);
 end;
 
+procedure TGDBMIDebugger.DoRelease;
+begin
+  SetState(dsDestroying);
+  if FReleaseLock > 0
+  then exit;
+
+  inherited DoRelease;
+end;
+
 function TGDBMIDebugger.ExecuteCommand(const ACommand: String;
   const AFlags: TGDBMICmdFlags): Boolean;
 var
@@ -1748,7 +1773,11 @@ procedure TGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand);
 var
   R: Boolean;
   Cmd: TGDBMIDebuggerCommand;
+  SavedInExecuteCount: LongInt;
 begin
+  SavedInExecuteCount := FInExecuteCount;
+  LockRelease;
+  try
     FCommandQueue.Add(ACommand);
     if (FCommandQueue.Count > 1) or (FCommandQueueExecLock > 0)
     then begin
@@ -1762,7 +1791,7 @@ begin
     // If we are here we can process the command directly
     repeat
       Inc(FInExecuteCount);
-    try
+
       Cmd := TGDBMIDebuggerCommand(FCommandQueue[0]);
       FCommandQueue.Delete(0);
       {$IFDEF GDMI_QUEUE_DEBUG}
@@ -1771,16 +1800,14 @@ begin
       R := Cmd.Execute;
       Cmd.DoFinished;
 
-      if State = dsError
+      Dec(FInExecuteCount);
+
+      if State in [dsError, dsDestroying]
       then begin
         //DebugLn('[WARNING] TGDBMIDebugger:  ExecuteCommand "',Cmd,'" failed.');
         Break;
       end;
 
-    finally
-      Dec(FInExecuteCount);
-    end;
-
       if  FCommandQueue.Count = 0
       then begin
         if  (FInExecuteCount = 0)                        // not in Recursive call
@@ -1803,6 +1830,10 @@ begin
     {$IFDEF GDMI_QUEUE_DEBUG}
     debugln(['Leaving Queue with count: ', FCommandQueue.Count, ' Recurse-Count=', FInExecuteCount,' State=',DBGStateNames[State]]);
     {$ENDIF}
+  finally
+    UnlockRelease;
+    FInExecuteCount := SavedInExecuteCount;
+  end;
 end;
 
 procedure TGDBMIDebugger.UnQueueCommand(const ACommand: TGDBMIDebuggerCommand);
@@ -1810,6 +1841,19 @@ begin
   FCommandQueue.Remove(ACommand);
 end;
 
+procedure TGDBMIDebugger.CancelAllQueued;
+var
+  i: Integer;
+begin
+  i := FCommandQueue.Count - 1;
+  while i >= 0 do begin
+    TGDBMIDebuggerCommand(FCommandQueue[i]).Cancel;
+    dec(i);
+    if i >= FCommandQueue.Count
+    then i := FCommandQueue.Count - 1;
+  end;
+end;
+
 class function TGDBMIDebugger.ExePaths: String;
 begin
   Result := '/usr/bin/gdb;/usr/local/bin/gdb;/opt/fpc/gdb';
@@ -2482,6 +2526,18 @@ begin
   LinesList.Free;
 end;
 
+procedure TGDBMIDebugger.LockRelease;
+begin
+  inc(FReleaseLock);
+end;
+
+procedure TGDBMIDebugger.UnlockRelease;
+begin
+  dec(FReleaseLock);
+  if (FReleaseLock = 0) and (State = dsDestroying)
+  then Release;
+end;
+
 function TGDBMIDebugger.GDBStepInto: Boolean;
 begin
   Result := False;
@@ -2727,6 +2783,8 @@ procedure TGDBMIDebugger.Init;
 var
   Options: String;
 begin
+  LockRelease;
+  try
     FPauseWaitState := pwsNone;
     FInExecuteCount := 0;
 
@@ -2759,6 +2817,9 @@ begin
       else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0);
       SetState(dsError);
     end;
+  finally
+    UnlockRelease;
+  end;
 end;
 
 procedure TGDBMIDebugger.InterruptTarget;
@@ -3244,6 +3305,8 @@ end;
 
 function TGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
 begin
+  LockRelease;
+  try
     case ACommand of
       dcRun:         Result := GDBRun;
       dcPause:       Result := GDBPause(False);
@@ -3260,6 +3323,9 @@ begin
                                               String(AParams[3].VPointer^), String(AParams[4].VPointer^),
                                               String(AParams[5].VPointer^), Integer(AParams[6].VPointer^));
     end;
+  finally
+    UnlockRelease;
+  end;
 end;
 
 procedure TGDBMIDebugger.ClearCommandQueue;
@@ -5505,8 +5571,6 @@ begin
   OldState := FState;
   FState := NewState;
   DoStateChanged(OldState);
-  if State = dcsCanceled
-  then DoOnCanceled;
   if State in [dcsFinished, dcsCanceled]
   then DoFree;
 end;
@@ -5538,6 +5602,11 @@ begin
     FOnExecuted(self);
 end;
 
+procedure TGDBMIDebuggerCommand.DoCancel;
+begin
+  // empty
+end;
+
 procedure TGDBMIDebuggerCommand.DoOnCanceled;
 begin
   if assigned(FOnCancel) then
@@ -5915,9 +5984,9 @@ end;
 
 procedure TGDBMIDebuggerCommand.Cancel;
 begin
-  if State <> dcsQueued
-  then exit;
   FTheDebugger.UnQueueCommand(Self);
+  DoCancel;
+  DoOnCanceled;
   SetState(dcsCanceled);
 end;
 

ide/debugmanager.pas

@@ -1503,8 +1503,8 @@ procedure TDebugManager.DebuggerChangeState(ADebugger: TDebugger;
 const
   // dsNone, dsIdle, dsStop, dsPause, dsInit, dsRun, dsError
   TOOLSTATEMAP: array[TDBGState] of TIDEToolStatus = (
-    // dsNone, dsIdle, dsStop, dsPause, dsInit,     dsRun,      dsError
+    // dsNone, dsIdle, dsStop, dsPause, dsInit,     dsRun,      dsError,    dsDestroying
-    itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger
+    itNone, itNone, itNone, itDebugger, itDebugger, itDebugger, itDebugger, itNone
   );
   //STATENAME: array[TDBGState] of string = (
   //  'dsNone', 'dsIdle', 'dsStop', 'dsPause', 'dsInit', 'dsRun', 'dsError'
@@ -2259,7 +2259,7 @@ var
 begin
   dbg := FDebugger;
   SetDebugger(nil);
-  dbg.Free;
+  dbg.Release;
   FManagerStates := [];
 
   if MainIDE.ToolStatus = itDebugger