fcl-passrc: useanalyzer: new msg id for parameter of a virtual method not used

git-svn-id: trunk@39301 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1702,6 +1702,7 @@ type
     function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
     function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
     function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
+    function GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
     function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
     function GetPasPropertyType(El: TPasProperty): TPasType;
     function GetPasPropertyArgs(El: TPasProperty): TFPList;
@@ -4013,6 +4014,7 @@ var
   Data: PFindOverloadProcData absolute FindOverloadData;
   Proc: TPasProcedure;
   Store, SameScope: Boolean;
+  ProcScope: TPasProcedureScope;
 
   procedure CountProcInSameModule;
   begin
@@ -4142,8 +4144,8 @@ begin
             or ((Data^.FoundInSameScope=1) // missing 'overload' hints only for the first proc in a scope
                and not ProcHasGroupOverload(Data^.Proc)) then
           begin
-          // give a hint, that proc is hiding a proc in other scope
           if (Data^.Kind=fopkMethod) and (Proc.IsVirtual or Proc.IsOverride) then
+            // give a hint, that method hides a virtual method in ancestor
             LogMsg(20170216151712,mtWarning,nMethodHidesMethodOfBaseType,
               sMethodHidesMethodOfBaseType,
               [Data^.Proc.Name,Proc.Parent.Name,GetElementSourcePosStr(Proc)],Data^.Proc.ProcType)
@@ -4151,10 +4153,19 @@ begin
             begin
             // Delphi/FPC do not give a message when hiding a non virtual method
             // -> emit Hint with other message id
-            if Data^.Proc.Parent is TPasClassType then
-              LogMsg(20171118214523,mtHint,
-                nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
-                [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+            if (Data^.Proc.Parent is TPasClassType) then
+              begin
+              ProcScope:=Proc.CustomData as TPasProcedureScope;
+              if (ProcScope.ImplProc<>nil)  // not abstract, external
+                  and (GetProcFirstImplEl(ProcScope.ImplProc)=nil) then
+                // hidden method has implementation, but no statements -> useless
+                // -> do not give a hint for hiding this useless method
+                // Note: if this happens in the same unit, the body was not yet parsed
+              else
+                LogMsg(20171118214523,mtHint,
+                  nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
+                  [GetElementSourcePosStr(Proc)],Data^.Proc.ProcType);
+              end;
             end;
           Abort:=true;
           end;
@@ -17198,6 +17209,29 @@ begin
     Result:=BaseTypeNames[R.BaseType];
 end;
 
+function TPasResolver.GetProcFirstImplEl(Proc: TPasProcedure): TPasImplElement;
+var
+  Scope: TPasProcedureScope;
+  Body: TPasImplBlock;
+begin
+  Result:=nil;
+  if Proc=nil then exit;
+  if Proc.Body<>nil then
+    Body:=Proc.Body.Body;
+  if Body=nil then
+    begin
+    if Proc.CustomData=nil then exit;
+    Scope:=Proc.CustomData as TPasProcedureScope;
+    if Scope.ImplProc=nil then exit;
+    Proc:=Scope.ImplProc;
+    if Proc.Body<>nil then
+      Body:=Proc.Body.Body;
+    if Body=nil then exit;
+    end;
+  if Body.Elements.Count=0 then exit;
+  Result:=TPasImplElement(Body.Elements[0]);
+end;
+
 function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
   WithRedeclarations: boolean): TPasProperty;
 begin

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -48,7 +48,10 @@ uses
   PasTree, PScanner, PasResolveEval, PasResolver;
 
 const
-  // use same IDs as fpc
+  // non fpc hints
+  nPAParameterInOverrideNotUsed = 4501;
+  sPAParameterInOverrideNotUsed = 'Parameter "%s" not used';
+  // fpc hints: use same IDs as fpc
   nPAUnitNotUsed = 5023;
   sPAUnitNotUsed = 'Unit "%s" not used in %s';
   nPAParameterNotUsed = 5024;
@@ -2253,9 +2256,16 @@ begin
       Arg:=TPasArgument(Args[i]);
       Usage:=FindPAElement(Arg);
       if (Usage=nil) or (Usage.Access=paiaNone) then
+        begin
         // parameter was never used
-        EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
-          sPAParameterNotUsed,[Arg.Name],Arg)
+        if (Arg.Parent is TPasProcedureType) and (Arg.Parent.Parent is TPasProcedure)
+            and ([pmVirtual,pmOverride]*TPasProcedure(Arg.Parent.Parent).Modifiers<>[]) then
+          EmitMessage(20180625153623,mtHint,nPAParameterInOverrideNotUsed,
+            sPAParameterInOverrideNotUsed,[Arg.Name],Arg)
+        else
+          EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
+            sPAParameterNotUsed,[Arg.Name],Arg);
+        end
       else
         begin
         // parameter was used
