Browse Source

fcl-passrc: resolver: forbid assignment of for-loop variable

git-svn-id: trunk@38875 -
Mattias Gaertner 7 years ago
parent
commit
e16651f18c

+ 2 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -170,6 +170,7 @@ const
   nDuplicateCaseValueXatY = 3108;
   nMissingFieldsX = 3109;
   nCantAssignValuesToConstVariable = 3110;
+  nIllegalAssignmentToForLoopVar = 3111;
 
 // resourcestring patterns of messages
 resourcestring
@@ -272,6 +273,7 @@ resourcestring
   sDuplicateCaseValueXatY = 'Duplicate case value "%s", other at %s';
   sMissingFieldsX = 'Missing fields: "%s"';
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
+  sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

+ 78 - 25
packages/fcl-passrc/src/pasresolver.pp

@@ -40,6 +40,7 @@ Works:
   - check duplicate values
 - try..finally..except, on, else, raise
 - for loop
+  - fail to write a loop var inside the loop
 - spot duplicates
 - type cast base types
 - char
@@ -208,8 +209,7 @@ ToDo:
 - $pop, $push
 - $RTTI inherited|explicit
 - range checking:
-  - defaultvalue
-- fail to write a loop var inside the loop
+  - property defaultvalue
 - nested classes
 - records - TPasRecordType,
    - function default(record type): record
@@ -1662,7 +1662,9 @@ type
     function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
       LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
       RErrorEl: TPasElement = nil): integer;
