DBG:t caseupdat

git-svn-id: trunk@30703 -

debugger/cmdlinedebugger.pp

@@ -307,7 +307,7 @@ end;
 destructor TCmdLineDebugger.Destroy;
 begin
   if (FDbgProcess <> nil) and (FDbgProcess.Running)
-  then FDbgProcess.Terminate(0);
+  then FDbgProcess.Terminate(0); //TODO: set state ?
   
   inherited;
   

debugger/debugger.pp

@@ -2544,7 +2544,7 @@ end;
 
 procedure TWatchesSupplier.DoStateChange(const AOldState: TDBGState);
 begin
-  if FDebugger.State in [dsPause, dsStop, dsInit]
+  if (Debugger.State in [dsPause, dsStop, dsInit]) and (CurrentWatches <> nil)
   then begin
     CurrentWatches.ClearValues;
     Monitor.NotifyUpdate(CurrentWatches, nil);
@@ -2985,7 +2985,8 @@ end;
 procedure TThreadsMonitor.DoNewSupplier;
 begin
   inherited DoNewSupplier;
-  CurrentThreads.SetValidity(ddsUnknown);
+  if CurrentThreads <> nil
+  then CurrentThreads.SetValidity(ddsUnknown);
 end;
 
 procedure TThreadsMonitor.RequestData;
@@ -6272,26 +6273,31 @@ begin
   end;
   It.Free;
 
-  Monitor.NotifyChange;
+  if Monitor <> nil
+  then Monitor.NotifyChange;
 end;
 
 procedure TCallStackSupplier.CurrentChanged;
 begin
-  Monitor.NotifyCurrent;
+  if Monitor <> nil
+  then Monitor.NotifyCurrent;
 end;
 
 procedure TCallStackSupplier.DoStateChange(const AOldState: TDBGState);
 begin
   if FDebugger.State = dsPause
   then begin
-    CurrentCallStackList.Clear;
+    if CurrentCallStackList <> nil
+    then CurrentCallStackList.Clear;
     Changed;
   end
   else begin
     if (AOldState = dsPause) or (AOldState = dsNone) { Force clear on initialisation }
     then begin
-      CurrentCallStackList.Clear;
+      if CurrentCallStackList <> nil
-      Monitor.CallStackClear(Self);
+      then CurrentCallStackList.Clear;
+      if Monitor <> nil
+      then Monitor.CallStackClear(Self);
     end;
   end;
 end;

debugger/gdbmidebugger.pp

@@ -1545,12 +1545,15 @@ begin
   if Monitor = nil then exit;
   Cmd := TGDBMIDebuggerCommandThreads(Sender);
 
-  CurrentThreads.Clear;
+  if CurrentThreads <> nil
-  for i := 0 to Cmd.Count - 1 do
+  then begin
-    CurrentThreads.Add(Cmd.Threads[i]);
+    CurrentThreads.Clear;
+    for i := 0 to Cmd.Count - 1 do
+      CurrentThreads.Add(Cmd.Threads[i]);
 
-  CurrentThreads.SetValidity(ddsValid);
+    CurrentThreads.SetValidity(ddsValid);
-  CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
+    CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
+  end;
 end;
 
 procedure TGDBMIThreads.DoChangeThreadsDestroyed(Sender: TObject);
@@ -1572,7 +1575,8 @@ begin
   end;
 
   Debugger.DoThreadChanged;
-  CurrentThreads.CurrentThreadId := Cmd.NewId;
+  if CurrentThreads <> nil
+  then CurrentThreads.CurrentThreadId := Cmd.NewId;
 end;
 
 function TGDBMIThreads.GetDebugger: TGDBMIDebugger;
@@ -5323,8 +5327,10 @@ begin
   LockRelease;
   try
     CancelAllQueued;
-    if State = dsRun then GDBPause(True);
+    if (DebugProcess <> nil) and DebugProcess.Running then begin
-    ExecuteCommand('-gdb-exit', []);
+      if State = dsRun then GDBPause(True);
+      ExecuteCommand('-gdb-exit', []);
+    end;
     inherited Done;
   finally
     UnlockRelease;

debugger/test/Gdbmi/testbase.pas

@@ -169,6 +169,19 @@ type
   { TGDBTestCase }
 
   TGDBTestCase = class(TTestCase)