@@ -2522,7 +2532,7 @@ begin
     exit;
     end;
   {$IFDEF VerbosePasAnalyzer}
-  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText,' ScopeModule=',GetObjName(ScopeModule));
+  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') "',Msg.MsgText,'" at ',Resolver.GetElementSourcePosStr(Msg.PosEl),' ScopeModule=',GetObjName(ScopeModule));
   {$ENDIF}
   try
     OnMessage(Self,Msg);

packages/fcl-passrc/src/pparser.pp

@@ -264,7 +264,9 @@ type
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
     function GetCurrentModeSwitches: TModeSwitches;
     Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
-    function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr; ExternalClass : Boolean): string;
+    function GetVariableModifiers(Parent: TPasElement;
+      Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr;
+      const AllowedMods: TVariableModifiers): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value: TPasExpr; Out AbsoluteExpr: TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
     procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier);
@@ -4063,7 +4065,7 @@ end;
 
 function TPasParser.GetVariableModifiers(Parent: TPasElement; out
   VarMods: TVariableModifiers; out LibName, ExportName: TPasExpr;
-  ExternalClass: Boolean): string;
+  const AllowedMods: TVariableModifiers): string;
 
 Var
   S : String;
@@ -4074,7 +4076,7 @@ begin
   ExportName := nil;
   VarMods := [];
   NextToken;
-  If CurTokenIsIdentifier('cvar') and not ExternalClass then
+  If (vmCVar in AllowedMods) and CurTokenIsIdentifier('cvar') then
     begin
     Result:=';cvar';
     Include(VarMods,vmcvar);
@@ -4082,11 +4084,11 @@ begin
     NextToken;
     end;
   s:=LowerCase(CurTokenText);
-  if s='external' then
+  if (vmExternal in AllowedMods) and (s='external') then
     ExtMod:=vmExternal
-  else if (s='public') and not ExternalClass then
+  else if (vmPublic in AllowedMods) and (s='public') then
     ExtMod:=vmPublic
-  else if (s='export') and not ExternalClass then
+  else if (vmExport in AllowedMods) and (s='export') then
     ExtMod:=vmExport
   else
     begin
@@ -4111,7 +4113,7 @@ begin
   // external libname name exportname;
   // external name exportname;
   if (ExtMod=vmExternal) and (CurToken in [tkString,tkIdentifier])
-      and Not (CurTokenIsIdentifier('name')) and not ExternalClass then
+      and Not (CurTokenIsIdentifier('name')) then
     begin
     Result := Result + ' ' + CurTokenText;
     LibName:=DoParseExpression(Parent);
@@ -4137,9 +4139,9 @@ var
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
-  VarMods: TVariableModifiers;
+  VarMods, AllowedVarMods: TVariableModifiers;
   D,Mods,AbsoluteLocString: string;
-  OldForceCaret,ok,ExternalClass: Boolean;
+  OldForceCaret,ok,ExternalStruct: Boolean;
 
 begin
   Value:=Nil;
@@ -4195,17 +4197,22 @@ begin
     Value:=nil;
 
     // Note: external members are allowed for non external classes too
-    ExternalClass:=(msExternalClass in CurrentModeSwitches)
+    ExternalStruct:=(msExternalClass in CurrentModeSwitches)
                     and (Parent is TPasClassType);
 
     H:=H+CheckHint(Nil,False);
-    if Full or Externalclass then
+    if Full or ExternalStruct then
       begin
       NextToken;
       If Curtoken<>tkSemicolon then
         UnGetToken;
       VarEl:=TPasVariable(VarList[0]);
-      Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,ExternalClass);
+      AllowedVarMods:=[];
+      if ExternalStruct then
+        AllowedVarMods:=[vmExternal]
+      else
+        AllowedVarMods:=[vmCVar,vmExternal,vmPublic,vmExport];
+      Mods:=GetVariableModifiers(VarEl,VarMods,aLibName,aExpName,AllowedVarMods);
       if (mods='') and (CurToken<>tkSemicolon) then
         NextToken;
       end
