fcl-passrc: pasuseanalyzer: inherited; without params

git-svn-id: trunk@37569 -

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -198,6 +198,7 @@ type
     procedure UseExpr(El: TPasExpr); virtual;
     procedure UseExprRef(Expr: TPasExpr; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
+    procedure UseInheritedExpr(El: TInheritedExpr); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
@@ -982,7 +983,7 @@ var
   Decl: TPasElement;
 begin
   if El=nil then exit;
-  // expressions are not marked
+  // Note: expression itself is not marked, but it can reference identifiers
 
   Ref:=nil;
   if El.CustomData is TResolvedReference then
@@ -1043,7 +1044,6 @@ begin
   if (C=TPrimitiveExpr)
       or (C=TSelfExpr)
       or (C=TBoolConstExpr)
-      or (C=TInheritedExpr)
       or (C=TNilExpr) then
   else if C=TBinaryExpr then
     begin
@@ -1065,6 +1065,8 @@ begin
     for i:=0 to length(Params)-1 do
       UseExpr(Params[i]);
     end
+  else if C=TInheritedExpr then
+    UseInheritedExpr(TInheritedExpr(El))
   else
     RaiseNotSupported(20170307085444,El);
 end;
@@ -1128,6 +1130,42 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseInheritedExpr(El: TInheritedExpr);
+var
+  P: TPasElement;
+  ProcScope: TPasProcedureScope;
+  Proc: TPasProcedure;
+  Args: TFPList;
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  if (El.Parent.ClassType=TBinaryExpr)
+  and (TBinaryExpr(El.Parent).OpCode=eopNone) then
+    // 'inherited Proc...;'
+    exit;
+  // 'inherited;'
+  P:=El.Parent;
+  while not P.InheritsFrom(TPasProcedure) do
+    P:=P.Parent;
+  ProcScope:=TPasProcedure(P).CustomData as TPasProcedureScope;
+  if ProcScope.DeclarationProc<>nil then
+    Proc:=ProcScope.DeclarationProc
+  else
+    Proc:=TPasProcedure(P);
+  Args:=Proc.ProcType.Args;
+  for i:=0 to Args.Count-1 do
+    begin
+    Arg:=TPasArgument(Args[i]);
+    case Arg.Access of
+    argDefault,argConst,argConstRef: UseArgument(Arg,rraRead);
+    argVar: UseArgument(Arg,rraVarParam);
+    argOut: UseArgument(Arg,rraOutParam);
+    else
+      RaiseNotSupported(20171107175406,Arg);
+    end;
+    end;
+end;
+
 procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
 
   procedure UseOverrides(CurProc: TPasProcedure);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -82,6 +82,9 @@ type
     procedure TestM_Hint_ParameterNotUsed;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsedTypecast;
+    procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
+    procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
+    procedure TestM_Hint_InheritedWithoutParams;
     procedure TestM_Hint_LocalVariableNotUsed;
     procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
@@ -105,8 +108,6 @@ type
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
-    procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
-    procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
 
     // whole program optimization
     procedure TestWP_LocalVar;
@@ -1000,6 +1001,64 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(out x: longint);');
+  Add('begin');
+  Add('  x:=3;');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  DoIt(i);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure AssertTrue(b: boolean);',
+  'begin',
+  '  if b then ;',
+  'end;',
+  'procedure AssertFalse(b: boolean);',
+  'begin',
+  '  AssertTrue(not b);',
+  'end;',
+  'begin',
+  '  AssertFalse(true);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_InheritedWithoutParams;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create(i: longint); virtual;',
+  '  end;',
+  '  TBird = class',
+  '    constructor Create(i: longint); override;',
+  '  end;',
+  'constructor TObject.Create(i: longint);',
+  'begin',
+  '  if i=0 then ;',
+  'end;',
+  'constructor TBird.Create(i: longint);',
+  'begin',
+  '  inherited;',
+  'end;',
+  'begin',
+  '  TBird.Create(3);']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
 begin
   StartProgram(true);
@@ -1476,39 +1535,6 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
-procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
-begin
-  StartProgram(true);
-  Add('procedure DoIt(out x: longint);');
-  Add('begin');
-  Add('  x:=3;');
-  Add('end;');
-  Add('var i: longint;');
-  Add('begin');
-  Add('  DoIt(i);');
-  AnalyzeProgram;
-  CheckUseAnalyzerUnexpectedHints;
-end;
-
-procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
-begin
-  StartProgram(false);
-  Add([
-  'procedure AssertTrue(b: boolean);',
-  'begin',
-  '  if b then ;',
-  'end;',
-  'procedure AssertFalse(b: boolean);',
-  'begin',
-  '  AssertTrue(not b);',
-  'end;',
-  'begin',
-  '  AssertFalse(true);',
-  '']);
-  AnalyzeProgram;
-  CheckUseAnalyzerUnexpectedHints;
-end;
-
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 begin
   StartProgram(false);