From 4775c6d51745e5e4e963b8042e2dae3bb00a4c28 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sat, 15 Apr 2017 21:10:54 +0000 Subject: [PATCH] fcl-passrc: analyzer: fixed marking method override git-svn-id: trunk@35806 - --- packages/fcl-passrc/src/pasresolver.pp | 21 +-- packages/fcl-passrc/src/pasuseanalyzer.pas | 13 +- packages/fcl-passrc/tests/tcresolver.pas | 14 ++ packages/fcl-passrc/tests/tcuseanalyzer.pas | 136 ++++++++++++++------ 4 files changed, 137 insertions(+), 47 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 061bbed9a6..c181c8da42 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -8745,7 +8745,10 @@ begin if GotType.BaseType<>ExpType.BaseType then begin GotDesc:=GetBaseDecs(GotType); - ExpDesc:=GetBaseDecs(ExpType); + if ExpType.BaseType=btNil then + ExpDesc:=BaseTypeNames[btPointer] + else + ExpDesc:=GetBaseDecs(ExpType); if GotDesc=ExpDesc then begin GotDesc:=GetBaseDecs(GotType,true); @@ -9472,10 +9475,10 @@ begin or (TypeEl is TPasProcedureType) or IsDynArray(TypeEl) then exit(cExact); - end - else if RaiseOnIncompatible then - RaiseMsg(20170216152442,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected, - [BaseTypeNames[RHS.BaseType],BaseTypeNames[LHS.BaseType]],LErrorEl) + end; + if RaiseOnIncompatible then + RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected, + [],RHS,LHS,RErrorEl) else exit(cIncompatible); end @@ -9492,10 +9495,10 @@ begin or (TypeEl is TPasProcedureType) or IsDynArray(TypeEl) then exit(cExact); - end - else if RaiseOnIncompatible then - RaiseMsg(20170216152444,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected, - [BaseTypeNames[LHS.BaseType],BaseTypeNames[RHS.BaseType]],LErrorEl) + end; + if RaiseOnIncompatible then + RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected, + [],LHS,RHS,LErrorEl) else exit(cIncompatible); end diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index 2b10b000b3..b7fe8cd305 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -1135,7 +1135,7 @@ begin if ImplProc.Body<>nil then UseImplBlock(ImplProc.Body.Body,false); - if ProcScope.OverriddenProc<>nil then + if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then AddOverride(ProcScope.OverriddenProc,Proc); // mark overrides @@ -1304,8 +1304,17 @@ begin if FirstTime and (Member is TPasProcedure) then begin ProcScope:=Member.CustomData as TPasProcedureScope; - if ProcScope.OverriddenProc<>nil then + if TPasProcedure(Member).IsOverride and (ProcScope.OverriddenProc<>nil) then + begin + // this is an override AddOverride(ProcScope.OverriddenProc,Member); + if ScopeModule<>nil then + begin + // when analyzingf a single module, all overrides are assumed to be called + UseElement(Member,rraNone,true); + continue; + end; + end; end; if AllPublished and (Member.Visibility=visPublished) then begin diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 518f870a0d..e566a25a04 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -203,6 +203,7 @@ type Procedure TestEnumHighLow; Procedure TestEnumOrd; Procedure TestEnumPredSucc; + Procedure TestEnum_EqualNilFail; Procedure TestEnum_CastIntegerToEnum; Procedure TestEnum_Str; Procedure TestSet_AnonymousEnumtype; @@ -2366,6 +2367,19 @@ begin ParseProgram; end; +procedure TTestResolver.TestEnum_EqualNilFail; +begin + StartProgram(false); + Add('type'); + Add(' TFlag = (red, green);'); + Add('var'); + Add(' f: TFlag;'); + Add('begin'); + Add(' if f=nil then ;'); + CheckResolverException('Incompatible types: got "TFlag" expected "Pointer"', + nIncompatibleTypesGotExpected); +end; + procedure TTestResolver.TestEnum_CastIntegerToEnum; begin StartProgram(false); diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas index aba1eff1ea..b5d8a4866c 100644 --- a/packages/fcl-passrc/tests/tcuseanalyzer.pas +++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas @@ -21,6 +21,7 @@ type private FAnalyzer: TPasAnalyzer; FPAMessages: TFPList; // list of TPAMessage + FPAGoodMessages: TFPList; function GetPAMessages(Index: integer): TPAMessage; procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage); protected @@ -32,8 +33,9 @@ type procedure AnalyzeWholeProgram; virtual; procedure CheckUsedMarkers; virtual; procedure CheckHasHint(MsgType: TMessageType; MsgNumber: integer; - const MsgText: string; Has: boolean = true); virtual; - procedure CheckUnitUsed(const aFilename: string; Used: boolean); + const MsgText: string); virtual; + procedure CheckUnexpectedMessages; virtual; + procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual; public property Analyzer: TPasAnalyzer read FAnalyzer; function PAMessageCount: integer; @@ -85,6 +87,7 @@ type procedure TestM_Hint_PrivateFieldIsNeverUsed; procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed; procedure TestM_Hint_PrivateMethodIsNeverUsed; + procedure TestM_Hint_LocalDestructor_No_IsNeverUsed; procedure TestM_Hint_PrivateTypeNeverUsed; procedure TestM_Hint_PrivateConstNeverUsed; procedure TestM_Hint_PrivatePropertyNeverUsed; @@ -135,6 +138,7 @@ procedure TCustomTestUseAnalyzer.SetUp; begin inherited SetUp; FPAMessages:=TFPList.Create; + FPAGoodMessages:=TFPList.Create; FAnalyzer:=TPasAnalyzer.Create; FAnalyzer.Resolver:=ResolverEngine; Analyzer.OnMessage:=@OnAnalyzerMessage; @@ -144,6 +148,7 @@ procedure TCustomTestUseAnalyzer.TearDown; var i: Integer; begin + FreeAndNil(FPAGoodMessages); for i:=0 to FPAMessages.Count-1 do TPAMessage(FPAMessages[i]).Release; FreeAndNil(FPAMessages); @@ -234,7 +239,7 @@ begin end; procedure TCustomTestUseAnalyzer.CheckHasHint(MsgType: TMessageType; - MsgNumber: integer; const MsgText: string; Has: boolean); + MsgNumber: integer; const MsgText: string); var i: Integer; Msg: TPAMessage; @@ -246,22 +251,14 @@ begin Msg:=PAMessages[i]; if (Msg.MsgNumber=MsgNumber) then begin - if Has then + if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then begin - // must have -> message type and text must match exactly - if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then - exit; - end - else - begin - // must not have -> matching number is enough - break; + FPAGoodMessages.Add(Msg); + exit; end; end; dec(i); end; - if (not Has) and (i<0) then exit; - // mismatch writeln('TCustomTestUseAnalyzer.CheckHasHint: '); for i:=0 to PAMessageCount-1 do @@ -271,7 +268,23 @@ begin end; s:=''; str(MsgType,s); - Fail('Analyzer Message '+BoolToStr(Has,'not ','')+'found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}'); + Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}'); +end; + +procedure TCustomTestUseAnalyzer.CheckUnexpectedMessages; +var + i: Integer; + Msg: TPAMessage; + s: String; +begin + for i:=0 to PAMessageCount-1 do + begin + Msg:=PAMessages[i]; + if FPAGoodMessages.IndexOf(Msg)>=0 then continue; + s:=''; + str(Msg.MsgType,s); + Fail('Analyzer Message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}'); + end; end; procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string; @@ -756,7 +769,7 @@ begin Add(' {tmobile_used}TMobile = class(TObject)'); Add(' constructor {#mob_create_used}Create;'); Add(' procedure {#mob_doa_used}DoA; override;'); - Add(' procedure {#mob_dob_notused}DoB; override;'); + Add(' procedure {#mob_dob_used}DoB; override;'); Add(' end;'); Add('constructor TMobile.Create; begin end;'); Add('procedure TMobile.DoA; begin end;'); @@ -838,6 +851,7 @@ begin Add('begin'); AnalyzeProgram; CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal; @@ -858,7 +872,7 @@ begin AnalyzeProgram; // unit hints: no hint, even though no code is actually used - CheckHasHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile',false); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed; @@ -870,6 +884,7 @@ begin Add(' DoIt(1);'); AnalyzeProgram; CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract; @@ -882,8 +897,7 @@ begin Add('begin'); Add(' TObject.DoIt(3);'); AnalyzeProgram; - CheckHasHint(mtHint,nPAParameterNotUsed, - sPAParameterNotUsed,false); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed; @@ -904,6 +918,7 @@ begin CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used'); CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used'); CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed; @@ -928,8 +943,14 @@ begin Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;'); Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;'); AnalyzeUnit; - CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, - 'Local variable "a" is assigned but never used',false); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used'); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used'); + CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used'); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used'); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used'); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used'); + CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed; @@ -944,6 +965,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed, 'Value parameter "i" is assigned but never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed; @@ -969,6 +991,7 @@ begin 'Local variable "b" is assigned but never used'); CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, 'Local variable "c" is assigned but never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed; @@ -991,6 +1014,7 @@ begin CheckHasHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used'); CheckHasHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used'); CheckHasHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed; @@ -1005,7 +1029,11 @@ begin Add('begin'); Add(' m:=nil;'); AnalyzeProgram; - CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed,'Private field "TMobile.a" is never used'); + CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed, + 'Private field "TMobile.a" is never used'); + CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, + 'Local variable "m" is assigned but never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed; @@ -1027,6 +1055,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed, 'Private field "TMobile.a" is assigned but never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed; @@ -1047,6 +1076,34 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAPrivateMethodIsNeverUsed, 'Private method "TMobile.DoSome" is never used'); + CheckUnexpectedMessages; +end; + +procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed; +begin + StartProgram(true,[supTObject]); + Add('type'); + Add(' TMobile = class'); + Add(' private'); + Add(' public'); + Add(' constructor Create;'); + Add(' destructor Destroy; override;'); + Add(' end;'); + Add('var DestroyCount: longint = 0;'); + Add('constructor TMobile.Create;'); + Add('begin'); + Add('end;'); + Add('destructor TMobile.Destroy;'); + Add('begin'); + Add(' inc(DestroyCount);'); + Add(' inherited;'); + Add('end;'); + Add('var o: TObject;'); + Add('begin'); + Add(' o:=TMobile.Create;'); + Add(' o.Destroy;'); + AnalyzeProgram; + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed; @@ -1067,6 +1124,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAPrivateTypeXNeverUsed, 'Private type "TMobile.t" never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed; @@ -1087,6 +1145,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAPrivateConstXNeverUsed, 'Private const "TMobile.c" never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed; @@ -1108,6 +1167,9 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAPrivatePropertyXNeverUsed, 'Private property "TMobile.A" never used'); + CheckHasHint(mtHint,nPAPrivateFieldIsNeverUsed, + 'Private field "TMobile.FA" is never used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed; @@ -1127,6 +1189,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used'); CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed; @@ -1146,6 +1209,7 @@ begin Add(' if m=nil then ;'); AnalyzeProgram; CheckHasHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored; @@ -1168,8 +1232,7 @@ begin Add('begin'); Add(' DoIt(1);'); AnalyzeProgram; - CheckHasHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used',false); - AssertEquals('no hints for assembler proc',0,PAMessageCount); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet; @@ -1182,6 +1245,7 @@ begin AnalyzeProgram; CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet, sPAFunctionResultDoesNotSeemToBeSet); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract; @@ -1194,8 +1258,7 @@ begin Add('begin'); Add(' TObject.DoIt;'); AnalyzeProgram; - CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet, - sPAFunctionResultDoesNotSeemToBeSet,false); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord; @@ -1203,15 +1266,17 @@ begin StartProgram(true); Add('type'); Add(' TPoint = record X,Y:longint; end;'); - Add('function Point(Left,Top: longint): TPoint;'); + Add('function Point(Left: longint): TPoint;'); Add('begin'); Add(' Result.X:=Left;'); Add('end;'); Add('begin'); - Add(' Point(1,2);'); + Add(' Point(1);'); AnalyzeProgram; - CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet, - sPAFunctionResultDoesNotSeemToBeSet,false); + CheckHasHint(mtHint,nPALocalVariableIsAssignedButNeverUsed, + 'Local variable "X" is assigned but never used'); + CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement; @@ -1223,15 +1288,15 @@ begin Add('begin'); Add(' x:=3;'); Add('end;'); - Add('function Point(Left,Top: longint): TPoint;'); + Add('function Point(): TPoint;'); Add('begin'); Add(' Three(Result.X)'); Add('end;'); Add('begin'); - Add(' Point(1,2);'); + Add(' Point();'); AnalyzeProgram; - CheckHasHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet, - sPAFunctionResultDoesNotSeemToBeSet,false); + CheckHasHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used'); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed; @@ -1245,8 +1310,7 @@ begin Add('begin'); Add(' DoIt(i);'); AnalyzeProgram; - CheckHasHint(mtHint,nPAValueParameterIsAssignedButNeverUsed, - sPAValueParameterIsAssignedButNeverUsed,false); + CheckUnexpectedMessages; end; procedure TTestUseAnalyzer.TestWP_LocalVar;