Browse Source

fcl-passrc: fixed checking static array constant elements

git-svn-id: trunk@37375 -
Mattias Gaertner 7 years ago
parent
commit
01ac3334af
2 changed files with 17 additions and 2 deletions
  1. 4 1
      packages/fcl-passrc/src/pasresolver.pp
  2. 13 1
      packages/fcl-passrc/tests/tcresolver.pas

+ 4 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -11051,7 +11051,7 @@ end;
 
 
 procedure TPasResolver.CheckAssignExprRange(
 procedure TPasResolver.CheckAssignExprRange(
   const LeftResolved: TPasResolverResult; RHS: TPasExpr);
   const LeftResolved: TPasResolverResult; RHS: TPasExpr);
-// check if RHS fits into range LeftResolved
+// if RHS is a constant check if it fits into range LeftResolved
 var
 var
   RValue, RangeValue: TResEvalValue;
   RValue, RangeValue: TResEvalValue;
   MinVal, MaxVal: int64;
   MinVal, MaxVal: int64;
@@ -11062,6 +11062,8 @@ var
   bt: TResolverBaseType;
   bt: TResolverBaseType;
   w: WideChar;
   w: WideChar;
 begin
 begin
+  if (LeftResolved.TypeEl<>nil) and (LeftResolved.TypeEl.ClassType=TPasArrayType) then
+    exit; // arrays are checked by element, not by the whole value
   RValue:=Eval(RHS,[refAutoConst]);
   RValue:=Eval(RHS,[refAutoConst]);
   if RValue=nil then
   if RValue=nil then
     exit; // not a const expression
     exit; // not a const expression
@@ -12340,6 +12342,7 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
           Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
           Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
           if Result=cIncompatible then
           if Result=cIncompatible then
             exit;
             exit;
+          CheckAssignExprRange(ElTypeResolved,Value);
           end
           end
         else
         else
           begin
           begin

+ 13 - 1
packages/fcl-passrc/tests/tcresolver.pas

@@ -537,6 +537,7 @@ type
     Procedure TestDynArrayOfLongint;
     Procedure TestDynArrayOfLongint;
     Procedure TestStaticArray;
     Procedure TestStaticArray;
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfChar;
+    Procedure TestStaticArrayOfRangeElCheckFail;
     Procedure TestArrayOfArray;
     Procedure TestArrayOfArray;
     Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestArrayOfArray_NameAnonymous;
     Procedure TestFunctionReturningArray;
     Procedure TestFunctionReturningArray;
@@ -8699,7 +8700,7 @@ begin
   Add('type');
   Add('type');
   Add('  TArrA = array[1..3] of char;');
   Add('  TArrA = array[1..3] of char;');
   Add('const');
   Add('const');
-  Add('  A: TArrA = (''p'',''a'',''b'');');
+  Add('  A: TArrA = (''p'',''a'',''p'');'); // duplicate allowed, this bracket is not a set
   Add('  B: TArrA = ''pas'';');
   Add('  B: TArrA = ''pas'';');
   Add('  Three = length(TArrA);');
   Add('  Three = length(TArrA);');
   Add('  C: array[1..Three] of char = ''pas'';');
   Add('  C: array[1..Three] of char = ''pas'';');
@@ -8710,6 +8711,17 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestStaticArrayOfRangeElCheckFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  A: array[1..2] of shortint = (1,300);');
+  Add('begin');
+  ParseProgram;
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (300 must be between -128 and 127)');
+end;
+
 procedure TTestResolver.TestArrayOfArray;
 procedure TTestResolver.TestArrayOfArray;
 begin
 begin
   StartProgram(false);
   StartProgram(false);