mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 18:29:18 +02:00
* Added passrcutil easy-use unit and component
git-svn-id: trunk@22172 -
This commit is contained in:
parent
59db00bcf0
commit
d118f4fb41
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||||
|
@ -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
packages/fcl-passrc/src/passrcutil.pp
Normal file
292
packages/fcl-passrc/src/passrcutil.pp
Normal file
@ -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.
|
||||||
|
|
@ -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
packages/fcl-passrc/tests/tcpassrcutil.pas
Normal file
422
packages/fcl-passrc/tests/tcpassrcutil.pas
Normal file
@ -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.
|
||||||
|
|
@ -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>
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user