paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: range check on: warnings becomes errors

Browse Source 
git-svn-id: trunk@38828 -
This commit is contained in:
Mattias Gaertner 2018-04-24 10:22:45 +00:00
parent fcfe99d505
commit e6513d6883
3 changed files with 40 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -235,7 +235,7 @@ resourcestring
sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
sRangeCheckError = 'Range check error';
sHighRangeLimitLTLowRangeLimit = 'High range limit < low range limit';
sRangeCheckEvaluatingConstantsVMinMax = 'range check error while evaluating constants (%s must be between %s and %s)';
sRangeCheckEvaluatingConstantsVMinMax = 'range check error while evaluating constants (%s is not between %s and %s)';
sIllegalChar = 'Illegal character';
sOverflowInArithmeticOperation = 'Overflow in arithmetic operation';
sDivByZero = 'Division by zero';
@ -552,6 +552,8 @@ type
Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue of object;
TPasResEvalParamsHandler = function(Sender: TResExprEvaluator;
Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue of object;
TPasResEvalRangeCheckElHandler = procedure(Sender: TResExprEvaluator;
El: TPasElement; var MsgType: TMessageType) of object;
{ TResExprEvaluator }
@ -562,6 +564,7 @@ type
FOnEvalIdentifier: TPasResEvalIdentHandler;
FOnEvalParams: TPasResEvalParamsHandler;
FOnLog: TPasResEvalLogHandler;
FOnRangeCheckEl: TPasResEvalRangeCheckElHandler;
protected
procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
@ -638,6 +641,7 @@ type
property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
property OnEvalParams: TPasResEvalParamsHandler read FOnEvalParams write FOnEvalParams;
property OnRangeCheckEl: TPasResEvalRangeCheckElHandler read FOnRangeCheckEl write FOnRangeCheckEl;
property AllowedInts: TResEvalTypedInts read FAllowedInts write FAllowedInts;
property DefaultStringCodePage: TSystemCodePage read FDefaultEncoding write FDefaultEncoding;
end;
@ -4352,6 +4356,8 @@ end;
procedure TResExprEvaluator.EmitRangeCheckConst(id: int64; const aValue,
MinVal, MaxVal: String; PosEl: TPasElement; MsgType: TMessageType);
begin
if Assigned(OnRangeCheckEl) then
OnRangeCheckEl(Self,PosEl,MsgType);
LogMsg(id,MsgType,nRangeCheckEvaluatingConstantsVMinMax,
sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
end;

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

@ -1359,6 +1359,8 @@ type
Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
function OnExprEvalParams(Sender: TResExprEvaluator;
Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
procedure OnRangeCheckEl(Sender: TResExprEvaluator; El: TPasElement;
var MsgType: TMessageType); virtual;
function EvalBaseTypeCast(Params: TParamsExpr; bt: TResolverBaseType): TResEvalvalue;
protected
// custom types (added by descendant resolvers)
@ -10504,6 +10506,15 @@ begin
if Flags=[] then ;
end;
procedure TPasResolver.OnRangeCheckEl(Sender: TResExprEvaluator;
El: TPasElement; var MsgType: TMessageType);
begin
if El=nil then exit;
if (MsgType=mtWarning)
and (bsRangeChecks in CurrentParser.Scanner.CurrentBoolSwitches) then
MsgType:=mtError;
end;
function TPasResolver.EvalBaseTypeCast(Params: TParamsExpr;
bt: TResolverBaseType): TResEvalvalue;
@ -12158,6 +12169,7 @@ begin
fExprEvaluator.OnLog:=@OnExprEvalLog;
fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
fExprEvaluator.OnRangeCheckEl:=@OnRangeCheckEl;
PushScope(FDefaultScope);
end;

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

@ -686,6 +686,7 @@ type
// static arrays
Procedure TestArrayIntRange_OutOfRange;
Procedure TestArrayIntRange_OutOfRangeError;
Procedure TestArrayCharRange_OutOfRange;
// procedure types
@ -2813,7 +2814,7 @@ begin
' i:=3;']);
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (3 must be between 1 and 2)');
'range check error while evaluating constants (3 is not between 1 and 2)');
CheckResolverUnexpectedHints;
end;
@ -2825,7 +2826,7 @@ begin
'begin']);
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (300 must be between 0 and 255)');
'range check error while evaluating constants (300 is not between 0 and 255)');
CheckResolverUnexpectedHints;
end;
@ -2848,7 +2849,7 @@ begin
'begin']);
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (3 must be between 1 and 2)');
'range check error while evaluating constants (3 is not between 1 and 2)');
CheckResolverUnexpectedHints;
end;
@ -11020,7 +11021,7 @@ begin
Add('begin');
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (300 must be between -128 and 127)');
'range check error while evaluating constants (300 is not between -128 and 127)');
end;
procedure TTestResolver.TestArrayOfArray;
@ -11669,10 +11670,24 @@ begin
'']);
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (0 must be between 1 and 2)');
'range check error while evaluating constants (0 is not between 1 and 2)');
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestArrayIntRange_OutOfRangeError;
begin
StartProgram(false);
Add([
'{$R+}',
'type TArr = array[1..2] of longint;',
'var a: TArr;',
'begin',
' a[0]:=3;',
'']);
CheckResolverException('range check error while evaluating constants (0 is not between 1 and 2)',
nRangeCheckEvaluatingConstantsVMinMax);
end;
procedure TTestResolver.TestArrayCharRange_OutOfRange;
begin
StartProgram(false);
@ -11684,7 +11699,7 @@ begin
'']);
ParseProgram;
CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
'range check error while evaluating constants (''0'' must be between ''a'' and ''b'')');
'range check error while evaluating constants (''0'' is not between ''a'' and ''b'')');
CheckResolverUnexpectedHints;
end;