+  private
+    // stuff for the debugger
+    FCallStack: TCallStackMonitor;
+    FDisassembler: TIDEDisassembler;
+    FExceptions: TIDEExceptions;
+    FSignals: TIDESignals;
+    //FBreakPoints: TIDEBreakPoints;
+    //FBreakPointGroups: TIDEBreakPointGroups;
+    FLocals: TIDELocals;
+    FLineInfo: TIDELineInfo;
+    FWatches: TWatchesMonitor;
+    FThreads: TThreadsMonitor;
+    FRegisters: TIDERegisters;
   private
     FParent: TGDBTestsuite;
     FTestErrors, FIgnoredErrors, FUnexpectedSuccess: String;
@@ -185,6 +198,7 @@ type
     procedure InternalDbgOutPut(Sender: TObject; const AText: String);
     function GdbClass: TGDBMIDebuggerClass; virtual;
     function StartGDB(AppDir, TestExeName: String): TGDBMIDebugger;
+    procedure CleanGdb;
     procedure ClearTestErrors;
     procedure AddTestError(s: string; MinGdbVers: Integer = 0);
     procedure AddTestSuccess(s: string; MinGdbVers: Integer = 0);
@@ -203,6 +217,18 @@ type
     property DebuggerInfo: TDebuggerInfo read GetDebuggerInfo;
     property SymbolType: TSymbolType read GetSymbolType;
     property CompilerInfo: TCompilerInfo read GetCompilerInfo;
+  public
+    //property BreakPoints: TIDEBreakPoints read FBreakpoints;   // A list of breakpoints for the current project
+    //property BreakPointGroups: TIDEBreakPointGroups read FBreakPointGroups;
+    property Exceptions: TIDEExceptions read FExceptions;      // A list of exceptions we should ignore
+    property CallStack: TCallStackMonitor read FCallStack;
+    property Disassembler: TIDEDisassembler read FDisassembler;
+    property Locals: TIDELocals read FLocals;
+    property LineInfo: TIDELineInfo read FLineInfo;
+    property Registers: TIDERegisters read FRegisters;
+    property Signals: TIDESignals read FSignals;               // A list of actions for signals we know of
+    property Watches: TWatchesMonitor read FWatches;
+    property Threads: TThreadsMonitor read FThreads;
   end;
 
 
@@ -345,7 +371,31 @@ end;
 
 function TGDBTestCase.StartGDB(AppDir, TestExeName: String): TGDBMIDebugger;
 begin
+  //FBreakPoints := TManagedBreakPoints.Create(Self);
+  //FBreakPointGroups := TIDEBreakPointGroups.Create;
+  FWatches := TWatchesMonitor.Create;
+  FThreads := TThreadsMonitor.Create;
+  FExceptions := TIDEExceptions.Create;
+  FSignals := TIDESignals.Create;
+  FLocals := TIDELocals.Create;
+  FLineInfo := TIDELineInfo.Create;
+  FCallStack := TCallStackMonitor.Create;
+  FDisassembler := TIDEDisassembler.Create;
+  FRegisters := TIDERegisters.Create;
+
   Result := GdbClass.Create(DebuggerInfo.ExeName);
+
+  //TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
+  FWatches.Supplier := Result.Watches;
+  FThreads.Supplier := Result.Threads;
+  FLocals.Master := Result.Locals;
+  FLineInfo.Master := Result.LineInfo;
+  FCallStack.Supplier := Result.CallStack;
+  FDisassembler.Master := Result.Disassembler;
+  FExceptions.Master := Result.Exceptions;
+  FSignals.Master := Result.Signals;
+  FRegisters.Master := Result.Registers;
+
   Result.Init;
   if Result.State = dsError then
     Fail(' Failed Init');
@@ -354,6 +404,33 @@ begin
   Result.Arguments := '';
   Result.ShowConsole := True;
   Result.OnDbgOutput  := @InternalDbgOutPut;
+
+end;
+
+procedure TGDBTestCase.CleanGdb;
+begin
+  //TManagedBreakpoints(FBreakpoints).Master := nil;
+  FWatches.Supplier := nil;
+  FThreads.Supplier := nil;
+  FLocals.Master := nil;
+  FLineInfo.Master := nil;
+  FCallStack.Supplier := nil;
+  FDisassembler.Master := nil;
+  FExceptions.Master := nil;
+  FSignals.Master := nil;
+  FRegisters.Master := nil;
+
+  FreeAndNil(FWatches);
+  FreeAndNil(FThreads);
+  //FreeAndNil(FBreakPoints);
+  //FreeAndNil(FBreakPointGroups);
+  FreeAndNil(FCallStack);
+  FreeAndNil(FDisassembler);
+  FreeAndNil(FExceptions);
+  FreeAndNil(FSignals);
+  FreeAndNil(FLocals);
+  FreeAndNil(FLineInfo);
+  FreeAndNil(FRegisters);
 end;
 
 procedure TGDBTestCase.ClearTestErrors;

