paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 21:10:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed checking static array constant elements

Browse Source 
git-svn-id: trunk@37375 -
This commit is contained in:
Mattias Gaertner 2017-10-01 18:19:31 +00:00
parent 75e03a7e62
commit 01ac3334af
2 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/fcl-passrc/src/pasresolver.pp
View File

@ -11051,7 +11051,7 @@ end;
procedure TPasResolver.CheckAssignExprRange(
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
RValue, RangeValue: TResEvalValue;
MinVal, MaxVal: int64;
@ -11062,6 +11062,8 @@ var
bt: TResolverBaseType;
w: WideChar;
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]);
if RValue=nil then
exit; // not a const expression
@ -12340,6 +12342,7 @@ function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
if Result=cIncompatible then
exit;
CheckAssignExprRange(ElTypeResolved,Value);
end
else
begin

14
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -537,6 +537,7 @@ type
Procedure TestDynArrayOfLongint;
Procedure TestStaticArray;
Procedure TestStaticArrayOfChar;
Procedure TestStaticArrayOfRangeElCheckFail;
Procedure TestArrayOfArray;
Procedure TestArrayOfArray_NameAnonymous;
Procedure TestFunctionReturningArray;
@ -8699,7 +8700,7 @@ begin
Add('type');
Add(' TArrA = array[1..3] of char;');
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(' Three = length(TArrA);');
Add(' C: array[1..Three] of char = ''pas'';');
@ -8710,6 +8711,17 @@ begin
ParseProgram;
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;
begin
StartProgram(false);