Browse Source

* Fixed warnings/hints

git-svn-id: trunk@22130 -
michael 13 years ago
parent
commit
a665785b93

+ 53 - 14
packages/fcl-passrc/tests/tcbaseparser.pas

@@ -5,7 +5,7 @@ unit tcbaseparser;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser, testregistry;
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
 
 
 Type
 Type
   { TTestEngine }
   { TTestEngine }
@@ -65,6 +65,9 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TArgumentAccess); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TArgumentAccess); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifiers); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TVariableModifiers); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberVisibility); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
     Property Scanner : TPascalScanner Read FScanner;
@@ -309,28 +312,28 @@ Var
   E: TPasExportSymbol;
   E: TPasExportSymbol;
 
 
 begin
 begin
-  AssertNotNull('Have export symbols list',PasLibrary.LibrarySection.ExportSymbols);
+  AssertNotNull(Msg+'Have export symbols list',PasLibrary.LibrarySection.ExportSymbols);
   if AIndex>=PasLibrary.LibrarySection.ExportSymbols.Count then
   if AIndex>=PasLibrary.LibrarySection.ExportSymbols.Count then
-    Fail(Format('%d not a valid export list symbol',[AIndex]));
-  AssertNotNull('Have export symbol',PasLibrary.LibrarySection.ExportSymbols[Aindex]);
-  AssertEquals('Correct export symbol class',TPasExportSymbol,TObject(PasLibrary.LibrarySection.ExportSymbols[Aindex]).ClassType);
+    Fail(Format(Msg+'%d not a valid export list symbol',[AIndex]));
+  AssertNotNull(Msg+'Have export symbol',PasLibrary.LibrarySection.ExportSymbols[Aindex]);
+  AssertEquals(Msg+'Correct export symbol class',TPasExportSymbol,TObject(PasLibrary.LibrarySection.ExportSymbols[Aindex]).ClassType);
   E:=TPasExportSymbol(PasLibrary.LibrarySection.ExportSymbols[Aindex]);
   E:=TPasExportSymbol(PasLibrary.LibrarySection.ExportSymbols[Aindex]);
-  AssertEquals('Correct export symbol name',AName,E.Name);
+  AssertEquals(Msg+'Correct export symbol name',AName,E.Name);
   if (AExportName='') then
   if (AExportName='') then
-    AssertNull('No export name',E.ExportName)
+    AssertNull(Msg+'No export name',E.ExportName)
   else
   else
     begin
     begin
-    AssertNotNull('Export name symbol',E.ExportName);
-    AssertEquals('TPrimitiveExpr',TPrimitiveExpr,E.ExportName.CLassType);
-    AssertEquals('Correct export symbol export name ',''''+AExportName+'''',TPrimitiveExpr(E.ExportName).Value);
+    AssertNotNull(Msg+'Export name symbol',E.ExportName);
+    AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportName.CLassType);
+    AssertEquals(Msg+'Correct export symbol export name ',''''+AExportName+'''',TPrimitiveExpr(E.ExportName).Value);
     end;
     end;
   If AExportIndex=-1 then
   If AExportIndex=-1 then
-    AssertNull('No export name',E.ExportIndex)
+    AssertNull(Msg+'No export name',E.ExportIndex)
   else
   else
     begin
     begin
-    AssertNotNull('Export name symbol',E.ExportIndex);
-    AssertEquals('TPrimitiveExpr',TPrimitiveExpr,E.ExportIndex.CLassType);
-    AssertEquals('Correct export symbol export index',IntToStr(AExportindex),TPrimitiveExpr(E.ExportIndex).Value);
+    AssertNotNull(Msg+'Export name symbol',E.ExportIndex);
+    AssertEquals(Msg+'TPrimitiveExpr',TPrimitiveExpr,E.ExportIndex.CLassType);
+    AssertEquals(Msg+'Correct export symbol export index',IntToStr(AExportindex),TPrimitiveExpr(E.ExportIndex).Value);
     end;
     end;
 end;
 end;
 
 
@@ -378,6 +381,7 @@ procedure TTestParser.AssertEquals(const Msg: String; AExpected,
    M : TVariableModifier;
    M : TVariableModifier;
 
 
  begin
  begin
+   Result:='';
    For M:=Low(TVariableModifier) to High(TVariableModifier) do
    For M:=Low(TVariableModifier) to High(TVariableModifier) do
      if M in S then
      if M in S then
        begin
        begin
@@ -391,6 +395,41 @@ begin
   AssertEquals(Msg,Sn(AExpected),Sn(AActual));
   AssertEquals(Msg,Sn(AExpected),Sn(AActual));
 end;
 end;
 
 
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TPasMemberVisibility);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TPasMemberVisibility),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TProcedureModifier);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TProcedureModifier),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TProcedureModifier),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TProcedureModifiers);
+
+  Function Sn (S : TProcedureModifiers) : String;
+
+  Var
+    m : TProcedureModifier;
+  begin
+    Result:='';
+    For M:=Low(TProcedureModifier) to High(TProcedureModifier) do
+      If (m in S) then
+        begin
+        If (Result<>'') then
+           Result:=Result+',';
+        Result:=Result+GetEnumName(TypeInfo(TProcedureModifier),Ord(m))
+        end;
+  end;
+begin
+  AssertEquals(Msg,Sn(AExpected),SN(AActual));
+end;
+
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
 begin
 begin
   If not (AHint in AHints) then
   If not (AHint in AHints) then

+ 1 - 1
packages/fcl-passrc/tests/tcmoduleparser.pas

@@ -5,7 +5,7 @@ unit tcmoduleparser;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
   tcbaseparser, testregistry;
   tcbaseparser, testregistry;
 
 
 Type
 Type

+ 1 - 2
packages/fcl-passrc/tests/tconstparser.pas

