DBG: some fixes -dDEB_WITH_TIMEOUT

git-svn-id: trunk@28505 -

debugger/cmdlinedebugger.pp

@@ -95,17 +95,17 @@ uses
 {------------------------------------------------------------------------------
   Function: WaitForHandles
   Params:  AHandles:              A set of handles to wait for (max 32)
-  TimeOut: Max Time in milli-secs
+  TimeOut: Max Time in milli-secs => set to 0 if timeout occured
   Returns: BitArray of handles set, 0 when an error occoured
  ------------------------------------------------------------------------------}
-function WaitForHandles(const AHandles: array of Integer; ATimeOut: Integer = -1): Integer;
+function WaitForHandles(const AHandles: array of Integer; var ATimeOut: Integer): Integer;
 {$IFDEF UNIX}
 var
   n, R, Max, Count: Integer;
   TimeOut: Integer;
   FDSWait, FDS: TFDSet;
   Step: Integer;
-  t, t2: DWord;
+  t, t2, t3: DWord;
 begin
   Result := 0;
   Max := 0;
@@ -145,10 +145,17 @@ begin
     if (ATimeOut > 0) then begin
       t2 := GetTickCount;
       if t2 < t
-      then t2 := t2 + High(t) - t
-      else t2 := t2 - t;
-      if (t2 > ATimeOut)
-      then break;
+      then t3 := t2 + (High(t) - t)
+      else t3 := t2 - t;
+      if (t3 >= ATimeOut)
+      then begin
+        ATimeOut := 0;
+        break;
+      end
+      else begin
+        ATimeOut := ATimeOut - t3;
+        t := t2;
+      end;
     end;
 
     inc(Step);
@@ -181,7 +188,7 @@ var
   R: LongBool;
   n: integer;
   Step: Integer;
-  t, t2: DWord;
+  t, t2, t3: DWord;
 begin
   Result := 0;
   Step:=0;
@@ -211,10 +218,17 @@ begin
     if (ATimeOut > 0) then begin
       t2 := GetTickCount;
       if t2 < t
-      then t2 := t2 + High(t) - t
-      else t2 := t2 - t;
-      if (t2 > ATimeOut)
-      then break;
+      then t3 := t2 + (High(t) - t)
+      else t3 := t2 - t;
+      if (t3 >= ATimeOut)
+      then begin
+        ATimeOut := 0;
+        break;
+      end
+      else begin
+        ATimeOut := ATimeOut - t3;
+        t := t2;
+      end;
     end;
 
     // process messages
@@ -237,6 +251,14 @@ end;
 {$ENDIF win32}
 {$ENDIF linux}
 
+function WaitForHandles(const AHandles: array of Integer): Integer; overload;
+var
+  t: Integer;
+begin
+  t := -1;
+  WaitForHandles(AHandles, t);
+end;
+
 //////////////////////////////////////////////////
 
 { TCmdLineDebugger }
@@ -327,14 +349,11 @@ var
   WaitSet: Integer;
   LineEndMatch: String;
   n, Idx, MinIdx, PeekCount: Integer;
-  t, t2: DWord;
-begin                
+begin
 //  WriteLN('[TCmdLineDebugger.GetOutput] Enter');
 
 // TODO: get extra handles to wait for
 // TODO: Fix multiple peeks
-  if ATimeOut > 0
-  then t := GetTickCount;
   Result := '';
   FReadLineTimedOut := False;
 
@@ -376,29 +395,23 @@ begin
       end;
     end;
 
-    if (ATimeOut > 0) then begin
-      t2 := GetTickCount;
-      if t2 < t
-      then t2 := t2 + High(t) - t
-      else t2 := t2 - t;
-      if (t2 >= ATimeOut)
-      then begin
-        FReadLineTimedOut := True;
-        break;
-      end;
-      ATimeOut := ATimeOut - t2;
-      t := t2;
-    end;
+    if FReadLineTimedOut
+    then break;
 
     WaitSet := WaitForHandles([FDbgProcess.Output.Handle], ATimeOut);
-    if WaitSet = 0
+
+    if (ATimeOut = 0)
+    then FReadLineTimedOut := True;
+
+
+    if (WaitSet = 0) and not FReadLineTimedOut
     then begin
       SmartWriteln('[TCmdLineDebugger.Getoutput] Error waiting ');
       SetState(dsError);
       Break;
     end;
-    
-    if  ((WaitSet and 1) <> 0) 
+
+    if  ((WaitSet and 1) <> 0)
     and (FDbgProcess <> nil)
     and (ReadData(FDbgProcess.Output, FOutputBuf) > 0) 
     then Continue; // start lineend search

debugger/gdbmidebugger.pp

@@ -7823,6 +7823,8 @@ end;
 function TGDBMIDebuggerCommand.ExecuteCommand(const ACommand: String;
   out AResult: TGDBMIExecResult; AFlags: TGDBMICommandFlags = [];
   ATimeOut: Integer = -1): Boolean;
+var
+  R: TGDBMIExecResult;
 begin
   AResult.Values := '';
   AResult.State := dsNone;
@@ -7836,13 +7838,19 @@ begin
   if ProcessResultTimedOut then begin
     FTheDebugger.SendCmdLn('-data-evaluate-expression 1');
     Result := ProcessResult(AResult, Min(ATimeOut, 1000));
-    ProcessResult(AResult, 500); // catch the 2nd <gdb> prompt, if indeed any
-    AResult.State := dsError;
-    if ProcessResultTimedOut then
-      Result := False
-    else
+
+    if ProcessResultTimedOut then begin
+      // still timed out
+      Result := False; // => dsError
+    end
+    else begin
       MessageDlg('Warning', 'A timeout occured, the debugger will try to continue, but further error may occur later',
-                 mtWarning, [mbOK], 0);
+             mtWarning, [mbOK], 0);
+
+      ProcessResult(R, 500); // catch the 2nd <gdb> prompt, if indeed any
+      if ProcessResultTimedOut then
+        AResult.State := dsError;
+    end;
   end;
 
   if not Result
@@ -7998,21 +8006,18 @@ function TGDBMIDebuggerCommand.ProcessResult(var AResult: TGDBMIExecResult;ATime
 
 var
   S: String;
-  t, t2: DWord;
 begin
   Result := False;
   FProcessResultTimedOut := False;
-  if ATimeOut > 0
-  then t := GetTickCount;
   AResult.Values := '';
   AResult.Flags := [];
   AResult.State := dsNone;
   repeat
     S := FTheDebugger.ReadLine(ATimeOut);
-    if S = '' then Continue;
     if S = '(gdb) ' then Break;
 
-    case S[1] of
+    if s <> ''
+    then case S[1] of
       '^': Result := DoResultRecord(S);
       '~': DoConsoleStream(S);
       '@': DoTargetStream(S);
@@ -8029,19 +8034,6 @@ begin
       FProcessResultTimedOut := True;
       break;
     end;
-    if (ATimeOut > 0) then begin
-      t2 := GetTickCount;
-      if t2 < t
-      then t2 := t2 + High(t) - t
-      else t2 := t2 - t;
-      if (t2 >= ATimeOut)
-      then begin
-        FProcessResultTimedOut := True;
-        break;
-      end;
-      ATimeOut := ATimeOut - t2;
-      t := t2;
-    end;
   until not FTheDebugger.DebugProcessRunning;
 end;