paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 12:59:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG:t caseupdat

Browse Source 
git-svn-id: trunk@30703 -
This commit is contained in:
martin 2011-05-12 20:01:11 +00:00
parent ab031a532f
commit bd7bdda224
8 changed files with 193 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
debugger/cmdlinedebugger.pp
View File

@ -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;

20
debugger/debugger.pp
View File

@ -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;
Monitor.CallStackClear(Self);
if CurrentCallStackList <> nil
then CurrentCallStackList.Clear;
if Monitor <> nil
then Monitor.CallStackClear(Self);
end;
end;
end;

22
debugger/gdbmidebugger.pp
View File

@ -1545,12 +1545,15 @@ begin
if Monitor = nil then exit;
Cmd := TGDBMIDebuggerCommandThreads(Sender);
CurrentThreads.Clear;
for i := 0 to Cmd.Count - 1 do
CurrentThreads.Add(Cmd.Threads[i]);
if CurrentThreads <> nil
then begin
CurrentThreads.Clear;
for i := 0 to Cmd.Count - 1 do
CurrentThreads.Add(Cmd.Threads[i]);
CurrentThreads.SetValidity(ddsValid);
CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
CurrentThreads.SetValidity(ddsValid);
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);
ExecuteCommand('-gdb-exit', []);
if (DebugProcess <> nil) and DebugProcess.Running then begin
if State = dsRun then GDBPause(True);
ExecuteCommand('-gdb-exit', []);
end;
inherited Done;
finally
UnlockRelease;

77
debugger/test/Gdbmi/testbase.pas
View File

@ -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;

1
debugger/test/Gdbmi/testbreakpoint.pas
View File

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

59
debugger/test/Gdbmi/testdisass.pas
View File

@ -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);

7
debugger/test/Gdbmi/testexception.pas
View File

@ -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;

103
debugger/test/Gdbmi/testwatches.pas
View File

@ -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
flag := flag and TestTrue (Name+ ' (HasValue)', AWatch.HasValue);
flag := flag and TestFalse (Name+ ' (One Value)', AWatch.HasMultiValue);
s := AWatch.Value;
WV := AWatch.Values[1, 0];// trigger read
flag := flag and TestTrue (Name+ ' (HasValue)', WV.Validity = ddsValid);
//flag := flag and TestFalse (Name+ ' (One Value)', AWatch.HasMultiValue);
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 := TestEquals(Name + ' kind', KindName[Data.Kind], KindName[AWatch.TypeInfo.Kind]);
if flag then flag := TestTrue(Name + ' has typeinfo', WV.TypeInfo <> nil);
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)