From 507706949ba9d07c9c94c560fe0a620b8991c77d Mon Sep 17 00:00:00 2001 From: martin Date: Fri, 18 Oct 2013 22:46:25 +0000 Subject: [PATCH] FPDebug: tests git-svn-id: trunk@43277 - --- .gitattributes | 3 + components/fpdebug/test/FpTest.lpi | 8 +- components/fpdebug/test/FpTest.lpr | 2 +- .../fpdebug/test/testapps/CompileAll.bat | 3 + .../fpdebug/test/testapps/testprog1.pas | 34 ++++ components/fpdebug/test/testtypeinfo.pas | 153 ++++++++++++++++++ 6 files changed, 201 insertions(+), 2 deletions(-) create mode 100644 components/fpdebug/test/testapps/CompileAll.bat create mode 100644 components/fpdebug/test/testapps/testprog1.pas create mode 100644 components/fpdebug/test/testtypeinfo.pas diff --git a/.gitattributes b/.gitattributes index 456ecbd1a4..3ea28f36fc 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1249,7 +1249,10 @@ components/fpdebug/test/asmtest.lpi svneol=native#text/plain components/fpdebug/test/asmtest.lpr svneol=native#text/pascal components/fpdebug/test/asmtestunit.lfm svneol=native#text/plain components/fpdebug/test/asmtestunit.pas svneol=native#text/pascal +components/fpdebug/test/testapps/CompileAll.bat svneol=native#text/pascal +components/fpdebug/test/testapps/testprog1.pas svneol=native#text/pascal components/fpdebug/test/testpascalparser.pas svneol=native#text/pascal +components/fpdebug/test/testtypeinfo.pas svneol=native#text/pascal components/fppkg/images/archive.png -text components/fppkg/images/broken.png -text components/fppkg/images/build.png -text diff --git a/components/fpdebug/test/FpTest.lpi b/components/fpdebug/test/FpTest.lpi index 387f948f19..17789ca993 100644 --- a/components/fpdebug/test/FpTest.lpi +++ b/components/fpdebug/test/FpTest.lpi @@ -42,7 +42,7 @@ - + @@ -53,6 +53,11 @@ + + + + + @@ -60,6 +65,7 @@ + diff --git a/components/fpdebug/test/FpTest.lpr b/components/fpdebug/test/FpTest.lpr index 784c32b5e9..3701b3f062 100644 --- a/components/fpdebug/test/FpTest.lpr +++ b/components/fpdebug/test/FpTest.lpr @@ -3,7 +3,7 @@ program FpTest; {$mode objfpc}{$H+} uses - Interfaces, Forms, GuiTestRunner, TestPascalParser; + Interfaces, Forms, GuiTestRunner, TestPascalParser, TestTypeInfo; {$R *.res} diff --git a/components/fpdebug/test/testapps/CompileAll.bat b/components/fpdebug/test/testapps/CompileAll.bat new file mode 100644 index 0000000000..c7de66069f --- /dev/null +++ b/components/fpdebug/test/testapps/CompileAll.bat @@ -0,0 +1,3 @@ +c:\FPC\rel_2_6_2\gl\bin\i386-win32\fpc.exe -O- -gw -godwarfsets -otestprog1.exe testprog1.pas + +pause diff --git a/components/fpdebug/test/testapps/testprog1.pas b/components/fpdebug/test/testapps/testprog1.pas new file mode 100644 index 0000000000..c471984d4f --- /dev/null +++ b/components/fpdebug/test/testapps/testprog1.pas @@ -0,0 +1,34 @@ +program Foo; +{$mode objfpc}{$H+} + +type + TTestClass = class + public + FWord: Word; + FBool: Boolean; + FTest: TTestClass; + end; + +procedure Bar; +var + int1, int2: Integer; + pint1, pint2: ^Integer; + uint1, uint2: Cardinal; + puint1, puint2: ^Cardinal; + b1,b2: Byte; + bool1,bool2: Boolean; + test: TTestClass; + +begin + int1 := int2; + pint1 := pint2; + uint1 := uint2; + puint1 := puint2; + b1:=b2; + bool1 := bool2; + writeln(int1,uint1,b1,bool1, test.FWord); +end; + +begin + Bar; +end. diff --git a/components/fpdebug/test/testtypeinfo.pas b/components/fpdebug/test/testtypeinfo.pas new file mode 100644 index 0000000000..cbf0855613 --- /dev/null +++ b/components/fpdebug/test/testtypeinfo.pas @@ -0,0 +1,153 @@ +unit TestTypeInfo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FpPascalParser, FpDbgDwarf, FpDbgClasses, FpDbgLoader, FileUtil, + LazLoggerBase, fpcunit, testutils, testregistry; + +const + TESTPROG1_FUNC_BAR_LINE = 25; + +type + + { TTestPascalExpression } + + TTestPascalExpression = class(TFpPascalExpression) + private + protected + function GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol; override; + public + end; + + { TTestTypInfo } + + TTestTypInfo = class(TTestCase) + protected + procedure LoadDwarf(AFileName: String); + procedure UnLoadDwarf; + function GetTestAppDir: String; + published + procedure Test1; + end; + +implementation +var + FImageLoader: TDbgImageLoader; + FDwarfInfo: TDbgDwarf; + Location: TDBGPtr; + +{ TTestPascalExpression } + +function TTestPascalExpression.GetDbgTyeForIdentifier(AnIdent: String): TDbgSymbol; +var + Loc: TDBGPtr; +begin + Result := nil; + if (FDwarfInfo <> nil) and (AnIdent <> '') then + Result := FDwarfInfo.FindIdentifier(Location, AnIdent); +end; + +procedure TTestTypInfo.LoadDwarf(AFileName: String); +begin + UnLoadDwarf; + if not FileExistsUTF8(AFileName) then exit; + FImageLoader := TDbgImageLoader.Create(AFileName); + if not FImageLoader.IsValid then begin + FreeAndNil(FImageLoader); + exit; + end;; + FDwarfInfo := TDbgDwarf.Create(FImageLoader); + FDwarfInfo.LoadCompilationUnits; +end; + +procedure TTestTypInfo.UnLoadDwarf; +begin + FreeAndNil(FDwarfInfo); + FreeAndNil(FImageLoader); +end; + +function TTestTypInfo.GetTestAppDir: String; +begin + Result := ProgramDirectory; + while Result <> '' do begin + if DirectoryExistsUTF8(AppendPathDelim(Result) + 'testapps') then begin + Result := AppendPathDelim(Result) + 'testapps'; + exit; + end; + while (Result <> '') and (Result[Length(Result)] <> DirectorySeparator) do + SetLength(Result, Length(Result)-1); + while (Result <> '') and (Result[Length(Result)] = DirectorySeparator) do + SetLength(Result, Length(Result)-1); + end; +end; + +procedure TTestTypInfo.Test1; +var + Expr: TTestPascalExpression; + TestText: String; + + procedure DoTest(ADbgSym: TDbgSymbol; AKind: TDbgSymbolKind; ATypeName: String = ''); + begin + AssertTrue(TestText+' not nil', ADbgSym <> nil); + if ATypeName <> '' then + AssertEquals(TestText+' type-name', LowerCase(ATypeName), LowerCase(ADbgSym.Name)); + AssertEquals(TestText+' kind', dbgs(AKind), dbgs(ADbgSym.Kind)); + end; + + procedure DoTest(AExprText: String; AKind: TDbgSymbolKind; ATypeName: String = ''); + begin + FreeAndNil(Expr); + TestText := AExprText; + Expr := TTestPascalExpression.Create(AExprText); + + AssertTrue(TestText+' is valid', Expr.Valid); + AssertTrue(TestText+' has ddbginfo', Expr.ResultType <> nil); + + if ATypeName <> '' then + AssertEquals(TestText+' type-name', LowerCase(ATypeName), LowerCase(Expr.ResultType.Name)); + AssertEquals(TestText+' kind', dbgs(AKind), dbgs(Expr.ResultType.Kind)); + end; + +var + LineInfo: PDWarfLineMap; +begin + LoadDwarf(AppendPathDelim(GetTestAppDir) + 'testprog1.exe'); + AssertTrue('Loaded dwarf', FDwarfInfo <> nil); + + LineInfo := FDwarfInfo.GetLineAddressMap('testprog1.pas'); + Location := LineInfo^.GetAddressForLine(TESTPROG1_FUNC_BAR_LINE); + + DoTest('int1', skInteger); + DoTest('b1', skCardinal); + + DoTest('pint1', skPointer); + DoTest(Expr.ResultType.PointedToType, skInteger); + + DoTest('@int1', skPointer); + DoTest(Expr.ResultType.PointedToType, skInteger); + + DoTest('pint1^', skInteger); + DoTest('@int1^', skInteger); + + DoTest('bool1', skBoolean); + + DoTest('test.FWord', skCardinal); + DoTest('test.FBool', skBoolean); + DoTest('test.FTest.FWord', skCardinal); + DoTest('test.FTest.FBool', skBoolean); + + FreeAndNil(expr); + + UnLoadDwarf; +end; + + + +initialization + + RegisterTest(TTestTypInfo); +end. +