GdbmiServerDebugger: Added stop on disconnect. Issue #0036076

git-svn-id: trunk@61886 -

components/lazdebuggergdbmi/gdbmidebugger.pp

@@ -942,6 +942,9 @@ type
     function  GetCommands: TDBGCommands; override;
     function  GetTargetWidth: Byte; override;
     procedure InterruptTarget; virtual;
+    procedure ProcessLineWhileRunning(const ALine: String; AnInLogWarning: boolean;
+      var AHandled, AForceStop: Boolean; var AStoppedParams: String; var AResult: TGDBMIExecResult); virtual;
+
     function  ParseInitialization: Boolean; virtual;
     function  CreateCommandInit: TGDBMIDebuggerCommandInitDebugger; virtual;
     function  CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; virtual;
@@ -2925,22 +2928,19 @@ var
       Delete(Warning, 1, 2);
     if Copy(Warning, Length(Warning) - 2, 3) = '\n"' then
       Delete(Warning, Length(Warning) - 2, 3);
-    if LowerCase(Copy(Warning, 1, Length(LogWarning))) = LogWarning then
+    if InLogWarning then
     begin
-      InLogWarning := True;
-      Delete(Warning, 1, Length(LogWarning));
       Warning := MakePrintable(UnEscapeBackslashed(Trim(Warning), [uefOctal, uefTab, uefNewLine]));
       DoDbgEvent(ecOutput, etOutputDebugString, Format(gdbmiEventLogDebugOutput, [Warning]));
     end;
     if InLogWarning then
       FLogWarnings := FLogWarnings + Warning + LineEnding;
-    if Line = '&"\n"' then
-      InLogWarning := False;
 
     if FTheDebugger.CheckForInternalError(Line, '') then begin
       AResult.State := dsStop;
       ForceStop := True;
     end;
+
 (*
 << TCmdLineDebugger.ReadLn "&"Warning:\n""
   << TCmdLineDebugger.ReadLn "&"Cannot insert breakpoint 11.\n""
@@ -2954,12 +2954,35 @@ var
 *)
   end;
 
+  procedure CheckMultiLineLogWarning(const Line: String; var AInLogWarning: Boolean);
+  const
+    LogWarning = 'warning:';
+  var
+    i: Integer;
+  begin
+    if (Line = '') or (Line[1] <> '&') then
+      InLogWarning := False;
+    if Length(Line) < Length(LogWarning) then
+      exit;
+
+    i := 1;
+    if (Line[1] = '&') and  (Line[2] = '"') then
+      i := 3;
+    if LowerCase(Copy(Line, i, Length(LogWarning))) = LogWarning then
+      AInLogWarning := True;
+      //Delete(Line, 1, Length(LogWarning));
+
+    if Line = '&"\n"' then
+      InLogWarning := False;
+  end;
+
 var
   S, s2: String;
   idx: Integer;
   {$IFDEF DBG_ASYNC_WAIT}
   GotPrompt: integer;
   {$ENDIF}
+  LineHandled: Boolean;
 begin
   {$IFDEF DBG_ASYNC_WAIT}
   GotPrompt := 0;
@@ -3013,8 +3036,11 @@ begin
 
     while S <> '' do
     begin
-      if S[1] <> '&' then
+      CheckMultiLineLogWarning(S, InLogWarning);
-        InLogWarning := False;
+
+      LineHandled := False;
+      FTheDebugger.ProcessLineWhileRunning(S, InLogWarning, LineHandled, ForceStop, AStoppedParams, AResult);
+      if not LineHandled then begin
         case S[1] of
           '^': DoResultRecord(S);
           '~': DoConsoleStream(S);
@@ -3039,6 +3065,7 @@ begin
             DebugLn(DBG_VERBOSE, '[DBGTGT] ', S);
           end;
         end;
+      end;
 
       if not (tfPidDetectionDone in  FTheDebugger.FTargetInfo.TargetFlags) then begin
         s2 := GetPart(['Switching to process '], [' local', ']'], S, True);
@@ -9346,6 +9373,13 @@ begin
 {$ENDIF}
 end;
 
+procedure TGDBMIDebuggerBase.ProcessLineWhileRunning(const ALine: String;
+  AnInLogWarning: boolean; var AHandled, AForceStop: Boolean;
+  var AStoppedParams: String; var AResult: TGDBMIExecResult);
+begin
+  //
+end;
+
 function TGDBMIDebuggerBase.ParseInitialization: Boolean;
 var
   Line, S: String;

components/lazdebuggergdbmi/gdbmiserverdebugger.pas

@@ -47,6 +47,9 @@ type
     function CreateCommandInit: TGDBMIDebuggerCommandInitDebugger; override;
     function CreateCommandStartDebugging(AContinueCommand: TGDBMIDebuggerCommand): TGDBMIDebuggerCommandStartDebugging; override;
     procedure InterruptTarget; override;
+    procedure ProcessLineWhileRunning(const ALine: String; AnInLogWarning: boolean;
+      var AHandled, AForceStop: Boolean; var AStoppedParams: String;
+      var AResult: TGDBMIExecResult); override;
     procedure StopInitProc;
   public
     InitProc: TProcessUTF8;
@@ -333,6 +336,29 @@ begin
   inherited InterruptTarget;
 end;
 
+procedure TGDBMIServerDebugger.ProcessLineWhileRunning(const ALine: String;
+  AnInLogWarning: boolean; var AHandled, AForceStop: Boolean;
+  var AStoppedParams: String; var AResult: TGDBMIExecResult);
+const
+  LogDisconnect = 'remote connection closed';
+var
+  i: Integer;
+begin
+  inherited ProcessLineWhileRunning(ALine, AnInLogWarning, AHandled, AForceStop,
+    AStoppedParams, AResult);
+
+  // If remote connection terminated then this debugging session is over
+  i := 1;
+  if (ALine[1] = '&') and  (ALine[2] = '"') then
+    i := 3;
+  if (not AnInLogWarning) and (LowerCase(Copy(ALine, i, Length(LogDisconnect))) = LogDisconnect) then begin
+    AHandled := True;
+    AForceStop := True;
+    AStoppedParams := '';
+    SetState(dsStop);
+  end;
+end;
+
 procedure TGDBMIServerDebugger.StopInitProc;
 begin
   if not Assigned(InitProc) then Exit;