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

fcl-passrc: analyzer: check $hints on/off at end of proc

Browse Source 
git-svn-id: trunk@37980 -
This commit is contained in:
Mattias Gaertner 2018-01-15 23:23:38 +00:00
parent 8d52be0d10
commit 204d381337
4 changed files with 114 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
packages/fcl-passrc/src/pasresolver.pp
View File

@ -633,6 +633,14 @@ type
end;
TPasClassScopeClass = class of TPasClassScope;
TPasProcedureScopeFlag = (
ppsfHints, // $Hints on for analyzer (runs at end of module, so have to safe Scanner flags)
ppsfNotes, // $Notes on for analyzer
ppsfWarnings, // $Warnings on for analyzer
ppsfIsGroupOverload // mode objfpc: one overload is enough for all procs in same scope
);
TPasProcedureScopeFlags = set of TPasProcedureScopeFlag;
{ TPasProcedureScope }
TPasProcedureScope = Class(TPasIdentifierScope)
@ -642,8 +650,8 @@ type
OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
ClassScope: TPasClassScope;
SelfArg: TPasArgument;
IsGroupOverload: boolean; // mode objfpc: one overload is enough for all procs in same scope
Mode: TModeSwitch;
Flags: TPasProcedureScopeFlags;
function FindIdentifier(const Identifier: String): TPasIdentifier; override;
procedure IterateElements(const aName: string; StartScope: TPasScope;
const OnIterateElement: TIterateScopeElement; Data: Pointer;
@ -1120,6 +1128,7 @@ type
procedure FinishCallArgAccess(Expr: TPasExpr; Access: TResolvedRefAccess);
procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
procedure StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure; CheckNames: boolean);
@ -1823,7 +1832,8 @@ begin
if Proc.IsOverload then
exit(true);
Data:=Proc.CustomData;
Result:=(Data is TPasProcedureScope) and TPasProcedureScope(Data).IsGroupOverload;
Result:=(Data is TPasProcedureScope)
and (ppsfIsGroupOverload in TPasProcedureScope(Data).Flags);
end;
function ChompDottedIdentifier(const Identifier: string): string;
@ -3225,9 +3235,9 @@ begin
if (msObjfpc in CurrentParser.CurrentModeswitches) then
begin
if ProcHasGroupOverload(Data^.Proc) then
TPasProcedureScope(Proc.CustomData).IsGroupOverload:=true
Include(TPasProcedureScope(Proc.CustomData).Flags,ppsfIsGroupOverload)
else if ProcHasGroupOverload(Proc) then
TPasProcedureScope(Data^.Proc.CustomData).IsGroupOverload:=true;
Include(TPasProcedureScope(Data^.Proc.CustomData).Flags,ppsfIsGroupOverload);
end;
if Store then
begin
@ -3912,17 +3922,20 @@ var
i: Integer;
Body: TProcedureBody;
SubEl: TPasElement;
SubProcScope: TPasProcedureScope;
SubProcScope, ProcScope: TPasProcedureScope;
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.FinishProcedure START');
{$ENDIF}
CheckTopScope(FScopeClass_Proc);
if TPasProcedureScope(TopScope).Element<>aProc then
ProcScope:=TPasProcedureScope(TopScope);
if ProcScope.Element<>aProc then
RaiseInternalError(20170220163043);
Body:=aProc.Body;
if Body<>nil then
begin
StoreScannerFlagsInProc(ProcScope);
if Body.Body is TPasImplAsmStatement then
aProc.Modifiers:=aProc.Modifiers+[pmAssembler];
ResolveImplBlock(Body.Body);
@ -4070,7 +4083,6 @@ begin
end;
// finish interface/implementation/nested procedure
//writeln('TPasResolver.FinishProcedureType FindForward1 ',ProcName,' IsOverload=',Proc.IsOverload,' IsForward=',Proc.IsForward,' ArgCnt=',Proc.ProcType.Args.Count,' ProcNeedsBody=',ProcNeedsBody(Proc));
if ProcNeedsBody(Proc) then
begin
// check if there is a forward declaration
@ -4100,6 +4112,13 @@ begin
ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
exit;
end;
end
else
begin
// forward declaration
ProcScope:=Proc.CustomData as TPasProcedureScope;
// ToDo: store the scanner flags *before* it has parsed the token after the proc
StoreScannerFlagsInProc(ProcScope);
end;
// check for invalid overloads
@ -4143,7 +4162,7 @@ procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
SetLength(A,length(A)-Count);
end;
procedure Insert(Item: TPasProcedure; A: TArrayOfPasProcedure; Index: integer); overload;
procedure Insert(Item: TPasProcedure; var A: TArrayOfPasProcedure; Index: integer); overload;
var
i: Integer;
begin
@ -4168,6 +4187,8 @@ var
begin
Proc.ProcType.IsOfObject:=true;
ProcScope:=TopScope as TPasProcedureScope;
// ToDo: store the scanner flags *before* it has parsed the token after the proc
StoreScannerFlagsInProc(ProcScope);
ClassScope:=Scopes[ScopeCount-2] as TPasClassScope;
ProcScope.ClassScope:=ClassScope;
FindData:=Default(TFindOverloadProcData);
@ -5131,6 +5152,19 @@ begin
[El.Name],PosEl);
end;
procedure TPasResolver.StoreScannerFlagsInProc(ProcScope: TPasProcedureScope);
var
ScanBools: TBoolSwitches;
begin
ScanBools:=CurrentParser.Scanner.CurrentBoolSwitches;
if bsHints in ScanBools then
Include(ProcScope.Flags,ppsfHints);
if bsNotes in ScanBools then
Include(ProcScope.Flags,ppsfNotes);
if bsWarnings in ScanBools then
Include(ProcScope.Flags,ppsfWarnings);
end;
procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
ImplProcScope: TPasProcedureScope);
var

