Sfoglia il codice sorgente

* Added passrcutil easy-use unit and component

git-svn-id: trunk@22172 -
michael 13 anni fa
parent
commit
d118f4fb41

+ 2 - 0
.gitattributes

@@ -2326,6 +2326,7 @@ packages/fcl-passrc/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/examples/testunit1.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
 packages/fcl-passrc/fpmake.pp svneol=native#text/plain
+packages/fcl-passrc/src/passrcutil.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastounittest.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastounittest.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
 packages/fcl-passrc/src/pastree.pp svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
 packages/fcl-passrc/src/paswrite.pp svneol=native#text/plain
@@ -2337,6 +2338,7 @@ packages/fcl-passrc/tests/tcclasstype.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcexprparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcexprparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcmoduleparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tconstparser.pas svneol=native#text/plain
+packages/fcl-passrc/tests/tcpassrcutil.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcprocfunc.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcscanner.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
 packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain

+ 8 - 0
packages/fcl-passrc/fpmake.pp

@@ -46,6 +46,14 @@ begin
           AddUnit('pscanner');
           AddUnit('pscanner');
         end;
         end;
     T.ResourceStrings := True;
     T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('passrcutil.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('pparser');
+          AddUnit('pastree');
+          AddUnit('pscanner');
+        end;
+    T.ResourceStrings := False;
 
 
     T:=P.Targets.AddUnit('paswrite.pp');
     T:=P.Targets.AddUnit('paswrite.pp');
       with T.Dependencies do
       with T.Dependencies do

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

@@ -0,0 +1,292 @@
+unit passrcutil;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pscanner, pparser, pastree;
+
+Type
+
+  { TPasSrcAnalysis }
+
+  TPasSrcAnalysis = class(TComponent)
+  private
+    FFilename : string;
+    FResolver : TBaseFileResolver;
+    FScanner  : TPascalScanner;
+    FParser   : TPasParser;
+    FModule   : TPasModule;
+    FContainer : TPasTreeContainer;
+    FStream: TStream;
+    procedure SetFileName(AValue: string);
+    Function ResourceStringCount(Section : TPasSection) : Integer;
+  Protected
+    Procedure FreeParser;
+    Procedure CheckParser;
+    Procedure Parse;
+    procedure GetRecordFields(Rec: TPasrecordType; List: TStrings; const APrefix: String = ''); virtual;
+    procedure GetClassMembers(AClass: TPasClassType; List: TStrings; AVisibilities : TPasMemberVisibilities; const APrefix: String = ''); virtual;
+    procedure GetEnumValues(Enum: TPasEnumType; List: TStrings; const APrefix: String = ''); virtual;
+    procedure GetIdentifiers(Section: TPasSection; List: TStrings; Recurse: Boolean);virtual;
+    procedure GetUses(ASection: TPasSection; List: TStrings);virtual;
+  Public
+    Destructor Destroy; override;
+    Procedure GetInterfaceUnits(List : TStrings);
+    Procedure GetImplementationUnits(List : TStrings);
+    Procedure GetUsedUnits(List : TStrings);
+    Procedure GetInterfaceIdentifiers(List : TStrings; Recurse : Boolean = False);
+    Procedure GetImplementationIdentifiers(List : TStrings; Recurse : Boolean = False);
+    Procedure GetAllIdentifiers(List : TStrings; Recurse : Boolean = False);
+    Function InterfaceHasResourcestrings : Boolean;
+    Function ImplementationHasResourcestrings : Boolean;
+    Function HasResourcestrings : Boolean;
+    Property Stream : TStream Read FStream Write FStream;
+  Published
+    Property FileName : string Read FFilename Write SetFileName;
+  end;
+
+
+
+implementation
+
+Type
+  { TSrcContainer }
+  TSrcContainer = Class(TPasTreeContainer)
+  Public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;overload; override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+  { TSrcContainer }
+
+function TSrcContainer.CreateElement(AClass: TPTreeElement;
+  const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Result:=AClass.Create(AName,AParent);
+  Result.Visibility:=AVisibility;
+  Result.SourceFilename:=ASourceFileName;
+  Result.SourceLinenumber:=ASourceLineNumber;
+end;
+
+function TSrcContainer.FindElement(const AName: String): TPasElement;
+begin
+  Result:=Nil;
+end;
+
+{ TPasSrcAnalysis }
+
+procedure TPasSrcAnalysis.SetFileName(AValue: string);
+begin
+  if FFilename=AValue then Exit;
+  FFilename:=AValue;
+  FreeParser;
+end;
+
+function TPasSrcAnalysis.ResourceStringCount(Section: TPasSection): Integer;
+begin
+  Result:=0;
+  If Assigned(Section) and Assigned(Section.ResStrings) then
+   Result:=Section.ResStrings.Count;;
+end;
+
+procedure TPasSrcAnalysis.FreeParser;
+
+begin
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FContainer);
+  FreeAndNil(FResolver);
+  FreeAndNil(FModule);
+end;
+
+procedure TPasSrcAnalysis.CheckParser;
+begin
+  If (FParser<>Nil) then
+    exit;
+  Try
+    If Assigned(Stream) then
+      begin
+      FResolver:=TStreamResolver.Create;
+      TStreamResolver(Fresolver).AddStream(FileName,Stream);
+      end
+    else
+      FResolver:=TFileResolver.Create;
+    FResolver.BaseDirectory:=ExtractFilePath(Filename);
+    FScanner:=TPascalScanner.Create(FResolver);
+    FScanner.OpenFile(FileName);
+    FContainer:=TSrcContainer.Create;
+    FParser:=TPasParser.Create(FScanner,FResolver,FContainer);
+  except
+    FreeParser;
+    Raise;
+  end;
+end;
+
+procedure TPasSrcAnalysis.Parse;
+begin
+  If FModule<>Nil then exit;
+  CheckParser;
+  FParser.ParseMain(FModule);
+end;
+
+procedure TPasSrcAnalysis.GetRecordFields(Rec: TPasrecordType; List: TStrings;
+  const APrefix: String = '');
+
+Var
+  I : Integer;
+  E : TPasElement;
+  V : TPasVariant;
+
+begin
+  For I:=0 to Rec.Members.Count-1 do
+    begin
+    E:=TPasElement(Rec.Members[I]);
+    if E<>Nil then
+      List.Add(APrefix+E.Name);
+    end;
+  If Assigned(Rec.Variants) then
+    For I:=0 to Rec.Variants.Count-1 do
+      begin
+      V:=TPasVariant(Rec.Variants[I]);
+      if (v<>Nil) and (V.members<>Nil) then
+        GetRecordFields(V.Members,List,APrefix);
+      end;
+end;
+
+procedure TPasSrcAnalysis.GetClassMembers(AClass: TPasClassType; List: TStrings;
+  AVisibilities: TPasMemberVisibilities; const APrefix: String);
+Var
+  I : Integer;
+  E : TPasElement;
+  V : TPasVariant;
+
+begin
+  For I:=0 to AClass.Members.Count-1 do
+    begin
+    E:=TPasElement(AClass.Members[I]);
+    if (E<>Nil) and ((AVisibilities=[]) or (E.Visibility in AVisibilities)) then
+      List.Add(APrefix+E.Name);
+    end;
+end;
+
+destructor TPasSrcAnalysis.Destroy;
+begin
+  FreeParser;
+  inherited Destroy;
+end;
+
+procedure TPasSrcAnalysis.GetUses(ASection : TPasSection; List: TStrings);
+
+Var
+  I : Integer;
+begin
+  If Assigned(ASection) and Assigned(ASection.UsesList) then
+    For I:=0 to ASection.UsesList.Count-1 do
+      List.Add(TPasElement(ASection.UsesList[i]).Name);
+end;
+
+procedure TPasSrcAnalysis.GetInterfaceUnits(List: TStrings);
+begin
+  Parse;
+  GetUses(Fmodule.InterfaceSection,List);
+end;
+
+procedure TPasSrcAnalysis.GetImplementationUnits(List: TStrings);
+begin
+  Parse;
+  GetUses(Fmodule.ImplementationSection,List);
+end;
+
+procedure TPasSrcAnalysis.GetUsedUnits(List: TStrings);
+begin
+  Parse;
+  GetUses(Fmodule.InterfaceSection,List);
+  GetUses(Fmodule.ImplementationSection,List);
+end;
+
+procedure TPasSrcAnalysis.GetEnumValues(Enum : TPasEnumType;List : TStrings; Const APrefix : String = '');
+
+Var
+  I : Integer;
+  E : TPasElement;
+
+begin
+  For I:=0 to Enum.Values.Count-1 do
+    begin
+    E:=TPasElement(Enum.Values[I]);
+    If (E<>Nil) then
+      List.Add(APrefix+E.Name);
+    end;
+end;
+
+procedure TPasSrcAnalysis.GetIdentifiers(Section : TPasSection; List: TStrings; Recurse : Boolean);
+
+Var
+  I : Integer;
+  E : TPasElement;
+
+begin
+  if not (Assigned(Section) and Assigned(Section.Declarations)) then
+    Exit;
+  For I:=0 to Section.Declarations.Count-1 do
+    begin
+    E:=TPasElement(Section.Declarations[I]);
+    If (E.Name<>'') then
+      List.Add(E.Name);
+    if Recurse then
+      begin
+      If E is TPasEnumType then
+        GetEnumValues(TPasEnumType(E),List,E.Name+'.')
+      else if E is TPasRecordType then
+        GetRecordFields(TPasRecordType(E),List,E.Name+'.')
+      else if E is TPasClassType then
+        GetClassMembers(TPasClassType(E),List,[],E.Name+'.')
+      end;
+    end;
+end;
+
+procedure TPasSrcAnalysis.GetInterfaceIdentifiers(List: TStrings; Recurse : Boolean = False);
+begin
+  Parse;
+  GetIdentifiers(Fmodule.InterfaceSection,List,Recurse);
+end;
+
+procedure TPasSrcAnalysis.GetImplementationIdentifiers(List: TStrings;
+  Recurse: Boolean);
+begin
+  Parse;
+  GetIdentifiers(Fmodule.ImplementationSection,List,Recurse);
+end;
+
+procedure TPasSrcAnalysis.GetAllIdentifiers(List: TStrings; Recurse: Boolean);
+begin
+  Parse;
+  GetIdentifiers(Fmodule.InterfaceSection,List,Recurse);
+  GetIdentifiers(Fmodule.ImplementationSection,List,Recurse);
+end;
+
+function TPasSrcAnalysis.InterfaceHasResourcestrings: Boolean;
+begin
+  Parse;
+  Result:=ResourceStringCount(Fmodule.InterfaceSection)>0;
+end;
+
+function TPasSrcAnalysis.ImplementationHasResourcestrings: Boolean;
+begin
+  Parse;
+  Result:=ResourceStringCount(Fmodule.ImplementationSection)>0;
+end;
+
+function TPasSrcAnalysis.HasResourcestrings: Boolean;
+begin
+  Parse;
+  Result:=(ResourceStringCount(Fmodule.InterfaceSection)>0)
+           or (ResourceStringCount(Fmodule.ImplementationSection)>0);
+end;
+
+end.
+

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

@@ -972,7 +972,6 @@ begin
       UngetToken;
       UngetToken;
       Result:=ParseRangeType(Parent,TypeName,Full);
       Result:=ParseRangeType(Parent,TypeName,Full);
     end;
     end;
-    DumpCurToken('Done');
     if CH then
     if CH then
       CheckHint(Result,True);
       CheckHint(Result,True);
   Except
   Except

+ 422 - 0
packages/fcl-passrc/tests/tcpassrcutil.pas

@@ -0,0 +1,422 @@
+unit tcpassrcutil;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils,passrcutil, testregistry;
+
+type
+
+  { TPasSrcUtilTest }
+
+  TPasSrcUtilTest= class(TTestCase)
+  Protected
+    FAnalyser : TPasSrcAnalysis;
+    FSrc : TStrings;
+    FList : TStrings;
+    FStream: TmemoryStream;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure AddLine(Const ALine : String);
+    Procedure AddUses(Const AUsesList : String);
+    Procedure StartUnit;
+    Procedure StartImplementation;
+    Procedure EndSource;
+    Procedure AssertList(Msg : String; Els : Array of string);
+    Property Analyser : TPasSrcAnalysis Read FAnalyser;
+    Property List : TStrings Read FList;
+  published
+    procedure TestGetInterfaceUses;
+    procedure TestGetInterfaceUsesEmpty;
+    procedure TestGetImplementationUses;
+    procedure TestGetImplementationUsesEmpty;
+    procedure TestGetAllUses;
+    procedure TestGetInterfaceIdentifiers;
+    procedure TestGetInterfaceVarIdentifiers;
+    procedure TestGetInterface2VarIdentifiers;
+    procedure TestGetInterfaceConstIdentifiers;
+    procedure TestGetInterface2ConstsIdentifiers;
+    procedure TestGetInterfaceTypeIdentifiers;
+    procedure TestGetInterface2TypeIdentifiers;
+    procedure TestGetInterfaceProcIdentifiers;
+    procedure TestGetInterfaceResourcestringIdentifiers;
+    procedure TestGetInterfaceEnumTypeIdentifiersNoRecurse;
+    procedure TestGetInterfaceEnumTypeIdentifiersRecurse;
+    procedure TestGetInterfaceRecordTypeIdentifiersNoRecurse;
+    procedure TestGetInterfaceRecordTypeIdentifiersRecurse;
+    procedure TestGetInterfaceRecordTypeIdentifiersRecurseVariant;
+    procedure TestGetInterfaceClassTypeIdentifiersNoRecurse;
+    procedure TestGetInterfaceClassTypeIdentifiersRecurse;
+    procedure TestGetImplementationVarIdentifiers;
+    procedure TestInterfaceHasResourceStrings;
+    procedure TestInterfaceHasResourceStringsFalse;
+    procedure TestImplementationHasResourceStrings;
+    procedure TestHasResourceStrings;
+    procedure TestHasResourceStrings2;
+    procedure TestHasResourceStrings3;
+    procedure TestHasResourceStrings4;
+  end;
+
+implementation
+
+procedure TPasSrcUtilTest.TestGetInterfaceUses;
+begin
+  StartUnit;
+  AddUses('a,b,c');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceUnits(List);
+  AssertList('4 interface units',['System','a','b','c']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceUsesEmpty;
+begin
+  StartUnit;
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceUnits(List);
+  AssertList('0 interface units',[]);
+end;
+
+procedure TPasSrcUtilTest.TestGetImplementationUses;
+begin
+  StartUnit;
+  StartImplementation;
+  AddUses('d,a,b,c');
+  EndSource;
+  Analyser.GetImplementationUnits(List);
+  AssertList('4 implementation units',['d','a','b','c']);
+end;
+
+procedure TPasSrcUtilTest.TestGetImplementationUsesEmpty;
+begin
+  StartUnit;
+  StartImplementation;
+  EndSource;
+  Analyser.GetImplementationUnits(List);
+  AssertList('0 implementation units',[]);
+end;
+
+procedure TPasSrcUtilTest.TestGetAllUses;
+begin
+  StartUnit;
+  AddUses('a,b,c');
+  StartImplementation;
+  AddUses('d,e');
+  EndSource;
+  Analyser.GetUsedUnits(List);
+  AssertList('6 units',['System','a','b','c','d','e']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceIdentifiers;
+begin
+  StartUnit;
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('0 identifiers',[]);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceVarIdentifiers;
+begin
+  StartUnit;
+  AddLine('Var a : integer;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['a']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterface2VarIdentifiers;
+begin
+  StartUnit;
+  AddLine('Var a,b : integer;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('2 identifiers',['a','b']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceConstIdentifiers;
+begin
+  StartUnit;
+  AddLine('Const a = 123;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['a']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterface2ConstsIdentifiers;
+begin
+  StartUnit;
+  AddLine('Const a = 123;');
+  AddLine(' b = 123;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('2 identifiers',['a','b']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceTypeIdentifiers;
+begin
+  StartUnit;
+  AddLine('Type a = Integer;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['a']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterface2TypeIdentifiers;
+begin
+  StartUnit;
+  AddLine('Type a = Integer;');
+  AddLine(' b = Word;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('2 identifiers',['a','b']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceProcIdentifiers;
+begin
+  StartUnit;
+  AddLine('Procedure a (b : Integer);');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['a']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceResourcestringIdentifiers;
+begin
+  StartUnit;
+  AddLine('Resourcestring astring = ''Something'';');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['astring']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceEnumTypeIdentifiersNoRecurse;
+begin
+  StartUnit;
+  AddLine('Type aenum = (one,two,three);');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List);
+  AssertList('1 identifiers',['aenum']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceEnumTypeIdentifiersRecurse;
+begin
+  StartUnit;
+  AddLine('Type aenum = (one,two,three);');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,True);
+  AssertList('4 identifiers',['aenum','aenum.one','aenum.two','aenum.three']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceRecordTypeIdentifiersNoRecurse;
+begin
+  StartUnit;
+  AddLine('Type arec = record one,two,three : integer; end;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,False);
+  AssertList('1 identifier',['arec']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceRecordTypeIdentifiersRecurse;
+begin
+  StartUnit;
+  AddLine('Type arec = record one,two,three : integer; end;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,True);
+  AssertList('4 identifiers',['arec','arec.one','arec.two','arec.three']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceRecordTypeIdentifiersRecurseVariant;
+begin
+  StartUnit;
+  AddLine('Type arec = record one,two,three : integer; case integer of 1: (x : integer;); end;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,True);
+  AssertList('4 identifiers',['arec','arec.one','arec.two','arec.three','arec.x']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceClassTypeIdentifiersNoRecurse;
+begin
+  StartUnit;
+  AddLine('Type TMyClass = Class');
+  AddLine('   one,two,three : integer;');
+  AddLine('end;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,False);
+  AssertList('4 identifiers',['TMyClass']);
+end;
+
+procedure TPasSrcUtilTest.TestGetInterfaceClassTypeIdentifiersRecurse;
+begin
+  StartUnit;
+  AddLine('Type TMyClass = Class');
+  AddLine('   one,two,three : integer;');
+  AddLine('end;');
+  StartImplementation;
+  EndSource;
+  Analyser.GetInterfaceIdentifiers(List,True);
+  AssertList('4 identifiers',['TMyClass','TMyClass.one','TMyClass.two','TMyClass.three']);
+end;
+
+procedure TPasSrcUtilTest.TestGetImplementationVarIdentifiers;
+begin
+  StartUnit;
+  StartImplementation;
+  AddLine('Var a : integer;');
+  EndSource;
+  Analyser.GetImplementationIdentifiers(List);
+  AssertList('1 identifiers',['a']);
+end;
+
+procedure TPasSrcUtilTest.TestInterfaceHasResourceStrings;
+begin
+  StartUnit;
+  AddLine('Resourcestring astring = ''Something'';');
+  StartImplementation;
+  EndSource;
+  AssertEquals('Have res. strings',True,Analyser.InterfaceHasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestInterfaceHasResourceStringsFalse;
+begin
+  StartUnit;
+  StartImplementation;
+  AddLine('Resourcestring astring = ''Something'';');
+  EndSource;
+  AssertEquals('Have no res. strings',False,Analyser.InterfaceHasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestImplementationHasResourceStrings;
+begin
+  StartUnit;
+  StartImplementation;
+  AddLine('Resourcestring astring = ''Something'';');
+  EndSource;
+  AssertEquals('Have res. strings',True,Analyser.ImplementationHasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestHasResourceStrings;
+begin
+  StartUnit;
+  StartImplementation;
+  EndSource;
+  AssertEquals('No res. strings',False,Analyser.ImplementationHasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestHasResourceStrings2;
+begin
+  StartUnit;
+  AddLine('Resourcestring astring = ''Something'';');
+  StartImplementation;
+  EndSource;
+  AssertEquals('Have  res. strings',True,Analyser.HasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestHasResourceStrings3;
+begin
+  StartUnit;
+  AddLine('Resourcestring astring = ''Something'';');
+  StartImplementation;
+  EndSource;
+  AssertEquals('Have  res. strings',True,Analyser.HasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.TestHasResourceStrings4;
+begin
+  StartUnit;
+  AddLine('Resourcestring astring = ''Something'';');
+  StartImplementation;
+  AddLine('Resourcestring astring2 = ''Something'';');
+  EndSource;
+  AssertEquals('Have  res. strings',True,Analyser.HasResourcestrings)
+end;
+
+procedure TPasSrcUtilTest.SetUp;
+begin
+  FAnalyser:=TPasSrcAnalysis.Create(Nil);
+  FSrc:=TStringList.Create;
+  FList:=TStringList.Create;
+  FStream:=TMemoryStream.Create;
+  FAnalyser.FileName:='atest.pp';
+  FAnalyser.Stream:=FStream;
+end;
+
+procedure TPasSrcUtilTest.TearDown;
+begin
+  FreeAndNil(FAnalyser);
+  FreeAndNil(FStream);
+  FreeAndNil(FSrc);
+  FreeAndNil(FList);
+end;
+
+procedure TPasSrcUtilTest.AddLine(const ALine: String);
+begin
+  FSrc.Add(ALine);
+end;
+
+procedure TPasSrcUtilTest.AddUses(const AUsesList: String);
+begin
+  AddLine('uses '+AUseslist+';');
+  AddLine('');
+end;
+
+procedure TPasSrcUtilTest.StartUnit;
+begin
+  AddLine('unit atest;');
+  AddLine('');
+  AddLine('Interface');
+  AddLine('');
+end;
+
+procedure TPasSrcUtilTest.StartImplementation;
+begin
+  AddLine('');
+  AddLine('Implementation');
+  AddLine('');
+end;
+
+procedure TPasSrcUtilTest.EndSource;
+begin
+  AddLine('');
+  AddLine('end.');
+  FSrc.SaveToStream(FStream);
+  FStream.Position:=0;
+  Writeln('// Test name : ',Self.TestName);
+  Writeln(FSrc.Text);
+end;
+
+procedure TPasSrcUtilTest.AssertList(Msg: String; Els: array of string);
+
+Var
+  I : Integer;
+
+begin
+  AssertEquals(Msg+': number of elements',Length(Els),List.Count);
+  For I:=Low(Els) to High(Els) do
+    AssertEquals(Msg+': list element '+IntToStr(i)+' matches : ',Els[i],List[i]);
+end;
+
+
+initialization
+
+  RegisterTest(TPasSrcUtilTest);
+end.
+

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

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
         <PackageName Value="FCL"/>
       </Item2>
       </Item2>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -93,6 +93,11 @@
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="tcprocfunc"/>
         <UnitName Value="tcprocfunc"/>
       </Unit10>
       </Unit10>
+      <Unit11>
+        <Filename Value="tcpassrcutil.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcpassrcutil"/>
+      </Unit11>
     </Units>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

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

@@ -5,7 +5,7 @@ program testpassrc;
 uses
 uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc;
+  tcexprparser, tcprocfunc, tcpassrcutil;
 
 
 type
 type