paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 09:23:48 +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( 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

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

@ -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);