fcl-passrc: resolver: compile time range checks

git-svn-id: trunk@37117 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -1265,11 +1265,9 @@ begin
       RaiseRangeCheck(20170522123106,Expr.Right);
     end
   else
-    {$IFDEF EnablePasResRangeCheck}
+    {$IFDEF VerbosePasResolver}
     writeln('TResExprEvaluator.EvalBinaryRangeExpr Left=',GetObjName(Expr.Left),' LeftValue.Kind=',LeftValue.Kind);
     RaiseNotYetImplemented(20170518221103,Expr.Left);
-    {$ELSE}
-    exit(nil);
     {$ENDIF}
   end;
 end;
@@ -3417,10 +3415,6 @@ var
   UInt: MaxPrecUInt;
   Flo: MaxPrecFloat;
 begin
-  {$IFNDEF EnablePasResRangeCheck}
-  writeln('TResExprEvaluator.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
-  RaiseInternalError(20170712103904);
-  {$ENDIF}
   Result:=nil;
   if Expr.CustomData is TResEvalValue then
     begin
@@ -3493,7 +3487,9 @@ begin
     else
       RaiseNotYetImplemented(20170518200951,Expr);
     end;
+    {$IFDEF VerbosePasResEval}
     writeln('TResExprEvaluator.Eval primitiv end result=',Result<>nil,' ',dbgs(Result));
+    {$ENDIF}
     end
   else if C=TNilExpr then
     Result:=TResEvalValue.CreateKind(revkNil)
@@ -3509,7 +3505,9 @@ begin
     Result:=EvalArrayValuesExpr(TArrayValues(Expr),Flags)
   else if refConst in Flags then
     RaiseConstantExprExp(20170518213800,Expr);
+  {$IFDEF VerbosePasResEval}
   writeln('TResExprEvaluator.Eval END ',Expr.ClassName,' result=',Result<>nil,' ',dbgs(Result));
+  {$ENDIF}
 end;
 
 function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;

packages/fcl-passrc/src/pasresolver.pp

@@ -3387,10 +3387,8 @@ end;
 procedure TPasResolver.FinishConstRangeExpr(Left, Right: TPasExpr; out LeftResolved,
   RightResolved: TPasResolverResult);
 // for example Left..Right
-{$IFDEF EnablePasResRangeCheck}
 var
   RgValue: TResEvalValue;
-{$ENDIF}
 begin
   {$IFDEF VerbosePasResEval}
   writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
@@ -3400,10 +3398,8 @@ begin
   ComputeElement(Right,RightResolved,[rcSkipTypeAlias,rcConstant]);
   CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
 
-  {$IFDEF EnablePasResRangeCheck}
   RgValue:=Eval(Left.Parent as TBinaryExpr,[refConst]);
   ReleaseEvalValue(RgValue);
-  {$ENDIF}
 end;
 
 procedure TPasResolver.FinishRecordType(El: TPasRecordType);
@@ -3457,9 +3453,7 @@ begin
   if El.VarType<>nil then
     CheckAssignCompatibility(El,El.Expr,true)
   else
-    {$IFDEF EnablePasResRangeCheck}
     Eval(El.Expr,[refConst])
-    {$ENDIF} ;
 end;
 
 procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
@@ -4809,9 +4803,7 @@ begin
   akDefault:
     begin
     CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
-    {$IFDEF EnablePasResRangeCheck}
     CheckAssignExprRange(LeftResolved,El.right);
-    {$ENDIF}
     end;
   akAdd, akMinus,akMul,akDivision:
     begin
@@ -4854,9 +4846,7 @@ begin
     else
       RaiseMsg(20170216152125,nIllegalQualifier,sIllegalQualifier,[AssignKindNames[El.Kind]],El);
     // store const expression result
-    {$IFDEF EnablePasResRangeCheck}
     Eval(El.right,[]);
-    {$ENDIF}
     end;
   else
     RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
@@ -7798,9 +7788,6 @@ function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
 // Important: Caller must free result if (Result<>nil) and (Result.Element=nil)
 //            use utility function ReleaseEvalValue(Result)
 begin
-  {$IFNDEF EnablePasResRangeCheck}
-  exit(nil);
-  {$ENDIF}
   Result:=fExprEvaluator.Eval(Expr,Flags);
   if Result=nil then exit;
   {$IFDEF VerbosePasResEval}
@@ -10587,9 +10574,7 @@ var
   NextType: TPasType;
   RangeExpr: TPasExpr;
   TypeFits: Boolean;
-  {$IFDEF EnablePasResRangeCheck}
   ParamValue: TResEvalValue;
-  {$ENDIF}
 begin
   ArgNo:=0;
   repeat
@@ -10602,7 +10587,6 @@ begin
         exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
       if EmitHints then
         begin
-        {$IFDEF EnablePasResRangeCheck}
         ParamValue:=Eval(Param,[refAutoConst]);
         if ParamValue<>nil then
           try // has const value -> check range
@@ -10614,7 +10598,6 @@ begin
           finally
             ReleaseEvalValue(ParamValue);
           end;
-        {$ENDIF}
         end;
       end
     else
@@ -10654,10 +10637,8 @@ begin
           RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
             [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
           end;
-        {$IFDEF EnablePasResRangeCheck}
         if EmitHints then
           fExprEvaluator.IsInRange(Param,RangeExpr,true);
-        {$ENDIF}
         end;
       end;
     if ArgNo=length(Params.Params) then exit(cExact);
@@ -10910,11 +10891,7 @@ begin
   ComputeElement(RHS,RightResolved,Flags);
   Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,RHS,RaiseOnIncompatible);
   if RHS is TPasExpr then
-    begin
-    {$IFDEF EnablePasResRangeCheck}
     CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
-    {$ENDIF}
-    end;
 end;
 
 procedure TPasResolver.CheckAssignExprRange(
@@ -10930,9 +10907,6 @@ var
   bt: TResolverBaseType;
   w: WideChar;
 begin
-  {$IFNDEF EnablePasResRangeCheck}
-  exit;
-  {$ENDIF}
   RValue:=Eval(RHS,[refAutoConst]);
   if RValue=nil then
     exit; // not a const expression
@@ -13457,9 +13431,7 @@ function TPasResolver.GetRangeLength(const RangeResolved: TPasResolverResult
   ): MaxPrecInt;
 var
   TypeEl: TPasType;
-  {$IFDEF EnablePasResRangeCheck}
   Value: TResEvalValue;
-  {$ENDIF}
 begin
   Result:=0;
   if RangeResolved.BaseType=btContext then
@@ -13476,7 +13448,6 @@ begin
     end
   else if RangeResolved.ExprEl<>nil then
     begin
-    {$IFDEF EnablePasResRangeCheck}
     Value:=Eval(RangeResolved.ExprEl,[]);
     if Value=nil then
       RaiseMsg(20170729094135,nIncompatibleTypesGotExpected,
@@ -13494,9 +13465,6 @@ begin
     finally
       ReleaseEvalValue(Value);
     end;
-    {$ELSE}
-    Result:=2;
-    {$ENDIF}
     end
   else if RangeResolved.BaseType in btAllBooleans then
     Result:=2;

packages/fcl-passrc/src/pparser.pp

@@ -4762,7 +4762,9 @@ var
     if (CurBlock.Elements.Count>0) and not (GetPrevToken in [tkSemicolon,tkColon])
         and (CurBlock.ClassType<>TPasImplIfElse) then
       begin
+      {$IFDEF VerbosePasParser}
       writeln('TPasParser.ParseStatement.CheckSemicolon Prev=',GetPrevToken,' Cur=',CurToken,' ',CurBlock.ClassName,' ',CurBlock.Elements.Count,' ',TObject(CurBlock.Elements[0]).ClassName);
+      {$ENDIF}
       ParseExcTokenError('Semicolon');
       end;
   end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -2321,10 +2321,8 @@ begin
   Add('type');
   Add('  {#TMyInt}TMyInt = MaxInt..MinInt;');
   Add('begin');
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverException(sHighRangeLimitLTLowRangeLimit,
     nHighRangeLimitLTLowRangeLimit);
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestIntegerRangeLowHigh;
@@ -2351,11 +2349,9 @@ begin
   'begin',
   '  i:=3;']);
   ParseProgram;
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
     'range check error while evaluating constants (3 must be between 1 and 2)');
   CheckResolverUnexpectedHints;
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestByteRangeFail;
@@ -2365,11 +2361,9 @@ begin
   'var b:byte=300;',
   'begin']);
   ParseProgram;
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
     'range check error while evaluating constants (300 must be between 0 and 255)');
   CheckResolverUnexpectedHints;
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestCustomIntRangeFail;
@@ -2379,11 +2373,9 @@ begin
   'const i:1..2 = 3;',
   'begin']);
   ParseProgram;
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
     'range check error while evaluating constants (3 must be between 1 and 2)');
   CheckResolverUnexpectedHints;
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestIntSet_Const;
@@ -2413,14 +2405,12 @@ end;
 
 procedure TTestResolver.TestIntSet_ConstDuplicateElement;
 begin
