DBG: Prevent exec-commands from running nested in other commands. Always queue, and run in the outer most "RunQueue" call.

Prevents state driven changes to IDE objects, while IDE is working on them (IDE-locals are destroyed while being evaluated). Issue #19551

git-svn-id: trunk@31208 -

debugger/gdbmidebugger.pp

@@ -277,15 +277,24 @@ type
     property  Properties: TGDBMIDebuggerCommandProperts read FProperties write FProperties;
   end;
 
+  { TGDBMIDebuggerCommandList }
+
+  TGDBMIDebuggerCommandList = class(TRefCntObjList)
+  private
+    function Get(Index: Integer): TGDBMIDebuggerCommand;
+    procedure Put(Index: Integer; const AValue: TGDBMIDebuggerCommand);
+  public
+    property Items[Index: Integer]: TGDBMIDebuggerCommand read Get write Put; default;
+  end;
+
   { TGDBMIDebugger }
 
   TGDBMIDebugger = class(TCmdLineDebugger)
   private
-    FCommandQueue: TList;
+    FCommandQueue: TGDBMIDebuggerCommandList;
     FCurrentCommand: TGDBMIDebuggerCommand;
     FCommandQueueExecLock: Integer;
     FCommandProcessingLock: Integer;
-    FProcessingExeCmdLock: Integer;
 
     FMainAddr: TDbgPtr;
     FBreakAtMain: TDBGBreakPoint;
@@ -1449,6 +1458,18 @@ begin
   Result := '"' + Result + '"';
 end;
 
+{ TGDBMIDebuggerCommandList }
+
+function TGDBMIDebuggerCommandList.Get(Index: Integer): TGDBMIDebuggerCommand;
+begin
+  Result := TGDBMIDebuggerCommand(inherited Items[Index]);
+end;
+
+procedure TGDBMIDebuggerCommandList.Put(Index: Integer; const AValue: TGDBMIDebuggerCommand);
+begin
+  inherited Items[Index] := AValue;
+end;
+
 { TGDBMIDebuggerCommandChangeFilename }
 
 function TGDBMIDebuggerCommandChangeFilename.DoExecute: Boolean;
@@ -4608,8 +4629,6 @@ begin
   FNextExecQueued := False;
   //ContinueExecution := True;
 
-  FTheDebugger.FProcessingExeCmdLock := FTheDebugger.FInExecuteCount;
-  try
   FTheDebugger.QueueExecuteLock; // prevent other commands from executing
   try
     if not ExecuteCommand(FCommand, FResult)
@@ -4686,10 +4705,6 @@ begin
     debugln(['ERROR: Got NO stop params at all, but was running']);
     //SetDebuggerState(dsError); // we cannot be running anymore
   end;
-  finally
-    FTheDebugger.FProcessingExeCmdLock := -1;
-  end;
-
 end;
 
 constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
@@ -4702,6 +4717,7 @@ constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
   const ExecType: TGDBMIExecCommandType; Args: array of const);
 begin
   inherited Create(AOwner);
+  FQueueRunLevel := 0; // Execommands are only allowed at level 0
   FCanKillNow := False;
   FDidKillNow := False;;
   FNextExecQueued := False;
@@ -5369,7 +5385,7 @@ begin
   FBreakErrorBreakID := -1;
   FRunErrorBreakID := -1;
   FExceptionBreakID := -1;
-  FCommandQueue := TList.Create;
+  FCommandQueue := TGDBMIDebuggerCommandList.Create;
   FTargetInfo.TargetPID := 0;
   FTargetInfo.TargetFlags := [];
   FDebuggerFlags := [];
@@ -5378,7 +5394,6 @@ begin
   FSourceNames.Duplicates := dupError;
   FSourceNames.CaseSensitive := False;
   FCommandQueueExecLock := 0;
-  FProcessingExeCmdLock := -1;
   FRunQueueOnUnlock := False;
   FThreadGroups := TStringList.Create;
 
@@ -5729,7 +5744,7 @@ begin
   LockRelease;
   try
     repeat
-      Cmd := TGDBMIDebuggerCommand(FCommandQueue[0]);
+      Cmd := FCommandQueue[0];
       if (Cmd.QueueRunLevel >= 0) and (Cmd.QueueRunLevel < FInExecuteCount)
       then break;
 
@@ -5797,49 +5812,65 @@ end;
 procedure TGDBMIDebugger.QueueCommand(const ACommand: TGDBMIDebuggerCommand; ForceQueue: Boolean = False);
 var
   i, p: Integer;
-  QueueExeInExe, CanRunQueue: Boolean;
+  CanRunQueue: Boolean;
 begin
