pas-fclsrc: emit element hints, type shortstring[]

git-svn-id: trunk@35851 -
This commit is contained in:
Mattias Gaertner 2017-04-19 18:38:18 +00:00
parent 9303a8f61a
commit 8376f3c126
4 changed files with 226 additions and 88 deletions

View File

@ -135,6 +135,7 @@ Works:
- nil, assigned(), typecast, class, classref, dynarray, procvar - nil, assigned(), typecast, class, classref, dynarray, procvar
ToDo: ToDo:
- test forward class in argument
- fix slow lookup declaration proc in PParser - fix slow lookup declaration proc in PParser
- fail to write a loop var inside the loop - fail to write a loop var inside the loop
- warn: create class with abstract methods - warn: create class with abstract methods
@ -256,6 +257,11 @@ const
nTypeIdentifierExpected = 3055; nTypeIdentifierExpected = 3055;
nCannotNestAnonymousX = 3056; nCannotNestAnonymousX = 3056;
nFoundCallCandidateX = 3057; nFoundCallCandidateX = 3057;
nSymbolXIsNotPortable = 3058;
nSymbolXIsExperimental = 3059;
nSymbolXIsNotImplemented = 3060;
nSymbolXBelongsToALibrary = 3061;
nSymbolXIsDeprecated = 3062;
// resourcestring patterns of messages // resourcestring patterns of messages
resourcestring resourcestring
@ -316,6 +322,11 @@ resourcestring
sTypeIdentifierExpected = 'Type identifier expected'; sTypeIdentifierExpected = 'Type identifier expected';
sCannotNestAnonymousX = 'Cannot nest anonymous %s'; sCannotNestAnonymousX = 'Cannot nest anonymous %s';
sFoundCallCandidateX = 'Found call candidate %s'; sFoundCallCandidateX = 'Found call candidate %s';
sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
sSymbolXIsExperimental = 'Symbol "%s" is experimental';
sSymbolXIsNotImplemented = 'Symbol "%s" is implemented';
sSymbolXBelongsToALibrary = 'Symbol "%s" belongs to a library';
sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
type type
TResolverBaseType = ( TResolverBaseType = (
@ -1105,7 +1116,7 @@ type
procedure FinishTypeDef(El: TPasType); virtual; procedure FinishTypeDef(El: TPasType); virtual;
procedure FinishEnumType(El: TPasEnumType); virtual; procedure FinishEnumType(El: TPasEnumType); virtual;
procedure FinishSetType(El: TPasSetType); virtual; procedure FinishSetType(El: TPasSetType); virtual;
procedure FinishSubElementType(Parent, El: TPasElement); virtual; procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
procedure FinishRangeType(El: TPasRangeType); virtual; procedure FinishRangeType(El: TPasRangeType); virtual;
procedure FinishRecordType(El: TPasRecordType); virtual; procedure FinishRecordType(El: TPasRecordType); virtual;
procedure FinishClassType(El: TPasClassType); virtual; procedure FinishClassType(El: TPasClassType); virtual;
@ -1125,6 +1136,8 @@ type
procedure FinishAncestors(aClass: TPasClassType); virtual; procedure FinishAncestors(aClass: TPasClassType); virtual;
procedure FinishPropertyParamAccess(Params: TParamsExpr; procedure FinishPropertyParamAccess(Params: TParamsExpr;
Prop: TPasProperty); Prop: TPasProperty);
procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope); procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure); procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure);
procedure CheckPendingForwards(El: TPasElement); procedure CheckPendingForwards(El: TPasElement);
@ -3153,6 +3166,8 @@ begin
writeln('TPasResolver.FinishUsesList Add UsesScope=',GetObjName(UsesScope)); writeln('TPasResolver.FinishUsesList Add UsesScope=',GetObjName(UsesScope));
{$ENDIF} {$ENDIF}
Scope.UsesList.Add(UsesScope); Scope.UsesList.Add(UsesScope);
EmitElementHints(Section,El);
end; end;
end; end;
@ -3295,11 +3310,12 @@ begin
RaiseXExpectedButYFound(20170216151557,'enum type',EnumType.ElementTypeName,EnumType); RaiseXExpectedButYFound(20170216151557,'enum type',EnumType.ElementTypeName,EnumType);
end; end;
procedure TPasResolver.FinishSubElementType(Parent, El: TPasElement); procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
var var
Decl: TPasDeclarations; Decl: TPasDeclarations;
EnumScope: TPasEnumTypeScope; EnumScope: TPasEnumTypeScope;
begin begin
EmitTypeHints(Parent,El);
if (El.Name<>'') or (AnonymousElTypePostfix='') then exit; if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
if Parent.Name='' then if Parent.Name='' then
RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El); RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
@ -3797,7 +3813,13 @@ begin
else if C=TPasProperty then else if C=TPasProperty then
FinishPropertyOfClass(TPasProperty(El)) FinishPropertyOfClass(TPasProperty(El))
else if C=TPasArgument then else if C=TPasArgument then
FinishArgument(TPasArgument(El)); FinishArgument(TPasArgument(El))
else
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
{$ENDIF}
end;
end; end;
procedure TPasResolver.FinishVariable(El: TPasVariable); procedure TPasResolver.FinishVariable(El: TPasVariable);
@ -3812,6 +3834,7 @@ begin
ResolveExpr(El.Expr,rraRead); ResolveExpr(El.Expr,rraRead);
CheckAssignCompatibility(El,El.Expr,true); CheckAssignCompatibility(El,El.Expr,true);
end; end;
EmitTypeHints(El,El.VarType);
end; end;
procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty); procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
@ -4146,6 +4169,7 @@ begin
RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl); RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
ClassScope.DefaultProperty:=PropEl; ClassScope.DefaultProperty:=PropEl;
end; end;
EmitTypeHints(PropEl,PropEl.VarType);
end; end;
procedure TPasResolver.FinishArgument(El: TPasArgument); procedure TPasResolver.FinishArgument(El: TPasArgument);
@ -4156,6 +4180,7 @@ begin
if El.ArgType<>nil then if El.ArgType<>nil then
CheckAssignCompatibility(El,El.ValueExpr,true); CheckAssignCompatibility(El,El.ValueExpr,true);
end; end;
EmitTypeHints(El,El.ArgType);
end; end;
procedure TPasResolver.FinishAncestors(aClass: TPasClassType); procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
@ -4206,7 +4231,10 @@ begin
else if AncestorType.ClassType<>TPasClassType then else if AncestorType.ClassType<>TPasClassType then
RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDesc(AncestorType),aClass) RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDesc(AncestorType),aClass)
else else
begin
AncestorEl:=TPasClassType(AncestorType); AncestorEl:=TPasClassType(AncestorType);
EmitTypeHints(aClass,AncestorEl);
end;
AncestorClassScope:=nil; AncestorClassScope:=nil;
if AncestorEl=nil then if AncestorEl=nil then
@ -4276,6 +4304,45 @@ begin
end; end;
end; end;
procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
begin
while aType<>nil do
begin
if EmitElementHints(PosEl,aType) then
exit; // give only hints for the nearest
if aType.InheritsFrom(TPasAliasType) then
aType:=TPasAliasType(aType).DestType
else if aType.ClassType=TPasPointerType then
aType:=TPasPointerType(aType).DestType
else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
and (aType.CustomData<>nil) then
aType:=TPasType((aType.CustomData as TResolvedReference).Declaration)
else
exit;
end;
end;
function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
begin
if El.Hints=[] then exit(false);
Result:=true;
if hDeprecated in El.Hints then
LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
[El.Name],PosEl);
if hLibrary in El.Hints then
LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
[El.Name],PosEl);
if hPlatform in El.Hints then
LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
[El.Name],PosEl);
if hExperimental in El.Hints then
LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
[El.Name],PosEl);
if hUnimplemented in El.Hints then
LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
[El.Name],PosEl);
end;
procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs( procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
ImplProcScope: TPasProcedureScope); ImplProcScope: TPasProcedureScope);
var var
@ -7931,6 +7998,12 @@ begin
or (AClass=TPasSetType) or (AClass=TPasSetType)
or (AClass=TPasRangeType) then or (AClass=TPasRangeType) then
AddType(TPasType(El)) AddType(TPasType(El))
else if AClass=TPasStringType then
begin
AddType(TPasType(El));
if BaseTypes[btShortString]=nil then
RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
end
else if AClass=TPasRecordType then else if AClass=TPasRecordType then
AddRecordType(TPasRecordType(El)) AddRecordType(TPasRecordType(El))
else if AClass=TPasClassType then else if AClass=TPasClassType then
@ -8583,6 +8656,7 @@ begin
Result.Declaration:=DeclEl; Result.Declaration:=DeclEl;
if RefEl is TPasExpr then if RefEl is TPasExpr then
SetResolvedRefAccess(TPasExpr(RefEl),Result,Access); SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
EmitElementHints(RefEl,DeclEl);
end; end;
function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
@ -11125,7 +11199,7 @@ begin
end end
else if ElClass=TPasClassType then else if ElClass=TPasClassType then
begin begin
if TPasClassType(El).IsForward then if TPasClassType(El).IsForward and (El.CustomData<>nil) then
begin begin
DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration; DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
ResolvedEl.TypeEl:=DeclEl as TPasClassType; ResolvedEl.TypeEl:=DeclEl as TPasClassType;
@ -11134,9 +11208,6 @@ begin
ResolvedEl.TypeEl:=TPasClassType(El); ResolvedEl.TypeEl:=TPasClassType(El);
SetResolverIdentifier(ResolvedEl,btContext, SetResolverIdentifier(ResolvedEl,btContext,
ResolvedEl.TypeEl,ResolvedEl.TypeEl,[]); ResolvedEl.TypeEl,ResolvedEl.TypeEl,[]);
//if not TPasClassType(El).IsExternal then
// Include(ResolvedEl.Flags,rrfReadable);
// Note: rrfReadable because a class has a vmt as value
end end
else if ElClass=TPasClassOfType then else if ElClass=TPasClassOfType then
SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),[]) SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),[])
@ -11187,6 +11258,12 @@ begin
SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[]) SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
else if ElClass=TArrayValues then else if ElClass=TArrayValues then
SetResolverValueExpr(ResolvedEl,btArray,nil,TArrayValues(El),[rrfReadable]) SetResolverValueExpr(ResolvedEl,btArray,nil,TArrayValues(El),[rrfReadable])
else if ElClass=TPasStringType then
begin
SetResolverTypeExpr(ResolvedEl,btShortString,BaseTypes[btShortString],[rrfReadable]);
if BaseTypes[btShortString]=nil then
RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
end
else else
RaiseNotYetImplemented(20160922163705,El); RaiseNotYetImplemented(20160922163705,El);
end; end;

