fcl-passrc: analyzer: fixed marking method override

git-svn-id: trunk@35806 -

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

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

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

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;