debugger/test/Gdbmi/testbreakpoint.pas

@@ -117,6 +117,7 @@ begin
     //TestTrue('gone next line 4', i <> FCurLine);
 
   finally
+    CleanGdb;
     dbg.Free;
   end;
   AssertTestErrors;

debugger/test/Gdbmi/testdisass.pas

@@ -41,6 +41,18 @@ type
   { TTestDisAss }
 
   TTestDisAss = class(TTestCase)
+  protected
+    FCallStack: TCallStackMonitor;
+    FDisassembler: TIDEDisassembler;
+    FExceptions: TIDEExceptions;
+    FSignals: TIDESignals;
+    //FBreakPoints: TIDEBreakPoints;
+    //FBreakPointGroups: TIDEBreakPointGroups;
+    FLocals: TIDELocals;
+    FLineInfo: TIDELineInfo;
+    FWatches: TWatchesMonitor;
+    FThreads: TThreadsMonitor;
+    FRegisters: TIDERegisters;
   published
     procedure RangeMap;
     procedure Disassemble;
@@ -323,9 +335,52 @@ var
     Gdb := TTestBrkGDBMIDebugger.Create('');
     IdeDisAss := TIDEDisassembler.Create;
     IdeDisAss.Master := Gdb.Disassembler;
+
+    FWatches := TWatchesMonitor.Create;
+    FThreads := TThreadsMonitor.Create;
+    FExceptions := TIDEExceptions.Create;
+    FSignals := TIDESignals.Create;
+    FLocals := TIDELocals.Create;
+    FLineInfo := TIDELineInfo.Create;
+    FCallStack := TCallStackMonitor.Create;
+    FRegisters := TIDERegisters.Create;
+
+    //TManagedBreakpoints(FBreakpoints).Master := FDebugger.BreakPoints;
+    FWatches.Supplier := Gdb.Watches;
+    FThreads.Supplier := Gdb.Threads;
+    FLocals.Master := Gdb.Locals;
+    FLineInfo.Master := Gdb.LineInfo;
+    FCallStack.Supplier := Gdb.CallStack;
+    FExceptions.Master := Gdb.Exceptions;
+    FSignals.Master := Gdb.Signals;
+    FRegisters.Master := Gdb.Registers;
+
     Gdb.TestSetState(dsPause);
     Gdb.TestIsFailed := False;;
     Gdb.TestFailMemDump := False;
+
+  end;
+  procedure CleanGdb;
+  begin
+    FWatches.Supplier := nil;
+    FThreads.Supplier := nil;
+    //FLocals.Master := nil;
+    //FLineInfo.Master := nil;
+    FCallStack.Supplier := nil;
+    //FExceptions.Master := nil;
+    //FSignals.Master := nil;
+    //FRegisters.Master := nil;
+
+    FreeAndNil(FWatches);
+    FreeAndNil(FThreads);
+    //FreeAndNil(FBreakPoints);
+    //FreeAndNil(FBreakPointGroups);
+    FreeAndNil(FCallStack);
+    FreeAndNil(FDisassembler);
+    FreeAndNil(FExceptions);
+    FreeAndNil(FSignals);
+    FreeAndNil(FLocals);
+    FreeAndNil(FLineInfo);
   end;
 
   procedure Test(Name: String;Addr: TDBGPtr; MinBefore, MinAfter: Integer);
@@ -413,6 +468,7 @@ begin
     end;
     IdeDisAss.PrepareRange($30100, 10, 20);
     Test('no src, multi block, overlap of 4', $30100, 10, 19);
+    CleanGdb;
     {%endregion}
   {%endregion NO SOURCE}
 
@@ -428,6 +484,7 @@ begin
   IdeDisAss.PrepareRange($30100, 10, 20);
   Test('src, 1 block', $30100, 10, 19);
   TestSrc('src, 1 block', $30100-400, $30100+400);
+  CleanGdb;
   {%endregion}
 
   {%region 2 block, part src}
@@ -444,6 +501,7 @@ begin
   IdeDisAss.PrepareRange($30100, 10, 20);
   Test('part-src, 1 block', $30100, 10, 19);
   TestSrc('part-src, 1 block', $30100-8, $30100+400);
+  CleanGdb;
   {%endregion}
 
 
@@ -455,6 +513,7 @@ begin
   Gdb.TestFailMemDump := True;
   IdeDisAss.PrepareRange($10100, 10, 20);
   // just enough, if it din't crash => go error state.