View File

@ -721,7 +721,7 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
end; end;
{ TPasStringType } { TPasStringType - e.g. string[len] }
TPasStringType = class(TPasUnresolvedTypeRef) TPasStringType = class(TPasUnresolvedTypeRef)
public public

View File

@ -104,6 +104,7 @@ type
FModules: TObjectList;// list of TTestEnginePasResolver FModules: TObjectList;// list of TTestEnginePasResolver
FResolverEngine: TTestEnginePasResolver; FResolverEngine: TTestEnginePasResolver;
FResolverMsgs: TObjectList; // list of TTestResolverMessage FResolverMsgs: TObjectList; // list of TTestResolverMessage
FResolverGoodMsgs: TFPList; // list of TTestResolverMessage marked as expected
function GetModuleCount: integer; function GetModuleCount: integer;
function GetModules(Index: integer): TTestEnginePasResolver; function GetModules(Index: integer): TTestEnginePasResolver;
function GetMsgCount: integer; function GetMsgCount: integer;
@ -121,7 +122,8 @@ type
procedure ParseProgram; virtual; procedure ParseProgram; virtual;
procedure ParseUnit; virtual; procedure ParseUnit; virtual;
procedure CheckReferenceDirectives; virtual; procedure CheckReferenceDirectives; virtual;
procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string; MustHave: boolean); procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string); virtual;
procedure CheckResolverUnexpectedHints; virtual;
procedure CheckResolverException(Msg: string; MsgNumber: integer); procedure CheckResolverException(Msg: string; MsgNumber: integer);
procedure CheckParserException(Msg: string; MsgNumber: integer); procedure CheckParserException(Msg: string; MsgNumber: integer);
procedure CheckAccessMarkers; virtual; procedure CheckAccessMarkers; virtual;
@ -191,6 +193,7 @@ type
Procedure TestStringElement_IndexNonIntFail; Procedure TestStringElement_IndexNonIntFail;
Procedure TestStringElement_AsVarArgFail; Procedure TestStringElement_AsVarArgFail;
Procedure TestString_DoubleQuotesFail; Procedure TestString_DoubleQuotesFail;
Procedure TestString_ShortstringType;
// enums // enums
Procedure TestEnums; Procedure TestEnums;
@ -545,6 +548,9 @@ type
Procedure TestPointer_TypecastFromMethodTypeFail; Procedure TestPointer_TypecastFromMethodTypeFail;
Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer; Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
Procedure TestPointer_OverloadSignature; Procedure TestPointer_OverloadSignature;
// hints
Procedure TestHint_ElementHints;
end; end;
function LinesToStr(Args: array of const): string; function LinesToStr(Args: array of const): string;
@ -619,6 +625,7 @@ end;
procedure TCustomTestResolver.TearDown; procedure TCustomTestResolver.TearDown;
begin begin
FResolverMsgs.Clear; FResolverMsgs.Clear;
FResolverGoodMsgs.Clear;
{$IFDEF VerbosePasResolverMem} {$IFDEF VerbosePasResolverMem}
writeln('TTestResolver.TearDown START FreeSrcMarkers'); writeln('TTestResolver.TearDown START FreeSrcMarkers');
{$ENDIF} {$ENDIF}
@ -1098,29 +1105,24 @@ begin
end; end;
procedure TCustomTestResolver.CheckResolverHint(MsgType: TMessageType; procedure TCustomTestResolver.CheckResolverHint(MsgType: TMessageType;
MsgNumber: integer; Msg: string; MustHave: boolean); MsgNumber: integer; Msg: string);
var var
i: Integer; i: Integer;
Item: TTestResolverMessage; Item: TTestResolverMessage;
Expected,Actual: string; Expected,Actual: string;
begin begin
writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount); //writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount);
for i:=0 to MsgCount-1 do for i:=0 to MsgCount-1 do
begin begin
Item:=Msgs[i]; Item:=Msgs[i];
if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue; if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
// found // found
FResolverGoodMsgs.Add(Item);
str(Item.MsgType,Actual); str(Item.MsgType,Actual);
if not MustHave then
begin
WriteSources('',0,0);
Fail('Expected to *not* emit '+Actual+' ('+IntToStr(MsgNumber)+') {'+Msg+'}');
end;
str(MsgType,Expected); str(MsgType,Expected);
AssertEquals('MsgType',Expected,Actual); AssertEquals('MsgType',Expected,Actual);
exit; exit;
end; end;
if not MustHave then exit;
// needed message missing -> show emitted messages // needed message missing -> show emitted messages
WriteSources('',0,0); WriteSources('',0,0);
@ -1133,6 +1135,22 @@ begin
Fail('Missing '+Expected+' ('+IntToStr(MsgNumber)+') '+Msg); Fail('Missing '+Expected+' ('+IntToStr(MsgNumber)+') '+Msg);
end; end;
procedure TCustomTestResolver.CheckResolverUnexpectedHints;
var
i: Integer;
s: String;
Msg: TTestResolverMessage;
begin
for i:=0 to MsgCount-1 do
begin
Msg:=Msgs[i];
if FResolverGoodMsgs.IndexOf(Msg)>=0 then continue;
s:='';
str(Msg.MsgType,s);
Fail('Unexpected resolver message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.Msg+'}');
end;
end;
procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer); procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer);
var var
ok: Boolean; ok: Boolean;
@ -1364,11 +1382,13 @@ constructor TCustomTestResolver.Create;
begin begin
inherited Create; inherited Create;
FResolverMsgs:=TObjectList.Create(true); FResolverMsgs:=TObjectList.Create(true);
FResolverGoodMsgs:=TFPList.Create;
end; end;
destructor TCustomTestResolver.Destroy; destructor TCustomTestResolver.Destroy;
begin begin
FreeAndNil(FResolverMsgs); FreeAndNil(FResolverMsgs);
FreeAndNil(FResolverGoodMsgs);
inherited Destroy; inherited Destroy;
end; end;
@ -2140,6 +2160,19 @@ begin
CheckParserException('Invalid character ''"''',PScanner.nErrInvalidCharacter); CheckParserException('Invalid character ''"''',PScanner.nErrInvalidCharacter);
end; end;
procedure TTestResolver.TestString_ShortstringType;
begin
StartProgram(false);
Add([
'type t = string[12];',
'var',
' s: t;',
'begin',
' s:=''abc'';',
'']);
ParseProgram;
end;
procedure TTestResolver.TestEnums; procedure TTestResolver.TestEnums;
begin begin
StartProgram(false); StartProgram(false);
@ -6153,13 +6186,14 @@ begin
Add('begin'); Add('begin');
ParseProgram; ParseProgram;
CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility, CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)',true); 'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)');
CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility, CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)',true); 'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)');
CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility, CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)',true); 'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)');
CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility, CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)',true); 'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)');
CheckResolverUnexpectedHints;
end; end;
procedure TTestResolver.TestClass_Const; procedure TTestResolver.TestClass_Const;
@ -8906,6 +8940,33 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestHint_ElementHints;
begin
StartProgram(false);
Add([
'type',
' TDeprecated = longint deprecated;',
' TLibrary = longint library;',
' TPlatform = longint platform;',
' TExperimental = longint experimental;',
' TUnimplemented = longint unimplemented;',
'var',
' vDeprecated: TDeprecated;',
' vLibrary: TLibrary;',
' vPlatform: TPlatform;',
' vExperimental: TExperimental;',
' vUnimplemented: TUnimplemented;',
'begin',
'']);
ParseProgram;
CheckResolverHint(mtWarning,nSymbolXIsDeprecated,'Symbol "TDeprecated" is deprecated');
CheckResolverHint(mtWarning,nSymbolXBelongsToALibrary,'Symbol "TLibrary" belongs to a library');
CheckResolverHint(mtWarning,nSymbolXIsNotPortable,'Symbol "TPlatform" is not portable');
CheckResolverHint(mtWarning,nSymbolXIsExperimental,'Symbol "TExperimental" is experimental');
CheckResolverHint(mtWarning,nSymbolXIsNotImplemented,'Symbol "TUnimplemented" is implemented');
CheckResolverUnexpectedHints;
end;
initialization initialization
RegisterTests([TTestResolver]); RegisterTests([TTestResolver]);

