Browse Source

* Patch from Mattias Gaertner
* fixed hints in code.
* fixed tests.

git-svn-id: trunk@34225 -

michael 9 years ago
parent
commit
a40e6acbf6

+ 0 - 2
packages/fcl-passrc/src/passrcutil.pp

@@ -171,8 +171,6 @@ procedure TPasSrcAnalysis.GetClassMembers(AClass: TPasClassType; List: TStrings;
 Var
   I : Integer;
   E : TPasElement;
-  V : TPasVariant;
-
 begin
   For I:=0 to AClass.Members.Count-1 do
     begin

+ 5 - 7
packages/fcl-passrc/src/pastree.pp

@@ -158,7 +158,7 @@ type
 
   TPasExpr = class(TPasElement)
     Kind      : TPasExprKind;
-    OpCode    : TexprOpcode;
+    OpCode    : TExprOpCode;
     constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode); virtual; overload;
   end;
 
@@ -614,9 +614,9 @@ type
   { TPasUnresolvedUnitRef }
 
   TPasUnresolvedUnitRef = Class(TPasUnresolvedSymbolRef)
-    function ElementTypeName: string; override;
-  Public
+  public
     FileName : string;
+    function ElementTypeName: string; override;
   end;
 
   { TPasStringType }
@@ -630,7 +630,6 @@ type
   { TPasTypeRef }
 
   TPasTypeRef = class(TPasUnresolvedTypeRef)
-  public
   public
     RefType: TPasType;
   end;
@@ -657,6 +656,7 @@ type
   { TPasExportSymbol }
 
   TPasExportSymbol = class(TPasElement)
+  public
     ExportName : TPasExpr;
     Exportindex : TPasExpr;
     Destructor Destroy; override;
@@ -667,7 +667,6 @@ type
   { TPasConst }
 
   TPasConst = class(TPasVariable)
-  public
   public
     function ElementTypeName: string; override;
   end;
@@ -675,7 +674,7 @@ type
   { TPasProperty }
 
   TPasProperty = class(TPasVariable)
-  Public
+  public
     FResolvedType : TPasType;
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
@@ -864,7 +863,6 @@ Type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
   public
-
     Labels: TFPList;
     Body: TPasImplBlock;
   end;

+ 1 - 1
packages/fcl-passrc/src/pparser.pp

@@ -2097,7 +2097,7 @@ var
   VarEl: TPasVariable;
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
-  TypeName,ETN: String;
+  TypeName: String;
   PT : TProcType;
 
 begin

+ 1 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -251,7 +251,7 @@ type
 
   TStringStreamLineReader = class(TStreamLineReader)
   Public
-    constructor Create( const AFilename: string; Const ASource: String);
+    constructor Create( const AFilename: string; Const ASource: String); reintroduce;
   end;
 
   { TMacroReader }

+ 6 - 3
packages/fcl-passrc/tests/tcmoduleparser.pas

@@ -118,7 +118,8 @@ begin
   StartUnit('unit1');
   StartImplementation;
   ParseUnit;
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('Only system in interface units',1,IntfSection.UsesList.Count);
+  CheckUnit(0,'System',IntfSection.UsesList);
   AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
 end;
 
@@ -155,7 +156,8 @@ begin
   ParseUnit;
   AssertEquals('One implementation units',1,ImplSection.UsesList.Count);
   CheckUnit(0,'a',ImplSection.UsesList);
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('Only system in interface units',1,IntfSection.UsesList.Count);
+  CheckUnit(0,'System',IntfSection.UsesList);
 end;
 
 procedure TTestModuleParser.TestUnitTwoImplUses;
@@ -164,10 +166,11 @@ begin
   StartImplementation;
   UsesClause(['a','b']);
   ParseUnit;
+  AssertEquals('One interface unit',1,IntfSection.UsesList.Count);
+  CheckUnit(0,'System',IntfSection.UsesList);
   AssertEquals('Two implementation units',2,ImplSection.UsesList.Count);
   CheckUnit(0,'a',ImplSection.UsesList);
   CheckUnit(1,'b',ImplSection.UsesList);
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
 end;
 
 procedure TTestModuleParser.TestEmptyUnitInitialization;

+ 2 - 2
packages/fcl-passrc/tests/tcpassrcutil.pas

@@ -5,7 +5,7 @@ unit tcpassrcutil;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils,passrcutil, testregistry;
+  Classes, SysUtils, fpcunit,passrcutil, testregistry;
 
 type
 
@@ -78,7 +78,7 @@ begin
   StartImplementation;
   EndSource;
   Analyser.GetInterfaceUnits(List);
-  AssertList('0 interface units',[]);
+  AssertList('1 interface unit',['System']);
 end;
 
 procedure TPasSrcUtilTest.TestGetImplementationUses;

+ 8 - 7
packages/fcl-passrc/tests/tcstatements.pas

@@ -1,3 +1,7 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestStatementParser.TestCallQualified2
+}
 unit tcstatements;
 
 {$mode objfpc}{$H+}
@@ -382,10 +386,10 @@ begin
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as TBinaryExpr;
-  AssertExpression('Unit name',B.Left,pekIdent,'Unita');
-  AssertExpression('Doit call',B.Right,pekBinary,TBinaryExpr);
-  B:=B.Right  as TBinaryExpr;
-  AssertExpression('Unit name',B.Left,pekIdent,'ClassB');
+  AssertExpression('Unit name part 1',B.Left,pekIdent,'Unita');
+  AssertExpression('Second part of unit name',B.Right,pekBinary,TBinaryExpr);
+  B:=B.Right as TBinaryExpr;
+  AssertExpression('Unit name part 2',B.Left,pekIdent,'ClassB');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
 end;
 
@@ -979,9 +983,6 @@ procedure TTestStatementParser.TestCaseOtherwiseBlockEmpty;
 
 Var
   C : TPasImplCaseOf;
-  S : TPasImplCaseStatement;
-  B : TPasImplbeginBlock;
-
 begin
   DeclareVar('integer');
   TestStatement(['case a of','1 : begin end;','otherwise',' end;']);

+ 1 - 1
packages/fcl-passrc/tests/testpassrc.lpi

@@ -30,7 +30,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestProcedureFunction.TestOperatorTokens"/>
+        <CommandLineParams Value="--suite=TTestTypeParser.TestGenericArray"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">