mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-07 19:37:37 +01:00
DBG: More tests
git-svn-id: trunk@28653 -
This commit is contained in:
martin
parent
2fd897d60d
commit
b85a048745
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -2553,10 +2553,13 @@ debugger/registersdlg.lfm svneol=native#text/pascal
|
||||
debugger/registersdlg.pp svneol=native#text/pascal
|
||||
debugger/sshgdbmidebugger.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/TestApps/ExceptPrg.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/TestApps/WatchesPrg.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/TestGdbmi.lpi svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/TestGdbmi.lpr svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/compilehelpers.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/testbase.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/testexception.pas svneol=native#text/pascal
|
||||
debugger/test/Gdbmi/testwatches.pas svneol=native#text/pascal
|
||||
debugger/test/debugtest.lpi svneol=native#text/plain
|
||||
debugger/test/debugtest.pp svneol=native#text/pascal
|
||||
debugger/test/debugtestform.lrs svneol=native#text/pascal
|
||||
|
||||
30
debugger/test/Gdbmi/TestApps/WatchesPrg.pas
Normal file
30
debugger/test/Gdbmi/TestApps/WatchesPrg.pas
Normal file
@ -0,0 +1,30 @@
|
||||
program WatchesPrg;
|
||||
{$H-}
|
||||
|
||||
uses sysutils;
|
||||
|
||||
procedure Foo;
|
||||
var
|
||||
TestInt: Integer;
|
||||
TesTShortString: String[10];
|
||||
TestAnsiString: AnsiString;
|
||||
TestPChar: PChar;
|
||||
|
||||
function SubFoo(var AVal1: Integer; AVal2: Integer) : Integer;
|
||||
begin
|
||||
AVal1 := 2 * AVal2;
|
||||
inc(AVal2);
|
||||
end;
|
||||
|
||||
begin
|
||||
TestInt := 3;
|
||||
TesTShortString := IntToStr(TestInt);
|
||||
TestAnsiString := TesTShortString + ' Foo';
|
||||
TestPChar := @TestAnsiString[2];
|
||||
SubFoo(TestInt, 5);
|
||||
writeln(TestPChar);
|
||||
end;
|
||||
|
||||
begin
|
||||
Foo
|
||||
end.
|
||||
@ -42,35 +42,386 @@
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Units Count="27">
|
||||
<Unit0>
|
||||
<Filename Value="TestGdbmi.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestGdbmi"/>
|
||||
<UsageCount Value="26"/>
|
||||
<UsageCount Value="57"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="testexception.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestException"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="59"/>
|
||||
<CursorPos X="27" Y="102"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="17"/>
|
||||
<CursorPos X="46" Y="58"/>
|
||||
<ExtraEditorCount Value="1"/>
|
||||
<ExtraEditor1>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="136"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="17"/>
|
||||
<CursorPos X="1" Y="56"/>
|
||||
</ExtraEditor1>
|
||||
<UsageCount Value="26"/>
|
||||
<UsageCount Value="57"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="compilehelpers.pas"/>
|
||||
<UnitName Value="CompileHelpers"/>
|
||||
<EditorIndex Value="7"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="29"/>
|
||||
<CursorPos X="1" Y="79"/>
|
||||
<UsageCount Value="25"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\objpas\classes\classesh.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="599"/>
|
||||
<CursorPos X="14" Y="634"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\objpas\classes\stringl.inc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1160"/>
|
||||
<CursorPos X="3" Y="1170"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="testbase.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestBase"/>
|
||||
<EditorIndex Value="6"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="595"/>
|
||||
<CursorPos X="1" Y="653"/>
|
||||
<ExtraEditorCount Value="1"/>
|
||||
<ExtraEditor1>
|
||||
<EditorIndex Value="5"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="102"/>
|
||||
<CursorPos X="69" Y="129"/>
|
||||
<IsLocked Value="True"/>
|
||||
</ExtraEditor1>
|
||||
<UsageCount Value="51"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<UnitName Value="GDBMIDebugger"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="6589"/>
|
||||
<CursorPos X="7" Y="6631"/>
|
||||
<UsageCount Value="25"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="..\..\..\lcl\lclproc.pas"/>
|
||||
<UnitName Value="LCLProc"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="3152"/>
|
||||
<CursorPos X="3" Y="3159"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="A:\debugger\test\Gdbmi\gdblist.txt"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="5" Y="1"/>
|
||||
<UsageCount Value="25"/>
|
||||
<Loaded Value="True"/>
|
||||
<DefaultSyntaxHighlighter Value="None"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="A:\debugger\test\Gdbmi\fpclist.txt"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="14" Y="3"/>
|
||||
<UsageCount Value="25"/>
|
||||
<Loaded Value="True"/>
|
||||
<DefaultSyntaxHighlighter Value="None"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="A:\debugger\test\Gdbmi\gdblist - Copy.txt"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="1" Y="2"/>
|
||||
<UsageCount Value="7"/>
|
||||
<DefaultSyntaxHighlighter Value="None"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="..\..\..\test\testlpi.pas"/>
|
||||
<UnitName Value="TestLpi"/>
|
||||
<EditorIndex Value="8"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="71"/>
|
||||
<CursorPos X="20" Y="129"/>
|
||||
<UsageCount Value="24"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="C:\FPC\SVN\trunc\packages\fcl-fpcunit\src\fpcunit.pp"/>
|
||||
<UnitName Value="fpcunit"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="992"/>
|
||||
<CursorPos X="1" Y="1026"/>
|
||||
<UsageCount Value="22"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="A:\debugger\test\Gdbmi\TestApps\ExceptPrg.pas"/>
|
||||
<UnitName Value="ExceptPrg"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="5" Y="21"/>
|
||||
<UsageCount Value="21"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="C:\FPC\SVN\trunc\packages\fcl-fpcunit\src\testregistry.pp"/>
|
||||
<UnitName Value="testregistry"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="86"/>
|
||||
<CursorPos X="24" Y="117"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Bookmarks Count="1">
|
||||
<Item0 X="1" Y="30" ID="1"/>
|
||||
</Bookmarks>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="..\..\..\components\fpcunit\guitestrunner.pas"/>
|
||||
<UnitName Value="GuiTestRunner"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="668"/>
|
||||
<CursorPos X="1" Y="712"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\win32\system.pp"/>
|
||||
<UnitName Value="System"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="2"/>
|
||||
<CursorPos X="2" Y="37"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="..\..\..\lcl\fileutil.pas"/>
|
||||
<UnitName Value="FileUtil"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="75"/>
|
||||
<CursorPos X="10" Y="110"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="..\..\..\lcl\include\fileutil.inc"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1441"/>
|
||||
<CursorPos X="3" Y="1443"/>
|
||||
<UsageCount Value="11"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="..\..\..\lcl\include\winfileutil.inc"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="3" Y="14"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\objpas\sysutils\finah.inc"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="10" Y="26"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Testwatches"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="42"/>
|
||||
<CursorPos X="1" Y="88"/>
|
||||
<UsageCount Value="24"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="TestApps\WatchesPrg.pas"/>
|
||||
<UnitName Value="WatchesPrg"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<WindowIndex Value="0"/>
|
||||
<TopLine Value="1"/>
|
||||
<CursorPos X="23" Y="15"/>
|
||||
<UsageCount Value="12"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="..\..\debugger.pp"/>
|
||||
<UnitName Value="Debugger"/>
|
||||
<EditorIndex Value="3"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="3403"/>
|
||||
<CursorPos X="19" Y="3437"/>
|
||||
<UsageCount Value="11"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="..\..\debugutils.pp"/>
|
||||
<UnitName Value="DebugUtils"/>
|
||||
<EditorIndex Value="5"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="274"/>
|
||||
<CursorPos X="3" Y="302"/>
|
||||
<UsageCount Value="11"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\inc\generic.inc"/>
|
||||
<EditorIndex Value="4"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="789"/>
|
||||
<CursorPos X="1" Y="827"/>
|
||||
<UsageCount Value="11"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="C:\FPC\SVN\trunc\rtl\i386\i386.inc"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<WindowIndex Value="1"/>
|
||||
<TopLine Value="1558"/>
|
||||
<CursorPos X="1" Y="1603"/>
|
||||
<UsageCount Value="11"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit26>
|
||||
</Units>
|
||||
<JumpHistory Count="0" HistoryIndex="-1"/>
|
||||
<JumpHistory Count="30" HistoryIndex="29">
|
||||
<Position1>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6603" Column="1" TopLine="6594"/>
|
||||
</Position1>
|
||||
<Position2>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6604" Column="1" TopLine="6594"/>
|
||||
</Position2>
|
||||
<Position3>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6605" Column="1" TopLine="6594"/>
|
||||
</Position3>
|
||||
<Position4>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6610" Column="5" TopLine="6594"/>
|
||||
</Position4>
|
||||
<Position5>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6608" Column="1" TopLine="6594"/>
|
||||
</Position5>
|
||||
<Position6>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6610" Column="1" TopLine="6594"/>
|
||||
</Position6>
|
||||
<Position7>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="7863" Column="1" TopLine="7828"/>
|
||||
</Position7>
|
||||
<Position8>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="8535" Column="1" TopLine="8500"/>
|
||||
</Position8>
|
||||
<Position9>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="8536" Column="1" TopLine="8500"/>
|
||||
</Position9>
|
||||
<Position10>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="8537" Column="1" TopLine="8500"/>
|
||||
</Position10>
|
||||
<Position11>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4751" Column="1" TopLine="4716"/>
|
||||
</Position11>
|
||||
<Position12>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4752" Column="1" TopLine="4716"/>
|
||||
</Position12>
|
||||
<Position13>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4754" Column="1" TopLine="4716"/>
|
||||
</Position13>
|
||||
<Position14>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4757" Column="1" TopLine="4716"/>
|
||||
</Position14>
|
||||
<Position15>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4761" Column="1" TopLine="4716"/>
|
||||
</Position15>
|
||||
<Position16>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4767" Column="1" TopLine="4716"/>
|
||||
</Position16>
|
||||
<Position17>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="4816" Column="1" TopLine="4781"/>
|
||||
</Position17>
|
||||
<Position18>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6636" Column="1" TopLine="6601"/>
|
||||
</Position18>
|
||||
<Position19>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6641" Column="1" TopLine="6601"/>
|
||||
</Position19>
|
||||
<Position20>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6692" Column="1" TopLine="6657"/>
|
||||
</Position20>
|
||||
<Position21>
|
||||
<Filename Value="..\..\debugger.pp"/>
|
||||
<Caret Line="3437" Column="19" TopLine="3403"/>
|
||||
</Position21>
|
||||
<Position22>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6626" Column="1" TopLine="6606"/>
|
||||
</Position22>
|
||||
<Position23>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="66" Column="36" TopLine="39"/>
|
||||
</Position23>
|
||||
<Position24>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="49" Column="1" TopLine="39"/>
|
||||
</Position24>
|
||||
<Position25>
|
||||
<Filename Value="..\..\gdbmidebugger.pp"/>
|
||||
<Caret Line="6626" Column="59" TopLine="6573"/>
|
||||
</Position25>
|
||||
<Position26>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="96" Column="18" TopLine="42"/>
|
||||
</Position26>
|
||||
<Position27>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="85" Column="14" TopLine="42"/>
|
||||
</Position27>
|
||||
<Position28>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="97" Column="1" TopLine="42"/>
|
||||
</Position28>
|
||||
<Position29>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="98" Column="1" TopLine="42"/>
|
||||
</Position29>
|
||||
<Position30>
|
||||
<Filename Value="testwatches.pas"/>
|
||||
<Caret Line="81" Column="9" TopLine="42"/>
|
||||
</Position30>
|
||||
</JumpHistory>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="9"/>
|
||||
@ -90,7 +441,18 @@
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<BreakPoints Count="1">
|
||||
<Item1>
|
||||
<Source Value="testexception.pas"/>
|
||||
<Line Value="51"/>
|
||||
</Item1>
|
||||
</BreakPoints>
|
||||
<Watches Count="1">
|
||||
<Item1>
|
||||
<Expression Value="FTestIntWatch"/>
|
||||
</Item1>
|
||||
</Watches>
|
||||
<Exceptions Count="4">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
@ -100,6 +462,9 @@
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Name Value="EAssertionFailedError"/>
|
||||
</Item4>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
|
||||
@ -3,7 +3,7 @@ program TestGdbmi;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, Forms, GuiTestRunner, TestException, CompileHelpers;
|
||||
Interfaces, Forms, GuiTestRunner, TestException, CompileHelpers, TestBase, Testwatches;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@ -5,14 +5,10 @@ unit CompileHelpers;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, process, UTF8Process, EnvironmentOpts;
|
||||
Classes, SysUtils, process, UTF8Process, LCLProc;
|
||||
|
||||
function TestCompile(const PrgName, FpcOpts, ExeName, FpcExe: string): String;
|
||||
|
||||
function GetCompilers: TStringList;
|
||||
function GetDebuggers: TStringList;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function ReadOutput(AProcess:TProcess): TStringList;
|
||||
@ -99,37 +95,5 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetCompilers: TStringList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TStringList.Create;
|
||||
if FileExists(AppDir + 'fpclist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'fpclist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.CompilerFilename <> '') then
|
||||
Result.Add(EnvironmentOptions.CompilerFilename);
|
||||
end;
|
||||
|
||||
function GetDebuggers: TStringList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TStringList.Create;
|
||||
if FileExists(AppDir + 'gdblist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'gdblist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.DebuggerFilename <> '') then
|
||||
Result.Add(EnvironmentOptions.DebuggerFilename);
|
||||
end;
|
||||
|
||||
initialization
|
||||
EnvironmentOptions := TEnvironmentOptions.Create;
|
||||
with EnvironmentOptions do
|
||||
begin
|
||||
SetLazarusDefaultFilename;
|
||||
Load(false);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
666
debugger/test/Gdbmi/testbase.pas
Normal file
666
debugger/test/Gdbmi/testbase.pas
Normal file
@ -0,0 +1,666 @@
|
||||
unit TestBase;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, fpcunit, testutils, testregistry,
|
||||
EnvironmentOpts, LCLProc, CompileHelpers;
|
||||
|
||||
(*
|
||||
fpclist.txt contains lines of format:
|
||||
[Name]
|
||||
exe=/path/fpc.exe
|
||||
symbols=gs,gw,gw3
|
||||
|
||||
|
||||
gdblist.txt contains lines of format:
|
||||
[Name]
|
||||
exe=/path/fpc.exe
|
||||
symbols=gs,gw,gw3
|
||||
|
||||
*)
|
||||
|
||||
type
|
||||
TSymbolType = (stStabs, stDwarf, stDwarf3);
|
||||
TSymbolTypes = set of TSymbolType;
|
||||
|
||||
const
|
||||
SymbolTypeNames: Array [TSymbolType] of String = ('Stabs', 'Dwarf', 'Dwarf3');
|
||||
SymbolTypeSwitches: Array [TSymbolType] of String = ('-gs', '-gw', '-gw3');
|
||||
|
||||
type
|
||||
|
||||
TCompilerInfo = record
|
||||
Name: string;
|
||||
ExeName: string;
|
||||
SymbolTypes: TSymbolTypes;
|
||||
end;
|
||||
|
||||
TDebuggerInfo = record
|
||||
Name: string;
|
||||
ExeName: string;
|
||||
SymbolTypes: TSymbolTypes;
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
TBaseList = class
|
||||
protected
|
||||
function AddName(const AName: string): Integer; virtual; abstract;
|
||||
procedure SetAttribute(AIndex: Integer; const AAttr, AValue: string); virtual; abstract;
|
||||
public
|
||||
procedure LoadFromFile(const AFileName: string);
|
||||
end;
|
||||
|
||||
{ TCompilerList }
|
||||
|
||||
TCompilerList = class(TBaseList)
|
||||
private
|
||||
FList: array of TCompilerInfo;
|
||||
function GetCompilerInfo(Index: Integer): TCompilerInfo;
|
||||
function GetExeName(Index: Integer): string;
|
||||
function GetName(Index: Integer): string;
|
||||
function GetSymbolTypes(Index: Integer): TSymbolTypes;
|
||||
protected
|
||||
function AddName(const AName: string): Integer; override;
|
||||
procedure SetAttribute(AIndex: Integer; const AAttr, AValue: string); override;
|
||||
public
|
||||
procedure Add(Name, Exe: string);
|
||||
function Count: Integer;
|
||||
property CompilerInfo[Index: Integer]: TCompilerInfo read GetCompilerInfo;
|
||||
property Name[Index: Integer]: string read GetName;
|
||||
property ExeName[Index: Integer]: string read GetExeName;
|
||||
property SymbolTypes[Index: Integer]: TSymbolTypes read GetSymbolTypes;
|
||||
end;
|
||||
|
||||
{ TDebuggerList }
|
||||
|
||||
TDebuggerList = class(TBaseList)
|
||||
private
|
||||
FList: array of TDebuggerInfo;
|
||||
function GetDebuggerInfo(Index: Integer): TDebuggerInfo;
|
||||
function GetExeName(Index: Integer): string;
|
||||
function GetName(Index: Integer): string;
|
||||
function GetSymbolTypes(Index: Integer): TSymbolTypes;
|
||||
protected
|
||||
function AddName(const AName: string): Integer; override;
|
||||
procedure SetAttribute(AIndex: Integer; const AAttr, AValue: string); override;
|
||||
public
|
||||
procedure Add(Name, Exe: string);
|
||||
function Count: Integer;
|
||||
property DebuggerInfo[Index: Integer]: TDebuggerInfo read GetDebuggerInfo;
|
||||
property Name[Index: Integer]: string read GetName;
|
||||
property ExeName[Index: Integer]: string read GetExeName;
|
||||
property SymbolTypes[Index: Integer]: TSymbolTypes read GetSymbolTypes;
|
||||
end;
|
||||
|
||||
|
||||
{ TCompilerSuite }
|
||||
|
||||
TCompilerSuite = class(TTestSuite)
|
||||
private
|
||||
FCompilerInfo: TCompilerInfo;
|
||||
public
|
||||
constructor Create(ACompilerInfo: TCompilerInfo; ADebuggerList: TDebuggerList);
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
public
|
||||
property CompilerInfo: TCompilerInfo read FCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TCompilerOptionsSuite }
|
||||
|
||||
TCompilerOptionsSuite = class(TTestSuite)
|
||||
private
|
||||
FParent: TCompilerSuite;
|
||||
FSymbolSwitch: String;
|
||||
FSymbolType: TSymbolType;
|
||||
FFileNameExt: String;
|
||||
FCompiledList: TStringList;
|
||||
FInRun: Boolean;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
protected
|
||||
procedure Clear;
|
||||
public
|
||||
constructor Create(AParent: TCompilerSuite; ASymbolType: TSymbolType; ADebuggerList: TDebuggerList);
|
||||
destructor Destroy; override;
|
||||
procedure Run(AResult: TTestResult); override;
|
||||
procedure RunTest(ATest: TTest; AResult: TTestResult); override;
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TCompilerSuite read FParent;
|
||||
property SymbolType: TSymbolType read FSymbolType;
|
||||
property SymbolSwitch: String read FSymbolSwitch;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TDebuggerSuite }
|
||||
|
||||
TDebuggerSuite = class(TTestSuite)
|
||||
private
|
||||
FDebuggerInfo: TDebuggerInfo;
|
||||
FParent: TCompilerOptionsSuite;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
function GetSymbolType: TSymbolType;
|
||||
public
|
||||
constructor Create(AParent: TCompilerOptionsSuite; ADebuggerInfo: TDebuggerInfo);
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TCompilerOptionsSuite read FParent;
|
||||
property DebuggerInfo: TDebuggerInfo read FDebuggerInfo;
|
||||
property SymbolType: TSymbolType read GetSymbolType;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TGDBTestsuite }
|
||||
|
||||
TGDBTestsuite = class(TTestSuite)
|
||||
private
|
||||
FParent: TDebuggerSuite;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
function GetDebuggerInfo: TDebuggerInfo;
|
||||
function GetSymbolType: TSymbolType;
|
||||
public
|
||||
constructor Create(AParent: TDebuggerSuite; AClass: TClass);
|
||||
procedure AddTest(ATest: TTest); overload; override;
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TDebuggerSuite read FParent;
|
||||
property DebuggerInfo: TDebuggerInfo read GetDebuggerInfo;
|
||||
property SymbolType: TSymbolType read GetSymbolType;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TGDBTestCase }
|
||||
|
||||
TGDBTestCase = class(TTestCase)
|
||||
private
|
||||
FParent: TGDBTestsuite;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
function GetDebuggerInfo: TDebuggerInfo;
|
||||
function GetSymbolType: TSymbolType;
|
||||
public
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TGDBTestsuite read FParent write FParent;
|
||||
property DebuggerInfo: TDebuggerInfo read GetDebuggerInfo;
|
||||
property SymbolType: TSymbolType read GetSymbolType;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
end;
|
||||
|
||||
|
||||
function GetCompilers: TCompilerList;
|
||||
function GetDebuggers: TDebuggerList;
|
||||
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
|
||||
var
|
||||
AppDir: String;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
Compilers: TCompilerList = nil;
|
||||
Debuggers: TDebuggerList = nil;
|
||||
|
||||
function StrToSymbolTypes(s: string): TSymbolTypes;
|
||||
var
|
||||
s2: string;
|
||||
begin
|
||||
Result := [];
|
||||
while (s <> '') do begin
|
||||
while (s <> '') and (s[1] in [' ', ',', #9, #10, #13]) do delete(s,1, 1);
|
||||
s2 := '';
|
||||
while (s <> '') and not (s[1] in [' ', ',', #9, #10, #13]) do begin
|
||||
s2 := s2 + s[1];
|
||||
delete(s,1, 1);
|
||||
end;
|
||||
if s2 = 'gs' then Result := Result + [stStabs];
|
||||
if s2 = 'gw' then Result := Result + [stDwarf];
|
||||
if s2 = 'gw3' then Result := Result + [stDwarf3];
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function GetCompilers: TCompilerList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
if Compilers <> nil then exit(Compilers);
|
||||
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TCompilerList.Create;
|
||||
if FileExists(AppDir + 'fpclist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'fpclist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.CompilerFilename <> '') then
|
||||
Result.Add('fpc from conf', EnvironmentOptions.CompilerFilename);
|
||||
Compilers := Result;
|
||||
end;
|
||||
|
||||
function GetDebuggers: TDebuggerList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
if Debuggers <> nil then exit(Debuggers);
|
||||
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TDebuggerList.Create;
|
||||
if FileExists(AppDir + 'gdblist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'gdblist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.DebuggerFilename <> '') then
|
||||
Result.Add('gdb from conf', EnvironmentOptions.DebuggerFilename);
|
||||
Debuggers := Result;
|
||||
end;
|
||||
|
||||
{ TGDBTestCase }
|
||||
|
||||
function TGDBTestCase.GetCompilerInfo: TCompilerInfo;
|
||||
begin
|
||||
Result := Parent.CompilerInfo;
|
||||
end;
|
||||
|
||||
function TGDBTestCase.GetDebuggerInfo: TDebuggerInfo;
|
||||
begin
|
||||
Result := Parent.DebuggerInfo;
|
||||
end;
|
||||
|
||||
function TGDBTestCase.GetSymbolType: TSymbolType;
|
||||
begin
|
||||
Result := Parent.SymbolType;
|
||||
end;
|
||||
|
||||
procedure TGDBTestCase.TestCompile(const PrgName: string; out ExeName: string);
|
||||
begin
|
||||
Parent.TestCompile(PrgName, ExeName);
|
||||
end;
|
||||
|
||||
{ TBaseList }
|
||||
|
||||
procedure TBaseList.LoadFromFile(const AFileName: string);
|
||||
var
|
||||
txt: TStringList;
|
||||
s: string;
|
||||
i, j, k: Integer;
|
||||
begin
|
||||
txt := TStringList.Create;
|
||||
txt.LoadFromFile(AFileName);
|
||||
j := -1;
|
||||
for i := 0 to txt.Count - 1 do begin
|
||||
s := txt[i];
|
||||
if Trim(s) = '' then continue;
|
||||
if copy(s, 1, 1) = '[' then begin
|
||||
j := AddName(GetPart(['['], [']'], s));
|
||||
continue;
|
||||
end;
|
||||
if j < 0 then continue;
|
||||
k := pos('=', s);
|
||||
SetAttribute(j, copy(s, 1, k-1), copy(s, k + 1, length(s)));
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TCompilerList }
|
||||
|
||||
function TCompilerList.GetExeName(Index: Integer): string;
|
||||
begin
|
||||
Result := FList[Index].ExeName;
|
||||
end;
|
||||
|
||||
function TCompilerList.GetCompilerInfo(Index: Integer): TCompilerInfo;
|
||||
begin
|
||||
Result := FList[Index];
|
||||
end;
|
||||
|
||||
function TCompilerList.GetName(Index: Integer): string;
|
||||
begin
|
||||
Result := FList[Index].Name;
|
||||
end;
|
||||
|
||||
function TCompilerList.GetSymbolTypes(Index: Integer): TSymbolTypes;
|
||||
begin
|
||||
Result := FList[Index].SymbolTypes;
|
||||
end;
|
||||
|
||||
function TCompilerList.AddName(const AName: string): Integer;
|
||||
begin
|
||||
Result := length(FList);
|
||||
SetLength(FList, Result + 1);
|
||||
FList[Result].Name := AName;
|
||||
FList[Result].SymbolTypes := [];
|
||||
end;
|
||||
|
||||
procedure TCompilerList.SetAttribute(AIndex: Integer; const AAttr, AValue: string);
|
||||
begin
|
||||
case StringCase(AAttr, ['exe', 'symbols'], True, False) of
|
||||
0: begin // exe
|
||||
FList[AIndex].ExeName := AValue;
|
||||
end;
|
||||
1: begin // symbols
|
||||
FList[AIndex].SymbolTypes := StrToSymbolTypes(AValue);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerList.Add(Name, Exe: string);
|
||||
var
|
||||
i: LongInt;
|
||||
begin
|
||||
i := AddName(Name);
|
||||
FList[i].ExeName := Exe;
|
||||
FList[i].SymbolTypes := [stStabs, stDwarf];
|
||||
end;
|
||||
|
||||
function TCompilerList.Count: Integer;
|
||||
begin
|
||||
Result := length(FList);
|
||||
end;
|
||||
|
||||
{ TDebuggerList }
|
||||
|
||||
function TDebuggerList.GetExeName(Index: Integer): string;
|
||||
begin
|
||||
Result := FList[Index].ExeName;
|
||||
end;
|
||||
|
||||
function TDebuggerList.GetDebuggerInfo(Index: Integer): TDebuggerInfo;
|
||||
begin
|
||||
Result := FList[Index];
|
||||
end;
|
||||
|
||||
function TDebuggerList.GetName(Index: Integer): string;
|
||||
begin
|
||||
Result := FList[Index].Name;
|
||||
end;
|
||||
|
||||
function TDebuggerList.GetSymbolTypes(Index: Integer): TSymbolTypes;
|
||||
begin
|
||||
Result := FList[Index].SymbolTypes;
|
||||
end;
|
||||
|
||||
function TDebuggerList.AddName(const AName: string): Integer;
|
||||
begin
|
||||
Result := length(FList);
|
||||
SetLength(FList, Result + 1);
|
||||
FList[Result].Name := AName;
|
||||
FList[Result].SymbolTypes := [];
|
||||
end;
|
||||
|
||||
procedure TDebuggerList.SetAttribute(AIndex: Integer; const AAttr, AValue: string);
|
||||
begin
|
||||
case StringCase(AAttr, ['exe', 'symbols'], True, False) of
|
||||
0: begin // exe
|
||||
FList[AIndex].ExeName := AValue;
|
||||
end;
|
||||
1: begin // symbols
|
||||
FList[AIndex].SymbolTypes := StrToSymbolTypes(AValue);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebuggerList.Add(Name, Exe: string);
|
||||
var
|
||||
i: LongInt;
|
||||
begin
|
||||
i := AddName(Name);
|
||||
FList[i].ExeName := Exe;
|
||||
FList[i].SymbolTypes := [stStabs, stDwarf];
|
||||
end;
|
||||
|
||||
function TDebuggerList.Count: Integer;
|
||||
begin
|
||||
Result := length(FList);
|
||||
end;
|
||||
|
||||
{ TCompilerSuite }
|
||||
|
||||
constructor TCompilerSuite.Create(ACompilerInfo: TCompilerInfo; ADebuggerList: TDebuggerList);
|
||||
var
|
||||
st: TSymbolType;
|
||||
SubSuite: TCompilerOptionsSuite;
|
||||
begin
|
||||
inherited Create(ACompilerInfo.Name);
|
||||
FCompilerInfo := ACompilerInfo;
|
||||
|
||||
for st := low(TSymbolType) to high(TSymbolType) do begin
|
||||
if not (st in FCompilerInfo.SymbolTypes) then
|
||||
continue;
|
||||
|
||||
SubSuite := TCompilerOptionsSuite.Create(Self, st, ADebuggerList);
|
||||
Self.AddTest(SubSuite);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Tests.Count - 1 do
|
||||
if Test[i] is TCompilerOptionsSuite then
|
||||
TCompilerOptionsSuite(Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
{ TCompilerOptionsSuite }
|
||||
|
||||
function TCompilerOptionsSuite.GetCompilerInfo: TCompilerInfo;
|
||||
begin
|
||||
Result := Parent.CompilerInfo;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.Clear;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to FCompiledList.Count - 1 do
|
||||
DeleteFile(FCompiledList[i]);
|
||||
FCompiledList.Clear;
|
||||
end;
|
||||
|
||||
constructor TCompilerOptionsSuite.Create(AParent: TCompilerSuite; ASymbolType: TSymbolType;
|
||||
ADebuggerList: TDebuggerList);
|
||||
var
|
||||
i: Integer;
|
||||
SubSuite: TDebuggerSuite;
|
||||
begin
|
||||
inherited Create(SymbolTypeNames[ASymbolType]);
|
||||
FParent := AParent;
|
||||
FSymbolType := ASymbolType;
|
||||
|
||||
FCompiledList := TStringList.Create;
|
||||
FSymbolSwitch := SymbolTypeSwitches[FSymbolType];
|
||||
FInRun := False;
|
||||
|
||||
FFileNameExt := SymbolTypeNames[FSymbolType] + '_';
|
||||
for i := 1 to length(CompilerInfo.Name) do begin
|
||||
if CompilerInfo.Name[i] in ['a'..'z', 'A'..'Z', '0'..'9', '.', '-'] then
|
||||
FFileNameExt := FFileNameExt + CompilerInfo.Name[i]
|
||||
else if CompilerInfo.Name[i] = ' ' then
|
||||
FFileNameExt := FFileNameExt + '__'
|
||||
else
|
||||
FFileNameExt := FFileNameExt + '_' + IntToHex(ord(CompilerInfo.Name[i]), 2);
|
||||
end;
|
||||
|
||||
for i := 0 to ADebuggerList.Count - 1 do begin
|
||||
if not (FSymbolType in ADebuggerList.SymbolTypes[i]) then
|
||||
continue;
|
||||
SubSuite := TDebuggerSuite.Create(Self, ADebuggerList.DebuggerInfo[i]);
|
||||
Self.AddTest(SubSuite);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCompilerOptionsSuite.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
Clear;
|
||||
FreeAndNil(FCompiledList);
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.Run(AResult: TTestResult);
|
||||
begin
|
||||
FInRun := True;
|
||||
try
|
||||
inherited Run(AResult);
|
||||
finally
|
||||
FInRun := False;
|
||||
Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.RunTest(ATest: TTest; AResult: TTestResult);
|
||||
begin
|
||||
try
|
||||
inherited RunTest(ATest, AResult);
|
||||
finally
|
||||
if not FInRun then Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Tests.Count - 1 do
|
||||
if Test[i] is TDebuggerSuite then
|
||||
TDebuggerSuite(Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.TestCompile(const PrgName: string; out ExeName: string);
|
||||
var
|
||||
ExePath, ErrMsg: String;
|
||||
begin
|
||||
ExePath := ExtractFileNameWithoutExt(PrgName);
|
||||
ExeName := ExtractFileNameOnly(ExePath);
|
||||
ExePath := AppendPathDelim(copy(ExePath, 1, length(ExePath) - length(ExeName)));
|
||||
if DirectoryExistsUTF8(ExePath + 'lib') then
|
||||
ExePath := AppendPathDelim(ExePath + 'lib');
|
||||
ExeName := ExePath + ExeName + FFileNameExt + GetExeExt;
|
||||
|
||||
if FCompiledList.IndexOf(ExeName) < 0 then begin
|
||||
if FileExists(ExeName) then
|
||||
raise EAssertionFailedError.Create('Found existing file before compiling: ' + ExeName);
|
||||
FCompiledList.Add(ExeName);
|
||||
ErrMsg := CompileHelpers.TestCompile(PrgName, FSymbolSwitch, ExeName, CompilerInfo.ExeName);
|
||||
if ErrMsg <> '' then
|
||||
raise EAssertionFailedError.Create('Compilation Failed: ' + ExeName + LineEnding + ErrMsg);
|
||||
end;
|
||||
|
||||
if not FileExists(ExeName) then
|
||||
raise EAssertionFailedError.Create('Missing compiled exe ' + ExeName);
|
||||
end;
|
||||
|
||||
{ TDebuggerSuite }
|
||||
|
||||
function TDebuggerSuite.GetCompilerInfo: TCompilerInfo;
|
||||
begin
|
||||
Result := Parent.CompilerInfo;
|
||||
end;
|
||||
|
||||
function TDebuggerSuite.GetSymbolType: TSymbolType;
|
||||
begin
|
||||
Result := Parent.SymbolType;
|
||||
end;
|
||||
|
||||
constructor TDebuggerSuite.Create(AParent: TCompilerOptionsSuite;
|
||||
ADebuggerInfo: TDebuggerInfo);
|
||||
begin
|
||||
inherited Create(ADebuggerInfo.Name);
|
||||
FParent := AParent;
|
||||
FDebuggerInfo := ADebuggerInfo;
|
||||
end;
|
||||
|
||||
procedure TDebuggerSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
NewTest: TGDBTestsuite;
|
||||
begin
|
||||
NewTest := TGDBTestsuite.Create(Self, ATestClass);
|
||||
AddTest(NewTest);
|
||||
end;
|
||||
|
||||
procedure TDebuggerSuite.TestCompile(const PrgName: string; out ExeName: string);
|
||||
begin
|
||||
Parent.TestCompile(PrgName, ExeName);
|
||||
end;
|
||||
|
||||
{ TGDBTestsuite }
|
||||
|
||||
function TGDBTestsuite.GetCompilerInfo: TCompilerInfo;
|
||||
begin
|
||||
Result := Parent.CompilerInfo;
|
||||
end;
|
||||
|
||||
function TGDBTestsuite.GetDebuggerInfo: TDebuggerInfo;
|
||||
begin
|
||||
Result := Parent.DebuggerInfo;
|
||||
end;
|
||||
|
||||
function TGDBTestsuite.GetSymbolType: TSymbolType;
|
||||
begin
|
||||
Result := Parent.SymbolType;
|
||||
end;
|
||||
|
||||
constructor TGDBTestsuite.Create(AParent: TDebuggerSuite; AClass: TClass);
|
||||
begin
|
||||
inherited Create(AClass);
|
||||
FParent := AParent;
|
||||
end;
|
||||
|
||||
procedure TGDBTestsuite.AddTest(ATest: TTest);
|
||||
begin
|
||||
inherited AddTest(ATest);
|
||||
if ATest is TGDBTestCase then
|
||||
TGDBTestCase(ATest).Parent := Self;
|
||||
end;
|
||||
|
||||
procedure TGDBTestsuite.TestCompile(const PrgName: string; out ExeName: string);
|
||||
begin
|
||||
Parent.TestCompile(PrgName, ExeName);
|
||||
end;
|
||||
|
||||
{ --- }
|
||||
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
Suite: TTestSuite;
|
||||
i: Integer;
|
||||
begin
|
||||
Suite := GetTestRegistry;
|
||||
for i := 0 to Suite.Tests.Count - 1 do
|
||||
if Suite.Test[i] is TCompilerSuite then
|
||||
TCompilerSuite(Suite.Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
|
||||
procedure BuildTestSuites;
|
||||
var
|
||||
FpcList: TCompilerList;
|
||||
GdbList: TDebuggerList;
|
||||
CompilerSuite: TCompilerSuite;
|
||||
i: Integer;
|
||||
begin
|
||||
FpcList := GetCompilers;
|
||||
GdbList := GetDebuggers;
|
||||
|
||||
for i := 0 to FpcList.Count - 1 do begin
|
||||
CompilerSuite := TCompilerSuite.Create(FpcList.CompilerInfo[i], GdbList);
|
||||
GetTestRegistry.AddTest(CompilerSuite);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
AppDir := AppendPathDelim(AppendPathDelim(ExtractFilePath(Paramstr(0))) + 'TestApps');
|
||||
EnvironmentOptions := TEnvironmentOptions.Create;
|
||||
with EnvironmentOptions do
|
||||
begin
|
||||
SetLazarusDefaultFilename;
|
||||
Load(false);
|
||||
end;
|
||||
BuildTestSuites;
|
||||
|
||||
finalization
|
||||
FreeAndNil(Compilers);
|
||||
FreeAndNil(Debuggers);
|
||||
|
||||
end.
|
||||
|
||||
@ -5,14 +5,14 @@ unit TestException;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, CompileHelpers,
|
||||
Debugger, GDBMIDebugger;
|
||||
Classes, fpcunit, testutils, testregistry,
|
||||
TestBase, Debugger, GDBMIDebugger, LCLProc;
|
||||
|
||||
type
|
||||
|
||||
{ TTestException }
|
||||
{ TTestExceptionOne }
|
||||
|
||||
TTestException = class(TTestCase)
|
||||
TTestExceptionOne = class(TGDBTestCase)
|
||||
private
|
||||
FGotExceptCount: Integer;
|
||||
FGotExceptClass: String;
|
||||
@ -21,16 +21,16 @@ type
|
||||
|
||||
procedure DoDebuggerException(Sender: TObject; const AExceptionType: TDBGExceptionType;
|
||||
const AExceptionClass: String; const AExceptionText: String; out AContinue: Boolean);
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
published
|
||||
procedure TestException1;
|
||||
procedure TestException;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
procedure TTestException.DoDebuggerException(Sender: TObject;
|
||||
procedure TTestExceptionOne.DoDebuggerException(Sender: TObject;
|
||||
const AExceptionType: TDBGExceptionType; const AExceptionClass: String;
|
||||
const AExceptionText: String; out AContinue: Boolean);
|
||||
begin
|
||||
@ -41,115 +41,47 @@ begin
|
||||
AContinue := False;
|
||||
end;
|
||||
|
||||
procedure TTestException.TestException1;
|
||||
procedure TTestExceptionOne.TestException;
|
||||
var
|
||||
AppDir: String;
|
||||
|
||||
procedure TestCompileWith(const Name, TestExeName, Fpc, Opts: string);
|
||||
var
|
||||
ErrMsg: String;
|
||||
begin
|
||||
ErrMsg := TestCompile(AppDir + 'ExceptPrg.pas', Opts, TestExeName, Fpc);
|
||||
if ErrMsg <> '' then
|
||||
Fail(Name + ' Compilation Failed '+ErrMsg);
|
||||
end;
|
||||
|
||||
procedure TestEceptWith(const Name, TestExeName, Gdb: string);
|
||||
var
|
||||
dbg: TGDBMIDebugger;
|
||||
AppDir: String;
|
||||
begin
|
||||
FGotExceptCount := 0;
|
||||
|
||||
dbg := TGDBMIDebugger.Create(Gdb);
|
||||
try
|
||||
//dbg.OnBreakPointHit := @DebuggerBreakPointHit;
|
||||
//dbg.OnState := @DebuggerChangeState;
|
||||
//dbg.OnCurrent := @DebuggerCurrentLine;
|
||||
//dbg.OnDbgOutput := @DebuggerOutput;
|
||||
//dbg.OnDbgEvent := @DebuggerEvent;
|
||||
dbg.OnException := @DoDebuggerException;
|
||||
|
||||
dbg.Init;
|
||||
if dbg.State = dsError then
|
||||
Fail(Name + ' Failed Init');
|
||||
//dbg.Environment
|
||||
|
||||
dbg.WorkingDir := AppDir;
|
||||
dbg.FileName := TestExeName;
|
||||
dbg.Arguments := '';
|
||||
dbg.ShowConsole := True;
|
||||
|
||||
dbg.Run;
|
||||
dbg.Stop;
|
||||
finally
|
||||
dbg.Release;
|
||||
end;
|
||||
|
||||
AssertEquals(Name + ' Got 1 exception', 1, FGotExceptCount);
|
||||
AssertEquals(Name + ' Got class', 'Exception', FGotExceptClass);
|
||||
AssertEquals(Name + ' Got msg', 'foo', FGotExceptMsg);
|
||||
end;
|
||||
|
||||
var
|
||||
FpcList, GdbList: TStringList;
|
||||
i, j: Integer;
|
||||
TestExeName: string;
|
||||
|
||||
dbg: TGDBMIDebugger;
|
||||
begin
|
||||
AppDir := ExtractFilePath(Paramstr(0)) + DirectorySeparator+ 'TestApps' + DirectorySeparator;
|
||||
FGotExceptCount := 0;
|
||||
|
||||
FpcList := GetCompilers;
|
||||
GdbList := GetDebuggers;
|
||||
AssertTrue('Has Compilers', FpcList.Count > 0);
|
||||
AssertTrue('Has Debuggers', GdbList.Count > 0);
|
||||
TestCompile(AppDir + 'ExceptPrg.pas', TestExeName);
|
||||
|
||||
for i := 0 to FpcList.Count - 1 do begin
|
||||
TestExeName := AppDir + 'lib' + DirectorySeparator + 'ExceptPrg.exe';
|
||||
AssertFalse('exe doesn''t exist yet', FileExists(TestExeName));
|
||||
try
|
||||
TestCompileWith('-gw', TestExeName, FpcList[i], '-gw');
|
||||
for j := 0 to GdbList.Count - 1 do begin
|
||||
TestEceptWith('-gw', TestExeName, GdbList[j]);
|
||||
end;
|
||||
try
|
||||
dbg := TGDBMIDebugger.Create(DebuggerInfo.ExeName);
|
||||
//dbg.OnBreakPointHit := @DebuggerBreakPointHit;
|
||||
//dbg.OnState := @DebuggerChangeState;
|
||||
//dbg.OnCurrent := @DebuggerCurrentLine;
|
||||
//dbg.OnDbgOutput := @DebuggerOutput;
|
||||
//dbg.OnDbgEvent := @DebuggerEvent;
|
||||
dbg.OnException := @DoDebuggerException;
|
||||
|
||||
DeleteFile(TestExeName);
|
||||
AssertFalse('exe doesn''t exist yet', FileExists(TestExeName));
|
||||
TestCompileWith('-gs', TestExeName, FpcList[i], '-gs');
|
||||
for j := 0 to GdbList.Count - 1 do begin
|
||||
TestEceptWith('-gs', TestExeName, GdbList[j]);
|
||||
end;
|
||||
dbg.Init;
|
||||
if dbg.State = dsError then
|
||||
Fail(' Failed Init');
|
||||
//dbg.Environment
|
||||
|
||||
// gw3: msg does not work yet
|
||||
//DeleteFile(TestExeName);
|
||||
//AssertFalse('exe doesn''t exist yet', FileExists(TestExeName));
|
||||
//TestCompileWith('-gw3', TestExeName, FpcList[i], '-gw3');
|
||||
//for j := 0 to GdbList.Count - 1 do begin
|
||||
// TestEceptWith('-gw3', TestExeName, GdbList[j]);
|
||||
//end;
|
||||
dbg.WorkingDir := AppDir;
|
||||
dbg.FileName := TestExeName;
|
||||
dbg.Arguments := '';
|
||||
dbg.ShowConsole := True;
|
||||
|
||||
finally
|
||||
DeleteFile(TestExeName);
|
||||
end;
|
||||
dbg.Run;
|
||||
dbg.Stop;
|
||||
finally
|
||||
dbg.Free;
|
||||
end;
|
||||
|
||||
|
||||
FreeAndNil(FpcList);
|
||||
FreeAndNil(GdbList);
|
||||
end;
|
||||
|
||||
procedure TTestException.SetUp;
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TTestException.TearDown;
|
||||
begin
|
||||
//
|
||||
AssertEquals(' Got 1 exception', 1, FGotExceptCount);
|
||||
AssertEquals(' Got class', 'Exception', FGotExceptClass);
|
||||
AssertEquals(' Got msg', 'foo', FGotExceptMsg);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterDbgTest(TTestExceptionOne);
|
||||
|
||||
RegisterTest(TTestException);
|
||||
end.
|
||||
|
||||
|
||||
117
debugger/test/Gdbmi/testwatches.pas
Normal file
117
debugger/test/Gdbmi/testwatches.pas
Normal file
@ -0,0 +1,117 @@
|
||||
unit Testwatches;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry,
|
||||
TestBase, Debugger, GDBMIDebugger, LCLProc;
|
||||
|
||||
type
|
||||
|
||||
{ TTestWatch }
|
||||
|
||||
TTestWatch = class(TBaseWatch)
|
||||
private
|
||||
FHasMultiValue: Boolean;
|
||||
FHasValue: Boolean;
|
||||
FMaster: TDBGWatch;
|
||||
FValue: String;
|
||||
protected
|
||||
procedure DoChanged; 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;
|
||||
FTestIntWatch: TTestWatch;
|
||||
published
|
||||
procedure TestWatches;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestWatch }
|
||||
|
||||
procedure TTestWatch.DoChanged;
|
||||
begin
|
||||
if FMaster.Valid = vsValid then begin
|
||||
if FHasValue and (FValue <> FMaster.Value) then
|
||||
FHasMultiValue := True;
|
||||
FHasValue := True;
|
||||
FValue := FMaster.Value;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TTestWatch.Create(AOwner: TBaseWatches; AMaster: TDBGWatch);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FMaster := AMaster;
|
||||
FMaster.Slave := Self;
|
||||
FMaster.Enabled := True;
|
||||
end;
|
||||
|
||||
{ TTestWatches }
|
||||
|
||||
procedure TTestWatches.TestWatches;
|
||||
var
|
||||
TestExeName: string;
|
||||
dbg: TGDBMIDebugger;
|
||||
begin
|
||||
TestCompile(AppDir + 'WatchesPrg.pas', TestExeName);
|
||||
FTestIntWatch := nil;
|
||||
|
||||
try
|
||||
FWatches := TBaseWatches.Create(TBaseWatch);
|
||||
dbg := TGDBMIDebugger.Create(DebuggerInfo.ExeName);
|
||||
//dbg.OnBreakPointHit := @DebuggerBreakPointHit;
|
||||
with dbg.BreakPoints.Add('WatchesPrg.pas', 16) do begin
|
||||
InitialEnabled := True;
|
||||
Enabled := True;
|
||||
end;
|
||||
|
||||
FTestIntWatch := TTestWatch.Create(FWatches, dbg.Watches.Add('TestInt'));
|
||||
|
||||
dbg.Init;
|
||||
if dbg.State = dsError then
|
||||
Fail(' Failed Init');
|
||||
|
||||
dbg.WorkingDir := AppDir;
|
||||
dbg.FileName := TestExeName;
|
||||
dbg.Arguments := '';
|
||||
dbg.ShowConsole := True;
|
||||
|
||||
dbg.Run;
|
||||
// hit breakpoint
|
||||
FTestIntWatch.Master.Value; // trigger read
|
||||
AssertTrue ('TestInt (HasValue)', FTestIntWatch.HasValue);
|
||||
AssertFalse ('TestInt (One Value)', FTestIntWatch.HasMultiValue);
|
||||
AssertEquals('TestInt (Value)', FTestIntWatch.Value, '10');
|
||||
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
dbg.Free;
|
||||
//FreeAndNil(FTestIntWatch);
|
||||
FreeAndNil(FWatches);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
initialization
|
||||
|
||||
RegisterDbgTest(TTestWatches);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user