paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 09:50:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed warnings/hints

Browse Source 
git-svn-id: trunk@22130 -
This commit is contained in:
michael 2012-08-19 16:40:52 +00:00
parent 42391199af
commit a665785b93
7 changed files with 63 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
packages/fcl-passrc/tests/tcbaseparser.pas
View File

@ -5,7 +5,7 @@ unit tcbaseparser;
interface
uses
Classes, SysUtils, fpcunit, testutils, pastree, pscanner, pparser, testregistry;
Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
Type
{ TTestEngine }
@ -65,6 +65,9 @@ Type
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: 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);
Property Resolver : TStreamResolver Read FResolver;
Property Scanner : TPascalScanner Read FScanner;
@ -309,28 +312,28 @@ Var
E: TPasExportSymbol;
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
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]);
AssertEquals('Correct export symbol name',AName,E.Name);
AssertEquals(Msg+'Correct export symbol name',AName,E.Name);
if (AExportName='') then
AssertNull('No export name',E.ExportName)
AssertNull(Msg+'No export name',E.ExportName)
else
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;
If AExportIndex=-1 then
AssertNull('No export name',E.ExportIndex)
AssertNull(Msg+'No export name',E.ExportIndex)
else
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;
@ -378,6 +381,7 @@ procedure TTestParser.AssertEquals(const Msg: String; AExpected,
M : TVariableModifier;
begin
Result:='';
For M:=Low(TVariableModifier) to High(TVariableModifier) do
if M in S then
begin
@ -391,6 +395,41 @@ begin
AssertEquals(Msg,Sn(AExpected),Sn(AActual));
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);
begin
If not (AHint in AHints) then

2
packages/fcl-passrc/tests/tcmoduleparser.pas
View File

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

3
packages/fcl-passrc/tests/tconstparser.pas
View File

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

2
packages/fcl-passrc/tests/tcscanner.pas
View File

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

17
packages/fcl-passrc/tests/tcstatements.pas
View File

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

4
packages/fcl-passrc/tests/tctypeparser.pas
View File

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

2
packages/fcl-passrc/tests/tcvarparser.pas
View File

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