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
-  if State = dsRun then GDBPause(True);
+  LockRelease;
-  ExecuteCommand('-gdb-exit', []);
+  try
-  inherited Done;
+    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,21 +1773,25 @@ procedure TGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand);
 var
   R: Boolean;
   Cmd: TGDBMIDebuggerCommand;
+  SavedInExecuteCount: LongInt;
 begin
-  FCommandQueue.Add(ACommand);
+  SavedInExecuteCount := FInExecuteCount;
-  if (FCommandQueue.Count > 1) or (FCommandQueueExecLock > 0)
+  LockRelease;
-  then begin
+  try
-    {$IFDEF GDMI_QUEUE_DEBUG}
+    FCommandQueue.Add(ACommand);
-    debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos ', FCommandQueue.Count-1, ': "', ACommand.DebugText,'" State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock ]);
+    if (FCommandQueue.Count > 1) or (FCommandQueueExecLock > 0)
-    {$ENDIF}
+    then begin
-    ACommand.DoQueued;
+      {$IFDEF GDMI_QUEUE_DEBUG}
-    Exit;
+      debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos ', FCommandQueue.Count-1, ': "', ACommand.DebugText,'" State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock ]);
-  end;
+      {$ENDIF}
+      ACommand.DoQueued;
+      Exit;
+    end;
+
+    // If we are here we can process the command directly
+    repeat
+      Inc(FInExecuteCount);
 
-  // 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,38 +1800,40 @@ 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
+      if  FCommandQueue.Count = 0
-      Dec(FInExecuteCount);
-    end;
-
-    if  FCommandQueue.Count = 0
-    then begin
-      if  (FInExecuteCount = 0)                        // not in Recursive call
-      and (FPauseWaitState = pwsInternal)
-      and (State = dsRun)
       then begin
-        // reset state
+        if  (FInExecuteCount = 0)                        // not in Recursive call
-        FPauseWaitState := pwsNone;
+        and (FPauseWaitState = pwsInternal)
-        // insert continue command
+        and (State = dsRun)
-        Cmd := TGDBMIDebuggerSimpleCommand.Create(Self, '-exec-continue', [], [], nil, 0);
+        then begin
-        FCommandQueue.Add(Cmd);
+          // reset state
-        {$IFDEF GDMI_QUEUE_DEBUG}
+          FPauseWaitState := pwsNone;
-        debugln(['Internal Queueing: exec-continue']);
+          // insert continue command
-        {$ENDIF}
+          Cmd := TGDBMIDebuggerSimpleCommand.Create(Self, '-exec-continue', [], [], nil, 0);
-      end
+          FCommandQueue.Add(Cmd);
-      else Break; // Queue empty
+          {$IFDEF GDMI_QUEUE_DEBUG}
-    end;
+          debugln(['Internal Queueing: exec-continue']);
+          {$ENDIF}
+        end
+        else Break; // Queue empty
+      end;
 
-  until not R;
+    until not R;
-  {$IFDEF GDMI_QUEUE_DEBUG}
+    {$IFDEF GDMI_QUEUE_DEBUG}
-  debugln(['Leaving Queue with count: ', FCommandQueue.Count, ' Recurse-Count=', FInExecuteCount,' State=',DBGStateNames[State]]);
+    debugln(['Leaving Queue with count: ', FCommandQueue.Count, ' Recurse-Count=', FInExecuteCount,' State=',DBGStateNames[State]]);
-  {$ENDIF}
+    {$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,37 +2783,42 @@ procedure TGDBMIDebugger.Init;
 var
   Options: String;
 begin
-  FPauseWaitState := pwsNone;
+  LockRelease;
-  FInExecuteCount := 0;
+  try
+    FPauseWaitState := pwsNone;
+    FInExecuteCount := 0;
 
-  Options := '-silent -i mi -nx';
+    Options := '-silent -i mi -nx';
 
-  if Length(TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options) > 0
+    if Length(TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options) > 0
-  then Options := Options + ' ' + TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options;
+    then Options := Options + ' ' + TGDBMIDebuggerProperties(GetProperties).Debugger_Startup_Options;
 
-  if CreateDebugProcess(Options)
+    if CreateDebugProcess(Options)
-  then begin
-    if not ParseInitialization
     then begin
+      if not ParseInitialization
+      then begin
+        SetState(dsError);
+        Exit;
+      end;
+
+      ExecuteCommand('-gdb-set confirm off', []);
+      // for win32, turn off a new console otherwise breaking gdb will fail
+      // ignore the error on other platforms
+      ExecuteCommand('-gdb-set new-console off', [cfIgnoreError]);
+
+      if not ParseGDBVersionMI then ParseGDBVersion;
+      CheckGDBVersion;
+
+      inherited Init;
+    end
+    else begin
+      if DebugProcess = nil
+      then MessageDlg('Debugger', 'Failed to create debug process for unknown reason', mtError, [mbOK], 0)
+      else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0);
       SetState(dsError);
