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

fcl-passrc: pasuseanalyzer: inherited; without params

Browse Source 
git-svn-id: trunk@37569 -
This commit is contained in:
Mattias Gaertner 2017-11-07 16:54:40 +00:00
parent 4bbbf75d32
commit efb0730436
2 changed files with 101 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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