-    function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
+    function IsVariableConst(El, PosEl: TPasElement; RaiseIfConst: boolean): boolean; virtual;
+    function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult;
+      PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
     function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
     // utility functions
     function GetProcTypeDescription(ProcType: TPasProcedureType;
@@ -6894,7 +6896,7 @@ begin
   // loop var
   ResolveExpr(Loop.VariableName,rraReadAndAssign);
   ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
-  if not ResolvedElCanBeVarParam(VarResolved) then
+  if not ResolvedElCanBeVarParam(VarResolved,Loop.VariableName) then
     RaiseMsg(20170216151955,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Loop.VariableName);
 
   // resolve start expression
@@ -11448,7 +11450,7 @@ begin
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
   Result:=cIncompatible;
   DynArr:=nil;
-  if ResolvedElCanBeVarParam(ParamResolved) then
+  if ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if ParamResolved.BaseType in btAllStrings then
       Result:=cExact
@@ -11678,7 +11680,7 @@ begin
   {$ENDIF}
   Result:=cIncompatible;
   // Expr must be a variable
-  if not ResolvedElCanBeVarParam(ParamResolved) then
+  if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if RaiseOnError then
       RaiseMsg(20170216152319,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
@@ -12329,7 +12331,7 @@ begin
   Param:=Params.Params[1];
   ComputeElement(Param,ParamResolved,[]);
   Result:=cIncompatible;
-  if ResolvedElCanBeVarParam(ParamResolved) then
+  if ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if ParamResolved.BaseType in btAllStrings then
       Result:=cExact;
@@ -12516,7 +12518,7 @@ begin
   // check Array
   Param:=Params.Params[1];
   ComputeElement(Param,ParamResolved,[]);
-  if not ResolvedElCanBeVarParam(ParamResolved) then
+  if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if RaiseOnError then
       RaiseMsg(20170329171514,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
@@ -12567,7 +12569,7 @@ begin
   // check Array
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[]);
-  if not ResolvedElCanBeVarParam(ParamResolved) then
+  if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if RaiseOnError then
       RaiseMsg(20170329173421,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
@@ -12727,7 +12729,7 @@ begin
   {$ENDIF}
   Result:=cIncompatible;
   // Expr must be a variable
-  if not ResolvedElCanBeVarParam(ParamResolved) then
+  if not ResolvedElCanBeVarParam(ParamResolved,Expr) then
     begin
     if RaiseOnError then
       RaiseMsg(20180425005303,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
@@ -14987,7 +14989,7 @@ begin
       end;
     end;
   if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
-    exit(true);
+    exit(not IsVariableConst(El,ErrorEl,ErrorOnFalse));
   // not writable
   if not ErrorOnFalse then exit;
   {$IFDEF VerbosePasResolver}
@@ -16127,30 +16129,81 @@ begin
     exit(cIncompatible);
 end;
 
+function TPasResolver.IsVariableConst(El, PosEl: TPasElement;
+  RaiseIfConst: boolean): boolean;
+var
+  CurEl: TPasElement;
+  VarResolved: TPasResolverResult;
+  Loop: TPasImplForLoop;
+begin
+  Result:=false;
+  CurEl:=PosEl;
+  while CurEl<>nil do
+    begin
+    if (CurEl.ClassType=TPasImplForLoop) then
+      begin
+      Loop:=TPasImplForLoop(CurEl);
+      if (Loop.VariableName<>PosEl) then
+        begin
+        ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc]);
+        if VarResolved.IdentEl=El then
+          begin
+          if RaiseIfConst then
+            RaiseMsg(20180430100719,nIllegalAssignmentToForLoopVar,
+              sIllegalAssignmentToForLoopVar,[El.Name],PosEl);
+          exit(true);
+          end;
+        end;
+      end;
+    CurEl:=CurEl.Parent;
+    end;
+end;
+
 function TPasResolver.ResolvedElCanBeVarParam(
-  const ResolvedEl: TPasResolverResult): boolean;
+  const ResolvedEl: TPasResolverResult; PosEl: TPasElement;
+  RaiseIfConst: boolean): boolean;
+
+  function NotLocked(El: TPasElement): boolean;
+  begin
+    Result:=not IsVariableConst(El,PosEl,RaiseIfConst);
+  end;
+
+var
+  IdentEl: TPasElement;
 begin
   Result:=false;
   if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
     exit;
   if ResolvedEl.IdentEl=nil then exit;
-  if ResolvedEl.IdentEl.ClassType=TPasVariable then
-    exit(true);
-  if (ResolvedEl.IdentEl.ClassType=TPasArgument) then
+  IdentEl:=ResolvedEl.IdentEl;
+  if IdentEl.ClassType=TPasVariable then
+    exit(NotLocked(IdentEl));
+  if (IdentEl.ClassType=TPasConst) then
     begin
-    Result:=(TPasArgument(ResolvedEl.IdentEl).Access in [argDefault, argVar, argOut]);
-    exit;
+    if TPasConst(IdentEl).IsConst then
+      begin
+      if RaiseIfConst then
+        RaiseMsg(20180430100719,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
+      exit(false);
+      end;
+    exit(NotLocked(IdentEl));
     end;
-  if ResolvedEl.IdentEl.ClassType=TPasResultElement then
-    exit(true);
-  if (ResolvedEl.IdentEl.ClassType=TPasConst) then
+  if (IdentEl.ClassType=TPasArgument) then
     begin
-    Result:=TPasConst(ResolvedEl.IdentEl).IsConst;
-    exit;
+    if TPasArgument(IdentEl).Access in [argConst,argConstRef] then
+      begin
+      if RaiseIfConst then
+        RaiseMsg(20180430100843,nCantAssignValuesToConstVariable,sCantAssignValuesToConstVariable,[],PosEl);
+      exit(false);
+      end;
+    Result:=(TPasArgument(IdentEl).Access in [argDefault, argVar, argOut]);
+    exit(Result and NotLocked(IdentEl));
     end;
+  if IdentEl.ClassType=TPasResultElement then
+    exit(NotLocked(IdentEl));
   if (proPropertyAsVarParam in Options)
-      and (ResolvedEl.IdentEl.ClassType=TPasProperty) then
-    exit(true);
+      and (IdentEl.ClassType=TPasProperty) then
+    exit(NotLocked(IdentEl));
 end;
 
 function TPasResolver.ResolvedElIsClassInstance(
@@ -16481,7 +16534,7 @@ begin
   if NeedVar then
     begin
     // Expr must be a variable
-    if not ResolvedElCanBeVarParam(ExprResolved) then
+    if not ResolvedElCanBeVarParam(ExprResolved,Expr) then
       begin
       {$IFDEF VerbosePasResolver}
       writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));

+ 3 - 1
packages/fcl-passrc/src/pscanner.pp

@@ -287,7 +287,7 @@ type
                       // N
     bsOptimization,   // O   enable safe optimizations (-O1)
     bsOpenStrings,    // P   deprecated Delphi directive
-    bsOverflowChecks, // Q
+    bsOverflowChecks, // Q   or $OV
     bsRangeChecks,    // R
                       // S
     bsTypedAddress,   // T   enabled: @variable gives typed pointer, otherwise untyped pointer
@@ -3166,6 +3166,8 @@ begin
           DoBoolDirective(bsNotes);
         'OBJECTCHECKS':
           DoBoolDirective(bsObjectChecks);
+        'OVERFLOWCHECKS','OV':
+          DoBoolDirective(bsOverflowChecks);
         'POINTERMATH':
           DoBoolDirective(bsPointerMath);
         'RANGECHECKS':

+ 76 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -312,6 +312,9 @@ type
 
     // statements
     Procedure TestForLoop;
+    Procedure TestForLoop_NestedSameVarFail;
+    Procedure TestForLoop_AssignVarFail;
+    Procedure TestForLoop_PassVarFail;
     Procedure TestStatements;
     Procedure TestCaseStatement;
     Procedure TestCaseStatementDuplicateIntFail;
@@ -544,6 +547,9 @@ type
     Procedure TestClass_PublishedClassFunctionFail;
     Procedure TestClass_PublishedOverloadFail;
 
+    // nested class
+    Procedure TestNestedClass; // ToDo
+
     // external class
     Procedure TestExternalClass;
     Procedure TestExternalClass_Descendant;
@@ -4484,6 +4490,43 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestForLoop_NestedSameVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'var i: byte;',
+  'begin',
+  '  for i:=1 to 2 do',
+  '    for i:=1 to 2 do ;',
+  '']);
+  CheckResolverException('Illegal assignment to for-loop variable "i"',nIllegalAssignmentToForLoopVar);
+end;
+
+procedure TTestResolver.TestForLoop_AssignVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'var i: byte;',
+  'begin',
+  '  for i:=1 to 2 do',
+  '    i:=3;',
+  '']);
+  CheckResolverException('Illegal assignment to for-loop variable "i"',nIllegalAssignmentToForLoopVar);
+end;
+
+procedure TTestResolver.TestForLoop_PassVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(var i: byte); external;',
+  'var i: byte;',
+  'begin',
+  '  for i:=1 to 2 do',
+  '    DoIt(i);',
+  '']);
+  CheckResolverException('Illegal assignment to for-loop variable "i"',nIllegalAssignmentToForLoopVar);
+end;
+
 procedure TTestResolver.TestStatements;
 begin
   StartProgram(false);
@@ -9178,6 +9221,39 @@ begin
   CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestNestedClass;
+begin
+  exit;
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  type',
+  '    TLeg = class',
+  '      constructor Create(i: byte);',
+  '      procedure {#Walk}Walk(i: byte);',
+  '    end;',
+  '    procedure Move(i: byte);',
+  '  end;',
+  'procedure TObject.Move(i: byte);',
+  'var Leg: TLeg;',
+  'begin',
+  '  Leg:=TLeg.Create(i);',
+  '  Leg:=TObject.TLeg.Create(i);',
+  'end;',
+  'constructor tObject.tLeg.Create(i: byte);',
+  'begin',
+  '  {@Walk}Walk(i);',
+  '  Self.{@Walk}Walk(i);',
+  'end;',
+  'var Leg: TLeg;',
+  'begin',
+  '  Leg:=TObject.TLeg.Create(i);',
+  '  Leg.Walk;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestExternalClass;
 begin
   StartProgram(false);