-      Exit;
     end;
-
+  finally
-    ExecuteCommand('-gdb-set confirm off', []);
+    UnlockRelease;
-    // for win32, turn off a new console otherwise breaking gdb will fail
-    // ignore the error on other platforms
-    ExecuteCommand('-gdb-set new-console off', [cfIgnoreError]);
-
-    if not ParseGDBVersionMI then ParseGDBVersion;
-    CheckGDBVersion;
-
-    inherited Init;
-  end
-  else begin
-    if DebugProcess = nil
-    then MessageDlg('Debugger', 'Failed to create debug process for unknown reason', mtError, [mbOK], 0)
-    else MessageDlg('Debugger', Format('Failed to create debug process: %s', [ReadLine]), mtError, [mbOK], 0);
-    SetState(dsError);
   end;
 end;
 
@@ -3244,21 +3305,26 @@ end;
 
 function TGDBMIDebugger.RequestCommand(const ACommand: TDBGCommand; const AParams: array of const): Boolean;
 begin
-  case ACommand of
+  LockRelease;
-    dcRun:         Result := GDBRun;
+  try
-    dcPause:       Result := GDBPause(False);
+    case ACommand of
-    dcStop:        Result := GDBStop;
+      dcRun:         Result := GDBRun;
-    dcStepOver:    Result := GDBStepOver;
+      dcPause:       Result := GDBPause(False);
-    dcStepInto:    Result := GDBStepInto;
+      dcStop:        Result := GDBStop;
-    dcStepOut:     Result := GDBStepOut;
+      dcStepOver:    Result := GDBStepOver;
-    dcRunTo:       Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
+      dcStepInto:    Result := GDBStepInto;
-    dcJumpto:      Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
+      dcStepOut:     Result := GDBStepOut;
-    dcEvaluate:    Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^),TGDBType(AParams[2].VPointer^));
+      dcRunTo:       Result := GDBRunTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
-    dcModify:      Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString));
+      dcJumpto:      Result := GDBJumpTo(String(AParams[0].VAnsiString), AParams[1].VInteger);
-    dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
+      dcEvaluate:    Result := GDBEvaluate(String(AParams[0].VAnsiString), String(AParams[1].VPointer^),TGDBType(AParams[2].VPointer^));
-    dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
+      dcModify:      Result := GDBModify(String(AParams[0].VAnsiString), String(AParams[1].VAnsiString));
-                                            String(AParams[3].VPointer^), String(AParams[4].VPointer^),
+      dcEnvironment: Result := GDBEnvironment(String(AParams[0].VAnsiString), AParams[1].VBoolean);
-                                            String(AParams[5].VPointer^), Integer(AParams[6].VPointer^));
+      dcDisassemble: Result := GDBDisassemble(AParams[0].VQWord^, AParams[1].VBoolean, TDbgPtr(AParams[2].VPointer^),
+                                              String(AParams[3].VPointer^), String(AParams[4].VPointer^),
+                                              String(AParams[5].VPointer^), Integer(AParams[6].VPointer^));
+    end;
+  finally
+    UnlockRelease;
   end;
 end;
 
@@ -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