Browse Source

fcl-passrc: fixed hints for for loop var not used inside loop

git-svn-id: trunk@35909 -
Mattias Gaertner 8 years ago
parent
commit
fac17a2198

+ 5 - 3
packages/fcl-passrc/src/pasresolver.pp

@@ -3859,7 +3859,7 @@ var
           RaiseInternalError(20161010125255);
           RaiseInternalError(20161010125255);
         if ProcArgResolved.TypeEl=nil then
         if ProcArgResolved.TypeEl=nil then
           RaiseInternalError(20161010125304);
           RaiseInternalError(20161010125304);
-        if (PropArgResolved.TypeEl<>ProcArgResolved.TypeEl) then
+        if not IsSameType(PropArgResolved.TypeEl,ProcArgResolved.TypeEl,true) then
           RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
           RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
             [IntToStr(ArgNo)],ProcArgResolved.TypeEl,PropArgResolved.TypeEl,ErrorEl);
             [IntToStr(ArgNo)],ProcArgResolved.TypeEl,PropArgResolved.TypeEl,ErrorEl);
         end;
         end;
@@ -3982,6 +3982,8 @@ begin
         end;
         end;
       // check args
       // check args
       CheckArgs(Proc,PropEl.ReadAccessor);
       CheckArgs(Proc,PropEl.ReadAccessor);
+      // ToDo: check index arg
+      // check write arg
       PropArgCount:=PropEl.Args.Count;
       PropArgCount:=PropEl.Args.Count;
       if Proc.ProcType.Args.Count<>PropArgCount+1 then
       if Proc.ProcType.Args.Count<>PropArgCount+1 then
         RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
         RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
@@ -4463,7 +4465,7 @@ var
   VarResolved, StartResolved, EndResolved: TPasResolverResult;
   VarResolved, StartResolved, EndResolved: TPasResolverResult;
 begin
 begin
   // loop var
   // loop var
-  ResolveExpr(Loop.VariableName,rraAssign);
+  ResolveExpr(Loop.VariableName,rraReadAndAssign);
   ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
   ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
   if ResolvedElCanBeVarParam(VarResolved)
   if ResolvedElCanBeVarParam(VarResolved)
       and ((VarResolved.BaseType in (btAllBooleans+btAllInteger+btAllChars))
       and ((VarResolved.BaseType in (btAllBooleans+btAllInteger+btAllChars))
@@ -9076,7 +9078,7 @@ procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
 
 
   function GetString(ArgNo: integer): string;
   function GetString(ArgNo: integer): string;
   begin
   begin
-    if ArgNo>=High(Args) then
+    if ArgNo>High(Args) then
       exit('invalid param '+IntToStr(ArgNo));
       exit('invalid param '+IntToStr(ArgNo));
     case Args[ArgNo].VType of
     case Args[ArgNo].VType of
     vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
     vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);

+ 17 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -81,6 +81,7 @@ type
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsedTypecast;
     procedure TestM_Hint_ParameterNotUsedTypecast;
     procedure TestM_Hint_LocalVariableNotUsed;
     procedure TestM_Hint_LocalVariableNotUsed;
+    procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
     procedure TestM_Hint_InterfaceUnitVariableUsed;
     procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
     procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
     procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
     procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
@@ -947,6 +948,22 @@ begin
   CheckUseAnalyzerUnexpectedHints;
   CheckUseAnalyzerUnexpectedHints;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var i: longint;',
+  'begin',
+  '  for i:=1 to 2 do ;',
+  'end;',
+  'begin',
+  '  DoIt;',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
 procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
 begin
 begin
   StartUnit(true);
   StartUnit(true);