diff --git a/.gitattributes b/.gitattributes
index 7d37f978b7..0d40135c4c 100644
--- a/.gitattributes
+++ b/.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/testunit1.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/pastree.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/tcmoduleparser.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/tcscanner.pas svneol=native#text/plain
packages/fcl-passrc/tests/tcstatements.pas svneol=native#text/plain
diff --git a/packages/fcl-passrc/fpmake.pp b/packages/fcl-passrc/fpmake.pp
index ee8055d908..83c78274f3 100644
--- a/packages/fcl-passrc/fpmake.pp
+++ b/packages/fcl-passrc/fpmake.pp
@@ -46,6 +46,14 @@ begin
AddUnit('pscanner');
end;
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');
with T.Dependencies do
diff --git a/packages/fcl-passrc/src/passrcutil.pp b/packages/fcl-passrc/src/passrcutil.pp
new file mode 100644
index 0000000000..516f92570c
--- /dev/null
+++ b/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.
+
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 6dc760512a..06083a53c7 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -972,7 +972,6 @@ begin
UngetToken;
Result:=ParseRangeType(Parent,TypeName,Full);
end;
- DumpCurToken('Done');
if CH then
CheckHint(Result,True);
Except
diff --git a/packages/fcl-passrc/tests/tcpassrcutil.pas b/packages/fcl-passrc/tests/tcpassrcutil.pas
new file mode 100644
index 0000000000..a4d191840e
--- /dev/null
+++ b/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.
+
diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi
index 8bac411e17..7f6fd3c802 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpi
+++ b/packages/fcl-passrc/tests/testpassrc.lpi
@@ -37,7 +37,7 @@
-
+
@@ -93,6 +93,11 @@
+
+
+
+
+
diff --git a/packages/fcl-passrc/tests/testpassrc.lpr b/packages/fcl-passrc/tests/testpassrc.lpr
index b1818e1928..0590042139 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpr
+++ b/packages/fcl-passrc/tests/testpassrc.lpr
@@ -5,7 +5,7 @@ program testpassrc;
uses
Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
- tcexprparser, tcprocfunc;
+ tcexprparser, tcprocfunc, tcpassrcutil;
type