22
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -2034,10 +2034,32 @@ procedure TPasAnalyzer.EmitMessage(const Id: int64;
const Args: array of const; PosEl: TPasElement);
var
Msg: TPAMessage;
El: TPasElement;
ProcScope: TPasProcedureScope;
begin
{$IFDEF VerbosePasAnalyzer}
//writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
{$ENDIF}
if MsgType in [mtHint,mtNote,mtWarning] then
begin
El:=PosEl;
while El<>nil do
begin
if El is TPasProcedure then
begin
ProcScope:=El.CustomData as TPasProcedureScope;
if ProcScope.ImplProc<>nil then
ProcScope:=ProcScope.ImplProc.CustomData as TPasProcedureScope;
case MsgType of
mtHint: if not (ppsfHints in ProcScope.Flags) then exit;
mtNote: if not (ppsfNotes in ProcScope.Flags) then exit;
mtWarning: if not (ppsfWarnings in ProcScope.Flags) then exit;
end;
break;
end;
El:=El.Parent;
end;
end;
Msg:=TPAMessage.Create;
Msg.Id:=Id;
Msg.MsgType:=MsgType;

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

@ -1949,7 +1949,7 @@ begin
aScanner.LastMsgType:=mtError;
aScanner.LastMsg:='unknown directive "'+Directive+'"';
aScanner.LastMsgPattern:=aScanner.LastMsg;
aScanner.LastMsgArgs:=[];
aScanner.LastMsgArgs:=nil;
raise EScannerError.Create(aScanner.LastMsg);
if Param='' then ;
end;

65
packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

@ -80,6 +80,7 @@ type
procedure TestM_Hint_UnitNotUsed;
procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
procedure TestM_Hint_ParameterNotUsed;
procedure TestM_HintsOff_ParameterNotUsed;
procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
procedure TestM_Hint_ParameterNotUsed_Abstract;
procedure TestM_Hint_ParameterNotUsedTypecast;
@ -87,6 +88,7 @@ type
procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
procedure TestM_Hint_InheritedWithoutParams;
procedure TestM_Hint_LocalVariableNotUsed;
procedure TestM_HintsOff_LocalVariableNotUsed;
procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
procedure TestM_Hint_InterfaceUnitVariableUsed;
procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
@ -969,16 +971,25 @@ begin
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_HintsOff_ParameterNotUsed;
begin
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
begin
StartProgram(true);
StartUnit(false);
Add([
'procedure DoIt(var i: longint);',
'begin i:=3; end;',
'var v: longint;',
'interface',
'procedure DoIt(i: longint);',
'implementation',
'procedure DoIt(i: longint);',
'begin',
' DoIt(v);']);
AnalyzeProgram;
'{$Hints off}',
'end;',
'begin',
' DoIt(3);']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
@ -1077,16 +1088,18 @@ end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
begin
StartProgram(true);
Add('procedure DoIt;');
Add('const');
Add(' a = 13;');
Add(' b: longint = 14;');
Add('var');
Add(' c: char;');
Add(' d: longint = 15;');
Add('begin end;');
Add('begin');
Add(' DoIt;');
Add([
'procedure DoIt;',
'const',
' a = 13;',
' b: longint = 14;',
'var',
' c: char;',
' d: longint = 15;',
'begin',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
@ -1095,6 +1108,26 @@ begin
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_HintsOff_LocalVariableNotUsed;
begin
StartProgram(true);
Add([
'procedure DoIt;',
'const',
' a = 13;',
' b: longint = 14;',
'var',
' c: char;',
' d: longint = 15;',
'begin',
'{$Hints off}',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
begin
StartProgram(false);