View File

@ -32,9 +32,9 @@ type
procedure AnalyzeUnit; virtual; procedure AnalyzeUnit; virtual;
procedure AnalyzeWholeProgram; virtual; procedure AnalyzeWholeProgram; virtual;
procedure CheckUsedMarkers; virtual; procedure CheckUsedMarkers; virtual;
procedure CheckHasHint(MsgType: TMessageType; MsgNumber: integer; procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
const MsgText: string); virtual; const MsgText: string); virtual;
procedure CheckUnexpectedMessages; virtual; procedure CheckUseAnalyzerUnexpectedHints; virtual;
procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual; procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
public public
property Analyzer: TPasAnalyzer read FAnalyzer; property Analyzer: TPasAnalyzer read FAnalyzer;
@ -239,7 +239,7 @@ begin
end; end;
procedure TCustomTestUseAnalyzer.CheckHasHint(MsgType: TMessageType; procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
MsgNumber: integer; const MsgText: string); MsgNumber: integer; const MsgText: string);
var var
i: Integer; i: Integer;
@ -272,7 +272,7 @@ begin
Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}'); Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
end; end;
procedure TCustomTestUseAnalyzer.CheckUnexpectedMessages; procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
var var
i: Integer; i: Integer;
Msg: TPAMessage; Msg: TPAMessage;
@ -284,7 +284,7 @@ begin
if FPAGoodMessages.IndexOf(Msg)>=0 then continue; if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
s:=''; s:='';
str(Msg.MsgType,s); str(Msg.MsgType,s);
Fail('Analyzer Message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}'); Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
end; end;
end; end;
@ -851,8 +851,8 @@ begin
Add('uses unit2;'); Add('uses unit2;');
Add('begin'); Add('begin');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile'); CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal; procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
@ -873,7 +873,7 @@ begin
AnalyzeProgram; AnalyzeProgram;
// unit hints: no hint, even though no code is actually used // unit hints: no hint, even though no code is actually used
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed; procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
@ -884,8 +884,8 @@ begin
Add('begin'); Add('begin');
Add(' DoIt(1);'); Add(' DoIt(1);');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used'); CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract; procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
@ -898,7 +898,7 @@ begin
Add('begin'); Add('begin');
Add(' TObject.DoIt(3);'); Add(' TObject.DoIt(3);');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast; procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
@ -919,7 +919,7 @@ begin
Add('begin'); Add('begin');
Add(' DoIt(nil);'); Add(' DoIt(nil);');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
@ -936,11 +936,11 @@ begin
Add('begin'); Add('begin');
Add(' DoIt;'); Add(' DoIt;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed; procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
@ -965,14 +965,14 @@ begin
Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;'); Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;'); Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
AnalyzeUnit; AnalyzeUnit;
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@ -985,9 +985,9 @@ begin
Add('begin'); Add('begin');
Add(' DoIt(1);'); Add(' DoIt(1);');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
'Value parameter "i" is assigned but never used'); 'Value parameter "i" is assigned but never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
@ -1007,13 +1007,13 @@ begin
Add('begin'); Add('begin');
Add(' DoIt;'); Add(' DoIt;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "a" is assigned but never used'); 'Local variable "a" is assigned but never used');
CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "b" is assigned but never used'); 'Local variable "b" is assigned but never used');
CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "c" is assigned but never used'); 'Local variable "c" is assigned but never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
@ -1031,12 +1031,12 @@ begin
Add('begin'); Add('begin');
Add(' DoIt;'); Add(' DoIt;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
@ -1051,11 +1051,11 @@ begin
Add('begin'); Add('begin');
Add(' m:=nil;'); Add(' m:=nil;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
'Private field "TMobile.a" is never used'); 'Private field "TMobile.a" is never used');
CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "m" is assigned but never used'); 'Local variable "m" is assigned but never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
@ -1075,9 +1075,9 @@ begin
Add('begin'); Add('begin');
Add(' TMobile.Create;'); Add(' TMobile.Create;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
'Private field "TMobile.a" is assigned but never used'); 'Private field "TMobile.a" is assigned but never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
@ -1096,9 +1096,9 @@ begin
Add('begin'); Add('begin');
Add(' TMobile.Create;'); Add(' TMobile.Create;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivateMethodIsNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
'Private method "TMobile.DoSome" is never used'); 'Private method "TMobile.DoSome" is never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
@ -1125,7 +1125,7 @@ begin
Add(' o:=TMobile.Create;'); Add(' o:=TMobile.Create;');
Add(' o.Destroy;'); Add(' o.Destroy;');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
@ -1144,9 +1144,9 @@ begin
Add('begin'); Add('begin');
Add(' TMobile.Create;'); Add(' TMobile.Create;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivateTypeXNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
'Private type "TMobile.t" never used'); 'Private type "TMobile.t" never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
@ -1165,9 +1165,9 @@ begin
Add('begin'); Add('begin');
Add(' TMobile.Create;'); Add(' TMobile.Create;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivateConstXNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
'Private const "TMobile.c" never used'); 'Private const "TMobile.c" never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
@ -1187,11 +1187,11 @@ begin
Add('begin'); Add('begin');
Add(' TMobile.Create;'); Add(' TMobile.Create;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAPrivatePropertyXNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
'Private property "TMobile.A" never used'); 'Private property "TMobile.A" never used');
CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed, CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
'Private field "TMobile.FA" is never used'); 'Private field "TMobile.FA" is never used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
@ -1209,9 +1209,9 @@ begin
Add(' m: TMobile;'); Add(' m: TMobile;');
Add('begin'); Add('begin');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed; procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
@ -1230,8 +1230,8 @@ begin
Add('begin'); Add('begin');
Add(' if m=nil then ;'); Add(' if m=nil then ;');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used'); CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored; procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
@ -1254,7 +1254,7 @@ begin
Add('begin'); Add('begin');
Add(' DoIt(1);'); Add(' DoIt(1);');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
@ -1265,9 +1265,9 @@ begin
Add('begin'); Add('begin');
Add(' DoIt();'); Add(' DoIt();');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet, CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
sPAFunctionResultDoesNotSeemToBeSet); sPAFunctionResultDoesNotSeemToBeSet);
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
@ -1280,7 +1280,7 @@ begin
Add('begin'); Add('begin');
Add(' TObject.DoIt;'); Add(' TObject.DoIt;');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
@ -1295,10 +1295,10 @@ begin
Add('begin'); Add('begin');
Add(' Point(1);'); Add(' Point(1);');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "X" is assigned but never used'); 'Local variable "X" is assigned but never used');
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
@ -1317,8 +1317,8 @@ begin
Add('begin'); Add('begin');
Add(' Point();'); Add(' Point();');
AnalyzeProgram; AnalyzeProgram;
CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used'); CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed; procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
@ -1332,7 +1332,7 @@ begin
Add('begin'); Add('begin');
Add(' DoIt(i);'); Add(' DoIt(i);');
AnalyzeProgram; AnalyzeProgram;
CheckUnexpectedMessages; CheckUseAnalyzerUnexpectedHints;
end; end;
procedure TTestUseAnalyzer.TestWP_LocalVar; procedure TTestUseAnalyzer.TestWP_LocalVar;