@@ -5,8 +5,7 @@ unit tconstparser;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
-  tcbaseparser, testregistry;
+  Classes, SysUtils, fpcunit, pastree, pscanner, tcbaseparser, testregistry;
 
 
 Type
 Type
     { TTestConstParser }
     { TTestConstParser }

+ 1 - 1
packages/fcl-passrc/tests/tcscanner.pas

@@ -5,7 +5,7 @@ unit tcscanner;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, typinfo, fpcunit, testutils, testregistry, pscanner, pparser;
+  Classes, SysUtils, typinfo, fpcunit, testregistry, pscanner;
 
 
 type
 type
 
 

+ 5 - 12
packages/fcl-passrc/tests/tcstatements.pas

@@ -5,7 +5,7 @@ unit tcstatements;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
   tcbaseparser, testregistry;
   tcbaseparser, testregistry;
 
 
 Type
 Type
@@ -132,10 +132,9 @@ end;
 
 
 function TTestStatementParser.TestStatement(ASource: array of string): TPasImplElement;
 function TTestStatementParser.TestStatement(ASource: array of string): TPasImplElement;
 
 
-Var
-  i : Integer;
 
 
 begin
 begin
+  Result:=Nil;
   FStatement:=Nil;
   FStatement:=Nil;
   AddStatements(ASource);
   AddStatements(ASource);
   ParseModule;
   ParseModule;
@@ -145,6 +144,7 @@ begin
   if (PasProgram.InitializationSection.Elements.Count>0) then
   if (PasProgram.InitializationSection.Elements.Count>0) then
     if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
     if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
       FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
       FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+  Result:=FStatement;
 end;
 end;
 
 
 procedure TTestStatementParser.ExpectParserError(Const Msg : string);
 procedure TTestStatementParser.ExpectParserError(Const Msg : string);
@@ -377,9 +377,6 @@ end;
 
 
 procedure TTestStatementParser.TestIfSemiColonElseError;
 procedure TTestStatementParser.TestIfSemiColonElseError;
 
 
-Var
-  I : TPasImplIfElse;
-
 begin
 begin
   DeclareVar('boolean');
   DeclareVar('boolean');
   ExpectParserError('No semicolon before else',['if a then','  begin','  end;','else','  begin','  end']);
   ExpectParserError('No semicolon before else',['if a then','  begin','  end;','else','  begin','  end']);
@@ -387,7 +384,7 @@ end;
 
 
 procedure TTestStatementParser.TestNestedIf;
 procedure TTestStatementParser.TestNestedIf;
 Var
 Var
-  I,I2 : TPasImplIfElse;
+  I : TPasImplIfElse;
 begin
 begin
   DeclareVar('boolean');
   DeclareVar('boolean');
   DeclareVar('boolean','b');
   DeclareVar('boolean','b');
@@ -405,7 +402,7 @@ end;
 procedure TTestStatementParser.TestNestedIfElse;
 procedure TTestStatementParser.TestNestedIfElse;
 
 
 Var
 Var
-  I,I2 : TPasImplIfElse;
+  I : TPasImplIfElse;
 
 
 begin
 begin
   DeclareVar('boolean');
   DeclareVar('boolean');
@@ -895,8 +892,6 @@ procedure TTestStatementParser.TestCaseIfCaseElse;
 
 
 Var
 Var
   C : TPasImplCaseOf;
   C : TPasImplCaseOf;
-  S : TPasImplCaseStatement;
-  B : TPasImplbeginBlock;
 
 
 begin
 begin
   DeclareVar('integer');
   DeclareVar('integer');
@@ -915,7 +910,6 @@ procedure TTestStatementParser.TestCaseIfElse;
 Var
 Var
   C : TPasImplCaseOf;
   C : TPasImplCaseOf;
   S : TPasImplCaseStatement;
   S : TPasImplCaseStatement;
-  B : TPasImplbeginBlock;
 
 
 begin
 begin
   DeclareVar('integer');
   DeclareVar('integer');
@@ -1280,7 +1274,6 @@ Var
   E : TPasImplTryExcept;
   E : TPasImplTryExcept;
   O : TPasImplExceptOn;
   O : TPasImplExceptOn;
   EE : TPasImplTryExceptElse;
   EE : TPasImplTryExceptElse;
-  I : TPasImplIfElse;
 
 
 begin
 begin
   TestStatement(['Try','  DoSomething;','except','On E : Exception do','DoSomethingElse;','else','DoSomethingMore;','end']);
   TestStatement(['Try','  DoSomething;','except','On E : Exception do','DoSomethingElse;','else','DoSomethingMore;','end']);

+ 1 - 3
packages/fcl-passrc/tests/tctypeparser.pas

@@ -5,7 +5,7 @@ unit tctypeparser;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
   tcbaseparser, testregistry;
   tcbaseparser, testregistry;
 
 
 type
 type
@@ -475,8 +475,6 @@ end;
 
 
 procedure TTestProcedureTypeParser.DoTestProcedureArrayOfConst(
 procedure TTestProcedureTypeParser.DoTestProcedureArrayOfConst(
   CC: TCallingConvention; const AHint: String);
   CC: TCallingConvention; const AHint: String);
-Var
-  A : TPasArgument;
 
 
 begin
 begin
   ParseType('procedure(A : Array of const)',CC,TPasProcedureType,AHint);
   ParseType('procedure(A : Array of const)',CC,TPasProcedureType,AHint);

+ 1 - 1
packages/fcl-passrc/tests/tcvarparser.pas

@@ -5,7 +5,7 @@ unit tcvarparser;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser,
+  Classes, SysUtils, fpcunit, pastree, pscanner,
   tcbaseparser, testregistry;
   tcbaseparser, testregistry;
 
 
 Type
 Type