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

git-svn-id: trunk@37980 -

packages/fcl-passrc/src/pasresolver.pp

@@ -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

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -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;

packages/fcl-passrc/tests/tcresolver.pas

@@ -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;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -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);