+  CleanGdb;
   {%endregion}
 end;//xxxxxxxxxxxx
   FreeAndNil(IdeDisAss);

debugger/test/Gdbmi/testexception.pas

@@ -73,6 +73,7 @@ begin
     TestEquals(TstName+' Got msg',   'abc', FGotExceptMsg, 050300);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -91,6 +92,7 @@ begin
     TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -109,6 +111,7 @@ begin
     TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -127,6 +130,7 @@ begin
     TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -145,6 +149,7 @@ begin
     TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -163,6 +168,7 @@ begin
     TestEquals(TstName+' Got no more exception', 1, FGotExceptCount);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 
@@ -186,6 +192,7 @@ begin
     TestEquals(TstName+' Got msg',   'abc', FGotExceptMsg, 050300);
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
   end;
 

debugger/test/Gdbmi/testwatches.pas

@@ -25,33 +25,11 @@ const
 *)
 
 type
-
-  { TTestWatch }
-
-  TTestWatch = class(TBaseWatch)
-  private
-    FHasMultiValue: Boolean;
-    FHasValue: Boolean;
-    FMaster: TDBGWatch;
-    FValue: String;
-    FTypeInfo: TDBGType;
-  protected
-    procedure DoChanged; override;
-    function GetTypeInfo: TDBGType; override;
-    procedure SetDisplayFormat(const AValue: TWatchDisplayFormat); override;
-  public
-    constructor Create(AOwner: TBaseWatches; AMaster: TDBGWatch);
-    property Master: TDBGWatch read FMaster;
-    property HasMultiValue: Boolean read FHasMultiValue;
-    property HasValue: Boolean read FHasValue;
-    property Value: String read FValue;
-  end;
-
   { TTestWatches }
 
   TTestWatches = class(TGDBTestCase)
   private
-    FWatches: TBaseWatches;
+    FWatches: TcurrentWatches;
     FDbgOutPut: String;
     FDbgOutPutEnable: Boolean;
     procedure DoDbgOutput(Sender: TObject; const AText: String); override;
@@ -473,50 +451,6 @@ const
 
 
 
-{ TTestWatch }
-
-procedure TTestWatch.DoChanged;
-var
-  v: String;
-begin
-  if FMaster = nil then exit;
-  if (FMaster.Valid = vsValid) then begin
-    DbgLog := True;
-    v := FMaster.Value;
-    if v <> '<evaluating>' then begin // TODO: need better check
-      if FHasValue and (FValue <> v) then begin
-        FHasMultiValue := True;
-        FValue := FValue + LineEnding + v;
-      end
-      else
-        FValue := v;
-      FHasValue := True;
-
-      FTypeInfo := Master.TypeInfo;
-    end;
-  end;
-end;
-
-function TTestWatch.GetTypeInfo: TDBGType;
-begin
-  Result := FTypeInfo;
-end;
-
-procedure TTestWatch.SetDisplayFormat(const AValue: TWatchDisplayFormat);
-begin
-  inherited SetDisplayFormat(AValue);
-  FMaster.DisplayFormat := AValue;
-end;
-
-constructor TTestWatch.Create(AOwner: TBaseWatches; AMaster: TDBGWatch);
-begin
-  inherited Create(AOwner);
-  Expression := AMaster.Expression;
-  FMaster := AMaster;
-  FMaster.Slave := Self;
-  FMaster.Enabled := True;
-end;
-
 { TTestWatches }
 
 procedure TTestWatches.DoDbgOutput(Sender: TObject; const AText: String);
@@ -553,23 +487,24 @@ procedure TTestWatches.TestWatches;
     Result := False;
   end;
 
-  procedure TestWatch(Name: String; AWatch: TTestWatch; Data: TWatchExpectation; WatchValue: String = '');
+  procedure TestWatch(Name: String; AWatch: TCurrentWatch; Data: TWatchExpectation; WatchValue: String = '');
   const KindName: array [TDBGSymbolKind] of string =
      ('skClass', 'skRecord', 'skEnum', 'skSet', 'skProcedure', 'skFunction', 'skSimple', 'skPointer', 'skVariant');
   var
     rx: TRegExpr;
     s: String;
     flag: Boolean;
+    WV: TWatchValue;
   begin
     rx := nil;
 
     Name := Name + ' ' + Data.Exp + ' (' + TWatchDisplayFormatNames[Data.Fmt] + ')';
     flag := AWatch <> nil;
     if flag then begin;