+  (* TODO: if an exec-command is queued, cancel watches-commands, etc (unless required for snapshot)
+     This may occur if multiply exe are queued.
+     Currently, they will be ForcedQueue, and end up, after the exec command => cancel by state change
+  *)
+
+
   p := ACommand.Priority;
   i := 0;
+  // CanRunQueue: The queue can be run for "ACommand"
+  //  Either the queue is empty (so no other command will run)
+  //  Or the first command on the queue is blocked by "QueueRunLevel"
   CanRunQueue := (FCommandQueue.Count = 0)
     or ( (FCommandQueue.Count > 0)
-        and (TGDBMIDebuggerCommand(FCommandQueue[0]).QueueRunLevel >= 0)
-        and (TGDBMIDebuggerCommand(FCommandQueue[0]).QueueRunLevel < FInExecuteCount)
+        and (FCommandQueue[0].QueueRunLevel >= 0)
+        and (FCommandQueue[0].QueueRunLevel < FInExecuteCount)
        );
 
+  if (ACommand is TGDBMIDebuggerCommandExecute) then begin
+    // Execute-commands, must be queued at the end. They have QueueRunLevel, so they only run in the outer loop
+    CanRunQueue := (FCommandQueue.Count = 0);
+    i := FCommandQueue.Add(ACommand);
+  end
+  else
   if p > 0 then begin
+    // Queue Pririty commands
+    // TODO: check for "CanRunQueue": should be at start?
     while (i < FCommandQueue.Count)
-    and (TGDBMIDebuggerCommand(FCommandQueue[i]).Priority >= p)
+    and (FCommandQueue[i].Priority >= p)
     and ( (ForceQueue)
-       or (TGDBMIDebuggerCommand(FCommandQueue[i]).QueueRunLevel < 0)
-       or (TGDBMIDebuggerCommand(FCommandQueue[i]).QueueRunLevel >= FInExecuteCount)
+       or (FCommandQueue[i].QueueRunLevel < 0)
+       or (FCommandQueue[i].QueueRunLevel >= FInExecuteCount)
         )
     do inc(i);
     FCommandQueue.Insert(i, ACommand);
   end
   else begin
+    // Queue normal commands
     if (not ForceQueue) and (FCommandQueue.Count > 0)
-    and CanRunQueue  // first item is deffered, so new item inserted can run
+    and CanRunQueue  // first item is deferred, so new item inserted can run
     then
       FCommandQueue.Insert(0, ACommand)
     else
       i := FCommandQueue.Add(ACommand);
   end;
 
-  QueueExeInExe := (FProcessingExeCmdLock > 0)
-               and (ACommand is TGDBMIDebuggerCommandExecute);
   // if other commands do run the queue,
   // make sure this command only runs after the CurrentCommand finished
-  if ForceQueue then
+  if ForceQueue and
+    ( (ACommand.QueueRunLevel < 0) or (ACommand.QueueRunLevel >= FInExecuteCount) )
+  then
     ACommand.QueueRunLevel := FInExecuteCount - 1;
-  if QueueExeInExe then
-    ACommand.QueueRunLevel := FProcessingExeCmdLock - 1;
 
   if (not CanRunQueue) or (FCommandQueueExecLock > 0)
-  or (FCommandProcessingLock > 0) or ForceQueue or QueueExeInExe
+  or (FCommandProcessingLock > 0) or ForceQueue
   then begin
     {$IFDEF DBGMI_QUEUE_DEBUG}
-    debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos=', i, ' cnt=',FCommandQueue.Count-1, ' State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock, ' Forced=', dbgs(ForceQueue), ' ExeInExe=', dbgs(QueueExeInExe), ' Prior=',p, ': "', ACommand.DebugText,'"']);
+    debugln(['Queueing (Recurse-Count=', FInExecuteCount, ') at pos=', i, ' cnt=',FCommandQueue.Count-1, ' State=',DBGStateNames[State], ' Lock=',FCommandQueueExecLock, ' Forced=', dbgs(ForceQueue), ' Prior=',p, ': "', ACommand.DebugText,'"']);
     {$ENDIF}
     ACommand.DoQueued;
 

ide/debugmanager.pas

@@ -880,7 +880,9 @@ begin
   then FCurrentBreakpoint := nil;
 
   // Notify FSnapshots of new state (while dialogs still in updating)
-  if (FCurrentBreakpoint <> nil) and (bpaTakeSnapshot in FCurrentBreakpoint.Actions) then begin
+  if (FCurrentBreakpoint <> nil) and (bpaTakeSnapshot in FCurrentBreakpoint.Actions) and
+     (State in [dsPause, dsInternalPause])
+  then begin
     FSnapshots.DoStateChange(OldState);
     FSnapshots.Current.AddToSnapshots;
     FSnapshots.DoDebuggerIdle(True);