@@ -4573,7 +4580,7 @@ begin
     else
       begin
       AddModifier;
-      NextToken;  // Should be export name string.
+      NextToken;  // Should be "public name string".
       if not (CurToken in [tkString,tkIdentifier]) then
         ParseExcTokenError(TokenInfos[tkString]);
       E:=DoParseExpression(Parent);

packages/fcl-passrc/tests/tcresolver.pas

@@ -454,6 +454,7 @@ type
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_Variant;
+    Procedure TestRecord_VarExternal; // ToDo
 
     // class
     Procedure TestClass;
@@ -489,7 +490,8 @@ type
     Procedure TestClass_MethodOverloadMissingInDelphi;
     Procedure TestClass_MethodOverloadAncestor;
     Procedure TestClass_MethodOverloadUnit;
-    Procedure TestClass_MethodOverloadNonVirtualInfo;
+    Procedure TestClass_HintMethodHidesNonVirtualMethod;
+    Procedure TestClass_HintMethodHidesNonVirtualMethodWithoutBody_NoHint;
     Procedure TestClass_MethodReintroduce;
     Procedure TestClass_MethodOverloadArrayOfTClass;
     Procedure TestClass_ConstructorHidesAncestorWarning;
@@ -7198,6 +7200,19 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecord_VarExternal;
+begin
+  exit;
+  StartProgram(false);
+  Add([
+  'type',
+  '  TRec = record',
+  '    Id: longint external name ''$Id'';',
+  '  end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 begin
   StartProgram(false);
@@ -7840,7 +7855,7 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
-procedure TTestResolver.TestClass_MethodOverloadNonVirtualInfo;
+procedure TTestResolver.TestClass_HintMethodHidesNonVirtualMethod;
 begin
   StartProgram(false);
   Add([
@@ -7851,7 +7866,10 @@ begin
   '  TBird = class',
   '    procedure DoIt(i: longint);',
   '  end;',
-  'procedure TObject.DoIt(p: pointer); begin end;',
+  'procedure TObject.DoIt(p: pointer);',
+  'begin',
+  '  if p=nil then ;',
+  'end;',
   'procedure TBird.DoIt(i: longint); begin end;',
   'var b: TBird;',
   'begin',
@@ -7861,6 +7879,38 @@ begin
    'function hides identifier at "afile.pp(4,19)". Use overload or reintroduce');
 end;
 
+procedure TTestResolver.
+  TestClass_HintMethodHidesNonVirtualMethodWithoutBody_NoHint;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    procedure DoIt(p: pointer);',
+    '  end;',
+    '']),
+    LinesToStr([
+    'procedure TObject.DoIt(p: pointer);',
+    'begin',
+    'end;',
+    '']) );
+
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'type',
+  '  TBird = class',
+  '    procedure DoIt(i: longint);',
+  '  end;',
+  'procedure TBird.DoIt(i: longint); begin end;',
+  'var b: TBird;',
+  'begin',
+  '  b.DoIt(3);']);
+  ParseProgram;
+  CheckResolverUnexpectedHints(true);
+end;
+
 procedure TTestResolver.TestClass_MethodReintroduce;
 begin
   StartProgram(false);
@@ -8623,6 +8673,7 @@ begin
   Add('  if o.vpublic=12 then ;');
   Add('  if o.vautomated=13 then ;');
   Add('  if o.vpublished=14 then ;');
+  ParseProgram;
 end;
 
 procedure TTestResolver.TestClass_PrivateInMainBeginFail;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -91,6 +91,7 @@ type
     procedure TestM_Hint_UnitUsed;
     procedure TestM_Hint_UnitUsedVarArgs;
     procedure TestM_Hint_ParameterNotUsed;
+    procedure TestM_Hint_ParameterInOverrideNotUsed;
     procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsedTypecast;
@@ -1393,6 +1394,32 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_ParameterInOverrideNotUsed;
+begin
+  StartProgram(true);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure DoIt(i: longint); virtual;',
+  '  end;',
+  '  TBird = class',
+  '    procedure DoIt(j: longint); override;',
+  '  end;',
+  'procedure TObject.DoIt(i: longint);',
+  'begin',
+  'end;',
+  'procedure TBird.DoIt(j: longint);',
+  'begin',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  TObject(b).DoIt(1);']);
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "i" not used');
+  CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "j" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
 begin
   StartUnit(false);