-      AWatch.Master.Value; // trigger read
+      WV := AWatch.Values[1, 0];// trigger read
-      flag := flag and TestTrue  (Name+ ' (HasValue)',   AWatch.HasValue);
+      flag := flag and TestTrue  (Name+ ' (HasValue)',   WV.Validity = ddsValid);
-      flag := flag and TestFalse (Name+ ' (One Value)',  AWatch.HasMultiValue);
+      //flag := flag and TestFalse (Name+ ' (One Value)',  AWatch.HasMultiValue);
-      s := AWatch.Value;
+      s := WV.Value;
     end
     else
       s := WatchValue;
@@ -583,19 +518,19 @@ procedure TTestWatches.TestWatches;
     end;
 
     flag := (AWatch <> nil) and (Data.TpNm <> '');
-    if flag then flag := TestTrue(Name + ' has typeinfo',  AWatch.TypeInfo <> nil);
+    if flag then flag := TestTrue(Name + ' has typeinfo',  WV.TypeInfo <> nil);
-    if flag then flag := TestEquals(Name + ' kind',  KindName[Data.Kind], KindName[AWatch.TypeInfo.Kind]);
+    if flag then flag := TestEquals(Name + ' kind',  KindName[Data.Kind], KindName[WV.TypeInfo.Kind]);
     if flag then begin
       if fTpMtch  in Data.Flgs
       then begin
         FreeAndNil(rx);
-        s := AWatch.TypeInfo.TypeName;
+        s := WV.TypeInfo.TypeName;
         rx := TRegExpr.Create;
         rx.ModifierI := true;
         rx.Expression := Data.TpNm;
-        TestTrue(Name + ' TypeName matches '+Data.TpNm+' but was '+AWatch.TypeInfo.TypeName,  rx.Exec(s))
+        TestTrue(Name + ' TypeName matches '+Data.TpNm+' but was '+WV.TypeInfo.TypeName,  rx.Exec(s))
       end
-      else TestEquals(Name + ' TypeName',  LowerCase(Data.TpNm), LowerCase(AWatch.TypeInfo.TypeName));
+      else TestEquals(Name + ' TypeName',  LowerCase(Data.TpNm), LowerCase(WV.TypeInfo.TypeName));
     end;
     FreeAndNil(rx);
   end;
@@ -604,7 +539,7 @@ var
   TestExeName: string;
   dbg: TGDBMIDebugger;
   i: Integer;
-  WList: Array of TTestWatch;
+  WList: Array of TCurrentWatch;
 begin
   if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestWatch')] then exit;
 
@@ -616,8 +551,8 @@ begin
   end;
 
   try
-    FWatches := TBaseWatches.Create(TBaseWatch);
     dbg := StartGDB(AppDir, TestExeName);
+    FWatches := Watches.CurrentWatches;
 
     if (RUN_TEST_ONLY >= 0) or (RUN_GDB_TEST_ONLY >= 0) then begin
       DbgLog := False;
@@ -647,14 +582,18 @@ begin
     SetLength(WList, high(ExpectBrk1NoneNil)+1);
     if RUN_TEST_ONLY >= 0 then begin
       i := RUN_TEST_ONLY;
-      WList[i] := TTestWatch.Create(FWatches, dbg.Watches.Add(ExpectBrk1NoneNil[i].Exp));
+      WList[i] := TCurrentWatch.Create(FWatches);
+      WList[i].Expression := ExpectBrk1NoneNil[i].Exp;
       WList[i].DisplayFormat := ExpectBrk1NoneNil[i].Fmt;
+      WList[i].enabled := True;
     end
     else
       for i := low(ExpectBrk1NoneNil) to high(ExpectBrk1NoneNil) do begin
         if not SkipTest(ExpectBrk1NoneNil[i]) then begin
-          WList[i] := TTestWatch.Create(FWatches, dbg.Watches.Add(ExpectBrk1NoneNil[i].Exp));
+          WList[i] := TCurrentWatch.Create(FWatches);
+          WList[i].Expression := ExpectBrk1NoneNil[i].Exp;
           WList[i].DisplayFormat := ExpectBrk1NoneNil[i].Fmt;
+          WList[i].enabled := True;
         end;
       end;
 
@@ -705,8 +644,8 @@ begin
 
     dbg.Stop;
   finally
+    CleanGdb;
     dbg.Free;
-    FreeAndNil(FWatches);
 
     if (DbgMemo <> nil) and (TestErrors <> '') then DbgMemo.Lines.Add(TestErrors);
     //debugln(FailText)