-  {$IFDEF EnablePasResRangeCheck}
   StartProgram(false);
   Add([
   'const',
   '  s1 = [1,1..2];',
   'begin']);
   CheckResolverException(sRangeCheckInSetConstructor,nRangeCheckInSetConstructor);
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestChar_Ord;
@@ -8937,7 +8927,6 @@ end;
 
 procedure TTestResolver.TestArray_Static_Const;
 begin
-  {$IFDEF EnablePasResRangeCheck}
   StartProgram(false);
   Add([
   'type',
@@ -8948,7 +8937,6 @@ begin
   'begin']);
   ParseProgram;
   CheckResolverUnexpectedHints;
-  {$ENDIF}
 end;
 
 procedure TTestResolver.TestArrayIntRange_OutOfRange;
@@ -8961,10 +8949,8 @@ begin
   '  a[0]:=3;',
   '']);
   ParseProgram;
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
     'range check error while evaluating constants (0 must be between 1 and 2)');
-  {$ENDIF}
   CheckResolverUnexpectedHints;
 end;
 
@@ -8978,10 +8964,8 @@ begin
   '  a[''0'']:=3;',
   '']);
   ParseProgram;
-  {$IFDEF EnablePasResRangeCheck}
   CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
     'range check error while evaluating constants (''0'' must be between ''a'' and ''b'')');
-  {$ENDIF}
   CheckResolverUnexpectedHints;
 end;