FPDebug: tests

git-svn-id: trunk@43277 -

.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

components/fpdebug/test/FpTest.lpi

@@ -42,7 +42,7 @@
         <PackageName Value="FCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="FpTest.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -53,6 +53,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TestPascalParser"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="testtypeinfo.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestTypeInfo"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -60,6 +65,7 @@
     <PathDelim Value="\"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Other>
       <CompilerMessages>

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}
 

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

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.

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.
+