mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 00:09:31 +02:00
fcl-passrc: resolver: const float typecast, operators, string[]
git-svn-id: trunk@36725 -
This commit is contained in:
Mattias Gaertner
parent
be39ca0c85
commit
82569975c6
@ -19,43 +19,38 @@ Abstract:
|
||||
Works:
|
||||
- Emitting range check warnings
|
||||
- Error on overflow
|
||||
- bool: not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
|
||||
- bool:
|
||||
- not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
|
||||
- boolean(0), boolean(1)
|
||||
- int/uint
|
||||
- unary +, -
|
||||
- binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
|
||||
- binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not, shl, shr
|
||||
- low(), high(), pred(), succ(), ord()
|
||||
- typecast int
|
||||
- string:
|
||||
- +
|
||||
- pred(), succ()
|
||||
- typecast longint(-1), word(-2), intsingle(-1), uintsingle(1)
|
||||
- float:
|
||||
- typecast float
|
||||
- +, -, /, *, =, <>, <, >, <=, >=
|
||||
- string:
|
||||
- #65, '', 'a', 'ab'
|
||||
- +, =, <>, <, >, <=, >=
|
||||
- pred(), succ()
|
||||
- s[]
|
||||
- length(string)
|
||||
- enum/set
|
||||
|
||||
ToDo:
|
||||
- enable eval via option, default off
|
||||
- bool:
|
||||
- boolean(1)
|
||||
- int
|
||||
- typecast intsingle(-1), uintsingle(-1), longint(-1)
|
||||
- string:
|
||||
- =, <>, <, >, <=, >=
|
||||
- string encoding
|
||||
- s[]
|
||||
- length(string)
|
||||
- chr(), ord(), low(), high()
|
||||
- #65
|
||||
- #$DC00
|
||||
- float
|
||||
- typecast float
|
||||
- /
|
||||
- +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
|
||||
- unicodestring
|
||||
- enum
|
||||
- low(), high(), pred(), succ(), ord(), typecast
|
||||
- sets
|
||||
- [a,b,c..d]
|
||||
- +, -, *, =, <>, <=, >=, in, ><
|
||||
- arrays
|
||||
- length(), low(), high()
|
||||
- length(), low(), high(), []
|
||||
}
|
||||
unit PasResolveEval;
|
||||
|
||||
@ -478,6 +473,7 @@ type
|
||||
function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
@ -485,9 +481,7 @@ type
|
||||
function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
|
||||
function EvalArrayParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
|
||||
function EvalFuncParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
|
||||
function EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
|
||||
function EvalParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
|
||||
function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
|
||||
function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
|
||||
procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
|
||||
@ -510,9 +504,9 @@ type
|
||||
function IsConst(Expr: TPasExpr): boolean;
|
||||
function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
|
||||
procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
|
||||
PosEl: TPasElement); virtual;
|
||||
PosEl: TPasElement; MsgType: TMessageType = mtWarning); virtual;
|
||||
procedure EmitRangeCheckConst(id: int64; const aValue: String;
|
||||
MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
|
||||
MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement; MsgType: TMessageType = mtWarning);
|
||||
function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalInt; virtual;
|
||||
procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
|
||||
procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
|
||||
@ -938,6 +932,13 @@ begin
|
||||
Result:=Result.Clone;
|
||||
TResEvalUInt(Result).UInt:=-TResEvalUInt(Result).UInt;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
if TResEvalFloat(Result).FloatValue=0 then exit;
|
||||
if Result.Element<>nil then
|
||||
Result:=Result.Clone;
|
||||
TResEvalFloat(Result).FloatValue:=-TResEvalFloat(Result).FloatValue;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Result.Element=nil then
|
||||
@ -1021,6 +1022,8 @@ begin
|
||||
Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
|
||||
eopMultiply:
|
||||
Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
|
||||
eopDivide:
|
||||
Result:=EvalBinaryDivideExpr(Expr,LeftValue,RightValue);
|
||||
eopDiv:
|
||||
Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
|
||||
eopMod:
|
||||
@ -1196,6 +1199,7 @@ function TResExprEvaluator.EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue,
|
||||
var
|
||||
Int: MaxPrecInt;
|
||||
UInt: MaxPrecUInt;
|
||||
Flo: MaxPrecFloat;
|
||||
LeftCP, RightCP: TSystemCodePage;
|
||||
begin
|
||||
Result:=nil;
|
||||
@ -1204,42 +1208,68 @@ begin
|
||||
{$R+}
|
||||
case LeftValue.Kind of
|
||||
revkInt:
|
||||
begin
|
||||
Int:=TResEvalInt(LeftValue).Int;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// int+int
|
||||
if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
|
||||
revkInt: // int + int
|
||||
if (Int>0) and (TResEvalInt(RightValue).Int>0) then
|
||||
begin
|
||||
UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(TResEvalInt(RightValue).Int);
|
||||
UInt:=MaxPrecUInt(Int)+MaxPrecUInt(TResEvalInt(RightValue).Int);
|
||||
Result:=CreateResEvalInt(UInt);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Int:=TResEvalInt(LeftValue).Int + TResEvalInt(RightValue).Int;
|
||||
Int:=Int + TResEvalInt(RightValue).Int;
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
end;
|
||||
revkUInt:
|
||||
IntAddUInt(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt);
|
||||
revkUInt: // int + uint
|
||||
IntAddUInt(Int,TResEvalUInt(RightValue).UInt);
|
||||
revkFloat: // int + float
|
||||
Result:=TResEvalFloat.CreateValue(Int + TResEvalFloat(RightValue).FloatValue);
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170525115537,Expr);
|
||||
end;
|
||||
end;
|
||||
revkUInt:
|
||||
begin
|
||||
UInt:=TResEvalUInt(LeftValue).UInt;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
IntAddUInt(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int);
|
||||
revkUInt:
|
||||
revkInt: // uint + int
|
||||
IntAddUInt(UInt,TResEvalInt(RightValue).Int);
|
||||
revkUInt: // uint + uint
|
||||
begin
|
||||
UInt:=TResEvalUInt(LeftValue).UInt+TResEvalUInt(RightValue).UInt;
|
||||
UInt:=UInt+TResEvalUInt(RightValue).UInt;
|
||||
Result:=TResEvalUInt.CreateValue(UInt);
|
||||
end
|
||||
end;
|
||||
revkFloat: // uint + float
|
||||
Result:=TResEvalFloat.CreateValue(UInt + TResEvalFloat(RightValue).FloatValue);
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170601141031,Expr);
|
||||
end;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
Flo:=TResEvalFloat(LeftValue).FloatValue;
|
||||
case RightValue.Kind of
|
||||
revkInt: // float + int
|
||||
Result:=TResEvalFloat.CreateValue(Flo + TResEvalInt(RightValue).Int);
|
||||
revkUInt: // float + uint
|
||||
Result:=TResEvalFloat.CreateValue(Flo + TResEvalUInt(RightValue).UInt);
|
||||
revkFloat: // float + float
|
||||
Result:=TResEvalFloat.CreateValue(Flo + TResEvalFloat(RightValue).FloatValue);
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryAddExpr float+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711145637,Expr);
|
||||
end;
|
||||
end;
|
||||
revkString:
|
||||
case RightValue.Kind of
|
||||
revkString:
|
||||
@ -1307,36 +1337,148 @@ function TResExprEvaluator.EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue,
|
||||
var
|
||||
Int: MaxPrecInt;
|
||||
UInt: MaxPrecUInt;
|
||||
Flo: MaxPrecFloat;
|
||||
begin
|
||||
Result:=nil;
|
||||
case LeftValue.Kind of
|
||||
revkInt:
|
||||
begin
|
||||
Int:=TResEvalInt(LeftValue).Int;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// int-int
|
||||
// int - int
|
||||
try
|
||||
{$Q+}
|
||||
Int:=TResEvalInt(LeftValue).Int - TResEvalInt(RightValue).Int;
|
||||
Int:=Int - TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
except
|
||||
on E: EOverflow do
|
||||
if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int<0) then
|
||||
if (Int>0) and (TResEvalInt(RightValue).Int<0) then
|
||||
begin
|
||||
UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(-TResEvalInt(RightValue).Int);
|
||||
UInt:=MaxPrecUInt(Int)+MaxPrecUInt(-TResEvalInt(RightValue).Int);
|
||||
Result:=CreateResEvalInt(UInt);
|
||||
end
|
||||
else
|
||||
RaiseOverflowArithmetic(20170525230247,Expr);
|
||||
end;
|
||||
// ToDo: int-uint
|
||||
revkUInt:
|
||||
// int - uint
|
||||
try
|
||||
{$Q+}
|
||||
Int:=Int - TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151201,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// int - float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=MaxPrecFloat(Int) - TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151313,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170525230028,Expr);
|
||||
end;
|
||||
// ToDo: uint-int, uint-uint
|
||||
end;
|
||||
revkUInt:
|
||||
begin
|
||||
UInt:=TResEvalUInt(LeftValue).UInt;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// uint - int
|
||||
try
|
||||
{$Q+}
|
||||
UInt:=UInt - TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalUInt.CreateValue(UInt);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151405,Expr);
|
||||
end;
|
||||
revkUInt:
|
||||
// uint - uint
|
||||
try
|
||||
{$Q+}
|
||||
UInt:=UInt - TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalUInt.CreateValue(UInt);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151419,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// uint - float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=MaxPrecFloat(UInt) - TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151428,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinarySubExpr sub uint-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711151435,Expr);
|
||||
end;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
Flo:=TResEvalFloat(LeftValue).FloatValue;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// float - int
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo - TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151519,Expr);
|
||||
end;
|
||||
revkUInt:
|
||||
// float - uint
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo - TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151538,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// float - float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo - TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711151552,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinarySubExpr sub float-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711151600,Expr);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
@ -1350,25 +1492,28 @@ function TResExprEvaluator.EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue,
|
||||
var
|
||||
Int: MaxPrecInt;
|
||||
UInt: MaxPrecUInt;
|
||||
Flo: MaxPrecFloat;
|
||||
begin
|
||||
Result:=nil;
|
||||
case LeftValue.Kind of
|
||||
revkInt:
|
||||
begin
|
||||
Int:=TResEvalInt(LeftValue).Int;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// int*int
|
||||
// int * int
|
||||
try
|
||||
{$Q+}
|
||||
Int:=TResEvalInt(LeftValue).Int * TResEvalInt(RightValue).Int;
|
||||
Int:=Int * TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
except
|
||||
on E: EOverflow do
|
||||
if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
|
||||
if (Int>0) and (TResEvalInt(RightValue).Int>0) then
|
||||
try
|
||||
// try uint*uint
|
||||
{$Q+}
|
||||
UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int) * MaxPrecUInt(TResEvalInt(RightValue).Int);
|
||||
UInt:=MaxPrecUInt(Int) * MaxPrecUInt(TResEvalInt(RightValue).Int);
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=CreateResEvalInt(UInt);
|
||||
except
|
||||
@ -1378,14 +1523,128 @@ begin
|
||||
else
|
||||
RaiseOverflowArithmetic(20170525230247,Expr);
|
||||
end;
|
||||
// ToDo: int*uint
|
||||
revkUInt:
|
||||
// int * uint
|
||||
try
|
||||
{$Q+}
|
||||
Int:=Int * TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164445,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// int * float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Int * TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164541,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170525230028,Expr);
|
||||
end;
|
||||
// ToDo: uint*int, uint*uint
|
||||
end;
|
||||
revkUInt:
|
||||
begin
|
||||
UInt:=TResEvalUInt(LeftValue).UInt;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// uint * int
|
||||
if TResEvalInt(RightValue).Int>=0 then
|
||||
try
|
||||
{$Q+}
|
||||
UInt:=UInt * TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalUInt.CreateValue(UInt);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711164714,Expr);
|
||||
end
|
||||
else
|
||||
try
|
||||
{$Q+}
|
||||
Int:=UInt * TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalInt.CreateValue(Int);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711164736,Expr);
|
||||
end;
|
||||
revkUInt:
|
||||
// uint * uint
|
||||
try
|
||||
{$Q+}
|
||||
UInt:=UInt * TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalUInt.CreateValue(UInt);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164751,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// uint * float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=UInt * TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164800,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryMulExpr mul uint*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711164810,Expr);
|
||||
end;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
Flo:=TResEvalFloat(LeftValue).FloatValue;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// float * int
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo * TResEvalInt(RightValue).Int;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
on E: EOverflow do
|
||||
RaiseOverflowArithmetic(20170711164920,Expr);
|
||||
end;
|
||||
revkUInt:
|
||||
// float * uint
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo * TResEvalUInt(RightValue).UInt;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164940,Expr);
|
||||
end;
|
||||
revkFloat:
|
||||
// float * float
|
||||
try
|
||||
{$Q+}
|
||||
Flo:=Flo * TResEvalFloat(RightValue).FloatValue;
|
||||
{$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
except
|
||||
RaiseOverflowArithmetic(20170711164955,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryMulExpr mul float*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711165004,Expr);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
@ -1394,6 +1653,122 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue,
|
||||
RightValue: TResEvalValue): TResEvalValue;
|
||||
var
|
||||
Int: MaxPrecInt;
|
||||
UInt: MaxPrecUInt;
|
||||
Flo: MaxPrecFloat;
|
||||
begin
|
||||
Result:=nil;
|
||||
case LeftValue.Kind of
|
||||
revkInt:
|
||||
begin
|
||||
Int:=TResEvalInt(LeftValue).Int;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// int / int
|
||||
if TResEvalInt(RightValue).Int=0 then
|
||||
RaiseDivByZero(20170711143925,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(Int / TResEvalInt(RightValue).Int);
|
||||
revkUInt:
|
||||
// int / uint
|
||||
if TResEvalUInt(RightValue).UInt=0 then
|
||||
RaiseDivByZero(20170711144013,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(Int / TResEvalUInt(RightValue).UInt);
|
||||
revkFloat:
|
||||
begin
|
||||
// int / float
|
||||
try
|
||||
Flo:=Int / TResEvalFloat(RightValue).FloatValue;
|
||||
except
|
||||
RaiseMsg(20170711144525,nDivByZero,sDivByZero,[],Expr);
|
||||
end;
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
end
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryDivideExpr int / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711144057,Expr);
|
||||
end;
|
||||
end;
|
||||
revkUInt:
|
||||
begin
|
||||
UInt:=TResEvalUInt(LeftValue).UInt;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// uint / int
|
||||
if TResEvalInt(RightValue).Int=0 then
|
||||
RaiseDivByZero(20170711144103,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(UInt / TResEvalInt(RightValue).Int);
|
||||
revkUInt:
|
||||
// uint / uint
|
||||
if TResEvalUInt(RightValue).UInt=0 then
|
||||
RaiseDivByZero(20170711144203,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(UInt / TResEvalUInt(RightValue).UInt);
|
||||
revkFloat:
|
||||
begin
|
||||
// uint / float
|
||||
try
|
||||
Flo:=UInt / TResEvalFloat(RightValue).FloatValue;
|
||||
except
|
||||
RaiseMsg(20170711144912,nDivByZero,sDivByZero,[],Expr);
|
||||
end;
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
end
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryDivideExpr uint / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711144239,Expr);
|
||||
end;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
Flo:=TResEvalFloat(LeftValue).FloatValue;
|
||||
case RightValue.Kind of
|
||||
revkInt:
|
||||
// float / int
|
||||
if TResEvalInt(RightValue).Int=0 then
|
||||
RaiseDivByZero(20170711144954,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(Flo / TResEvalInt(RightValue).Int);
|
||||
revkUInt:
|
||||
// float / uint
|
||||
if TResEvalUInt(RightValue).UInt=0 then
|
||||
RaiseDivByZero(20170711145023,Expr)
|
||||
else
|
||||
Result:=TResEvalFloat.CreateValue(Flo / TResEvalUInt(RightValue).UInt);
|
||||
revkFloat:
|
||||
begin
|
||||
// float / float
|
||||
try
|
||||
Flo:=Flo / TResEvalFloat(RightValue).FloatValue;
|
||||
except
|
||||
RaiseMsg(20170711145040,nDivByZero,sDivByZero,[],Expr);
|
||||
end;
|
||||
Result:=TResEvalFloat.CreateValue(Flo);
|
||||
end
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryDivideExpr float / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711145050,Expr);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170530102352,Expr);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
|
||||
RightValue: TResEvalValue): TResEvalValue;
|
||||
var
|
||||
@ -1766,6 +2141,17 @@ begin
|
||||
Result.Free;
|
||||
RaiseNotYetImplemented(20170601122806,Expr);
|
||||
end;
|
||||
revkString:
|
||||
case RightValue.Kind of
|
||||
revkString:
|
||||
TResEvalBool(Result).B:=TResEvalString(LeftValue).S=TResEvalString(RightValue).S;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
Result.Free;
|
||||
RaiseNotYetImplemented(20170711175409,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
@ -1919,6 +2305,26 @@ begin
|
||||
Result.Free;
|
||||
RaiseNotYetImplemented(20170601133421,Expr);
|
||||
end;
|
||||
revkString:
|
||||
case RightValue.Kind of
|
||||
revkString:
|
||||
case Expr.OpCode of
|
||||
eopLessThan:
|
||||
TResEvalBool(Result).B:=TResEvalString(LeftValue).S < TResEvalString(RightValue).S;
|
||||
eopGreaterThan:
|
||||
TResEvalBool(Result).B:=TResEvalString(LeftValue).S > TResEvalString(RightValue).S;
|
||||
eopLessthanEqual:
|
||||
TResEvalBool(Result).B:=TResEvalString(LeftValue).S <= TResEvalString(RightValue).S;
|
||||
eopGreaterThanEqual:
|
||||
TResEvalBool(Result).B:=TResEvalString(LeftValue).S >= TResEvalString(RightValue).S;
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
Result.Free;
|
||||
RaiseNotYetImplemented(20170711175629,Expr);
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
|
||||
@ -1934,6 +2340,76 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalParamsExpr(Expr: TParamsExpr;
|
||||
Flags: TResEvalFlags): TResEvalValue;
|
||||
var
|
||||
ArrayValue, IndexValue: TResEvalValue;
|
||||
Int: MaxPrecInt;
|
||||
Param0: TPasExpr;
|
||||
MaxIndex: Integer;
|
||||
begin
|
||||
Result:=OnEvalParams(Self,Expr,Flags);
|
||||
if Result<>nil then exit;
|
||||
ArrayValue:=Eval(Expr.Value,Flags);
|
||||
if ArrayValue=nil then
|
||||
begin
|
||||
if (refConst in Flags) then
|
||||
RaiseConstantExprExp(20170711181321,Expr.Value);
|
||||
exit;
|
||||
end;
|
||||
IndexValue:=nil;
|
||||
try
|
||||
case ArrayValue.Kind of
|
||||
revkString,revkUnicodeString:
|
||||
begin
|
||||
Param0:=Expr.Params[0];
|
||||
IndexValue:=Eval(Param0,Flags);
|
||||
if IndexValue=nil then
|
||||
begin
|
||||
if (refConst in Flags) then
|
||||
RaiseConstantExprExp(20170711181603,Param0);
|
||||
exit;
|
||||
end;
|
||||
case IndexValue.Kind of
|
||||
revkInt: Int:=TResEvalInt(IndexValue).Int;
|
||||
revkUInt:
|
||||
if TResEvalUInt(IndexValue).UInt>High(MaxPrecInt) then
|
||||
RaiseRangeCheck(20170711182006,Param0)
|
||||
else
|
||||
Int:=TResEvalUInt(IndexValue).UInt;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalParamsExpr string[',IndexValue.AsDebugString,']');
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711182100,Expr);
|
||||
end;
|
||||
if ArrayValue.Kind=revkString then
|
||||
MaxIndex:=length(TResEvalString(ArrayValue).S)
|
||||
else
|
||||
MaxIndex:=length(TResEvalUTF16(ArrayValue).S);
|
||||
if (Int<1) or (Int>MaxIndex) then
|
||||
EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError);
|
||||
if ArrayValue.Kind=revkString then
|
||||
Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int])
|
||||
else
|
||||
Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]);
|
||||
exit;
|
||||
end;
|
||||
else
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TResExprEvaluator.EvalParamsExpr Array=',ArrayValue.AsDebugString);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711181507,Expr);
|
||||
end;
|
||||
|
||||
if (refConst in Flags) then
|
||||
RaiseConstantExprExp(20170522173150,Expr);
|
||||
finally
|
||||
ReleaseEvalValue(ArrayValue);
|
||||
ReleaseEvalValue(IndexValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
|
||||
RightValue: TResEvalValue): TResEvalValue;
|
||||
var
|
||||
@ -2009,45 +2485,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalArrayParams(Expr: TParamsExpr;
|
||||
Flags: TResEvalFlags): TResEvalValue;
|
||||
begin
|
||||
Result:=nil;
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TResExprEvaluator.EvalArrayParams ');
|
||||
{$ENDIF}
|
||||
if refConst in Flags then
|
||||
RaiseConstantExprExp(20170522173151,Expr);
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalFuncParams(Expr: TParamsExpr;
|
||||
Flags: TResEvalFlags): TResEvalValue;
|
||||
begin
|
||||
Result:=nil;
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TResExprEvaluator.EvalFuncParams ');
|
||||
{$ENDIF}
|
||||
Result:=OnEvalParams(Self,Expr,Flags);
|
||||
if (refConst in Flags) and (Result=nil) then
|
||||
RaiseConstantExprExp(20170522173150,Expr);
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags
|
||||
): TResEvalValue;
|
||||
begin
|
||||
Result:=nil;
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TResExprEvaluator.EvalSetParams ');
|
||||
{$ENDIF}
|
||||
if length(Expr.Params)=0 then
|
||||
begin
|
||||
Result:=TResEvalValue.CreateKind(revkSetEmpty);
|
||||
exit;
|
||||
end;
|
||||
if refConst in Flags then
|
||||
RaiseConstantExprExp(20170522173152,Expr);
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
|
||||
PosEl: TPasElement): longword;
|
||||
var
|
||||
@ -2339,13 +2776,7 @@ begin
|
||||
else if C=TBinaryExpr then
|
||||
Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
|
||||
else if C=TParamsExpr then
|
||||
case TParamsExpr(Expr).Kind of
|
||||
pekArrayParams: Result:=EvalArrayParams(TParamsExpr(Expr),Flags);
|
||||
pekFuncParams: Result:=EvalFuncParams(TParamsExpr(Expr),Flags);
|
||||
pekSet: Result:=EvalSetParams(TParamsExpr(Expr),Flags);
|
||||
else
|
||||
RaiseInternalError(20170522173013);
|
||||
end
|
||||
Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
|
||||
else if refConst in Flags then
|
||||
RaiseConstantExprExp(20170518213800,Expr);
|
||||
end;
|
||||
@ -2535,16 +2966,17 @@ begin
|
||||
end;
|
||||
|
||||
procedure TResExprEvaluator.EmitRangeCheckConst(id: int64; const aValue,
|
||||
MinVal, MaxVal: String; PosEl: TPasElement);
|
||||
MinVal, MaxVal: String; PosEl: TPasElement; MsgType: TMessageType);
|
||||
begin
|
||||
LogMsg(id,mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
|
||||
LogMsg(id,MsgType,nRangeCheckEvaluatingConstantsVMinMax,
|
||||
sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
|
||||
end;
|
||||
|
||||
procedure TResExprEvaluator.EmitRangeCheckConst(id: int64;
|
||||
const aValue: String; MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
|
||||
const aValue: String; MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement;
|
||||
MsgType: TMessageType);
|
||||
begin
|
||||
EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl);
|
||||
EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl,MsgType);
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
|
||||
|
||||
@ -5769,7 +5769,7 @@ begin
|
||||
end
|
||||
else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
|
||||
// ok
|
||||
else if (Access=rraRead)
|
||||
else if (Access in [rraRead,rraParamToUnknownProc])
|
||||
and ((C=TPrimitiveExpr)
|
||||
or (C=TNilExpr)
|
||||
or (C=TBoolConstExpr)) then
|
||||
@ -7513,6 +7513,7 @@ var
|
||||
Value: TResEvalValue;
|
||||
Int: MaxPrecInt;
|
||||
MinIntVal, MaxIntVal: int64;
|
||||
Flo: MaxPrecFloat;
|
||||
begin
|
||||
Result:=nil;
|
||||
{$IFDEF VerbosePasResEval}
|
||||
@ -7528,9 +7529,6 @@ begin
|
||||
if bt=btQWord then
|
||||
begin
|
||||
// int to qword
|
||||
if (Int<0) then
|
||||
fExprEvaluator.EmitRangeCheckConst(20170624195049,
|
||||
Value.AsString,'0',IntToStr(High(qword)),Params);
|
||||
{$R-}
|
||||
Result:=TResEvalUInt.CreateValue(MaxPrecUInt(Int));
|
||||
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
||||
@ -7541,21 +7539,21 @@ begin
|
||||
GetIntegerRange(bt,MinIntVal,MaxIntVal);
|
||||
if (Int<MinIntVal) or (Int>MaxIntVal) then
|
||||
begin
|
||||
fExprEvaluator.EmitRangeCheckConst(20170624194534,
|
||||
Value.AsString,MinIntVal,MaxIntVal,Params);
|
||||
{$R-}
|
||||
case bt of
|
||||
btByte: Result:=TResEvalInt.CreateValue(byte(Int),reitByte);
|
||||
btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);// ToDo: negative
|
||||
btShortInt: Result:=TResEvalInt.CreateValue(shortint(Int),reitShortInt);
|
||||
btWord: Result:=TResEvalInt.CreateValue(word(Int),reitWord);
|
||||
btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);// ToDo: negative
|
||||
btUIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitUIntSingle);// ToDo: negative
|
||||
btIntSingle: Result:=TResEvalInt.CreateValue(Int and MaskUIntSingle,reitIntSingle);// ToDo: negative
|
||||
btSmallInt: Result:=TResEvalInt.CreateValue(smallint(Int),reitSmallInt);
|
||||
btLongWord: Result:=TResEvalInt.CreateValue(longword(Int),reitLongWord);
|
||||
btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);// ToDo: negative
|
||||
btUIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitUIntDouble);// ToDo: negative
|
||||
btIntDouble: Result:=TResEvalInt.CreateValue(Int and MaskUIntDouble,reitIntDouble);// ToDo: negative
|
||||
btLongint: Result:=TResEvalInt.CreateValue(longint(Int),reitLongInt);
|
||||
btInt64: Result:=TResEvalInt.CreateValue(Int);
|
||||
btUIntSingle,
|
||||
btIntSingle,
|
||||
btUIntDouble,
|
||||
btIntDouble:
|
||||
fExprEvaluator.EmitRangeCheckConst(20170624194534,
|
||||
Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
|
||||
else
|
||||
RaiseNotYetImplemented(20170624200109,Params);
|
||||
end;
|
||||
@ -7583,6 +7581,26 @@ begin
|
||||
end;
|
||||
exit;
|
||||
end
|
||||
else if bt=btboolean then
|
||||
case Int of
|
||||
0: Result:=TResEvalBool.CreateValue(false);
|
||||
1: Result:=TResEvalBool.CreateValue(true);
|
||||
else
|
||||
fExprEvaluator.EmitRangeCheckConst(20170710203254,
|
||||
Value.AsString,0,1,Params,mtError);
|
||||
end
|
||||
else if bt=btSingle then
|
||||
try
|
||||
Result:=TResEvalFloat.CreateValue(Single(Int))
|
||||
except
|
||||
RaiseMsg(20170711002015,nRangeCheckError,sRangeCheckError,[],Params);
|
||||
end
|
||||
else if bt=btDouble then
|
||||
try
|
||||
Result:=TResEvalFloat.CreateValue(Double(Int))
|
||||
except
|
||||
RaiseMsg(20170711002016,nRangeCheckError,sRangeCheckError,[],Params);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$IFDEF VerbosePasResEval}
|
||||
@ -7591,6 +7609,66 @@ begin
|
||||
RaiseNotYetImplemented(20170624194308,Params);
|
||||
end;
|
||||
end;
|
||||
revkFloat:
|
||||
begin
|
||||
Flo:=TResEvalFloat(Value).FloatValue;
|
||||
if bt in (btAllInteger-[btQWord]) then
|
||||
begin
|
||||
// float to int
|
||||
GetIntegerRange(bt,MinIntVal,MaxIntVal);
|
||||
if (Flo<MinIntVal) or (Flo>MaxIntVal) then
|
||||
fExprEvaluator.EmitRangeCheckConst(20170711001228,
|
||||
Value.AsString,MinIntVal,MaxIntVal,Params,mtError);
|
||||
{$R-}
|
||||
try
|
||||
Int:=Round(Flo);
|
||||
except
|
||||
RaiseMsg(20170711002218,nRangeCheckError,sRangeCheckError,[],Params);
|
||||
end;
|
||||
case bt of
|
||||
btByte: Result:=TResEvalInt.CreateValue(Int,reitByte);
|
||||
btShortInt: Result:=TResEvalInt.CreateValue(Int,reitShortInt);
|
||||
btWord: Result:=TResEvalInt.CreateValue(Int,reitWord);
|
||||
btSmallInt: Result:=TResEvalInt.CreateValue(Int,reitSmallInt);
|
||||
btUIntSingle: Result:=TResEvalInt.CreateValue(Int,reitUIntSingle);
|
||||
btIntSingle: Result:=TResEvalInt.CreateValue(Int,reitIntSingle);
|
||||
btLongWord: Result:=TResEvalInt.CreateValue(Int,reitLongWord);
|
||||
btLongint: Result:=TResEvalInt.CreateValue(Int,reitLongInt);
|
||||
btUIntDouble: Result:=TResEvalInt.CreateValue(Int,reitUIntDouble);
|
||||
btIntDouble: Result:=TResEvalInt.CreateValue(Int,reitIntDouble);
|
||||
btInt64: Result:=TResEvalInt.CreateValue(Int);
|
||||
else
|
||||
RaiseNotYetImplemented(20170711001513,Params);
|
||||
end;
|
||||
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
||||
exit;
|
||||
end
|
||||
else if bt=btSingle then
|
||||
begin
|
||||
// float to single
|
||||
try
|
||||
Result:=TResEvalFloat.CreateValue(single(Flo));
|
||||
except
|
||||
RaiseMsg(20170711002315,nRangeCheckError,sRangeCheckError,[],Params);
|
||||
end;
|
||||
end
|
||||
else if bt=btDouble then
|
||||
begin
|
||||
// float to double
|
||||
try
|
||||
Result:=TResEvalFloat.CreateValue(double(Flo));
|
||||
except
|
||||
RaiseMsg(20170711002327,nRangeCheckError,sRangeCheckError,[],Params);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TPasResolver.OnExprEvalParams typecast float to ',bt);
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20170711002542,Params);
|
||||
end;
|
||||
end
|
||||
else
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TPasResolver.OnExprEvalParams typecast to ',bt);
|
||||
@ -7613,7 +7691,7 @@ begin
|
||||
Result:=fExprEvaluator.Eval(Expr,Flags);
|
||||
if Result=nil then exit;
|
||||
{$IFDEF VerbosePasResEval}
|
||||
writeln('TPasResolver.Eval Result=',Result.AsString);
|
||||
writeln('TPasResolver.Eval Result=',Result.AsDebugString);
|
||||
{$ENDIF}
|
||||
|
||||
if Store
|
||||
@ -10716,6 +10794,9 @@ begin
|
||||
// simple type check is enough
|
||||
else if RValue.Kind=revkBool then
|
||||
// simple type check is enough
|
||||
else if LeftResolved.BaseType in [btSingle,btDouble] then
|
||||
// simple type check is enough
|
||||
// ToDo: check if precision loss
|
||||
else
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
|
||||
@ -170,7 +170,7 @@ type
|
||||
Procedure TestAliasTypeNotFoundPosition;
|
||||
Procedure TestTypeAliasType; // ToDo
|
||||
|
||||
// var, const
|
||||
// vars, const
|
||||
Procedure TestVarLongint;
|
||||
Procedure TestVarInteger;
|
||||
Procedure TestConstInteger;
|
||||
@ -184,15 +184,21 @@ type
|
||||
Procedure TestArgWrongExprFail;
|
||||
Procedure TestVarExternal;
|
||||
Procedure TestVarNoSemicolonBeginFail;
|
||||
Procedure TestConstIntOperators;
|
||||
Procedure TestConstBitwiseOps;
|
||||
Procedure TestIntegerTypeCast;
|
||||
Procedure TestConstBoolOperators;
|
||||
Procedure TestBoolTypeCast;
|
||||
Procedure TestConstFloatOperators;
|
||||
Procedure TestFloatTypeCast;
|
||||
|
||||
// integer range
|
||||
Procedure TestIntegerRange;
|
||||
Procedure TestIntegerRangeHighLowerLowFail;
|
||||
Procedure TestIntegerRangeLowHigh;
|
||||
Procedure TestAssignIntRangeFail;
|
||||
Procedure TestByteRangeFail;
|
||||
Procedure TestCustomIntRangeFail;
|
||||
Procedure TestConstIntOperators;
|
||||
Procedure TestConstBitwiseOps;
|
||||
Procedure TestConstBoolOperators;
|
||||
|
||||
// strings
|
||||
Procedure TestChar_Ord;
|
||||
@ -2131,6 +2137,137 @@ begin
|
||||
nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstIntOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' integer = longint;',
|
||||
'const',
|
||||
' a:byte=1+2;',
|
||||
' b:shortint=1-2;',
|
||||
' c:word=2*3;',
|
||||
' d:smallint=5 div 2;',
|
||||
' e:longword=5 mod 2;',
|
||||
' f:longint=5 shl 2;',
|
||||
' g:qword=5 shr 2;',
|
||||
' h:boolean=5=2;',
|
||||
' i:boolean=5<>2;',
|
||||
' j:boolean=5<2;',
|
||||
' k:boolean=5>2;',
|
||||
' l:boolean=5<=2;',
|
||||
' m:boolean=5>=2;',
|
||||
' n:longword=5 and 2;',
|
||||
' o:longword=5 or 2;',
|
||||
' p:longword=5 xor 2;',
|
||||
' q:longword=not (5 or not 2);',
|
||||
' r=low(word)+high(int64);',
|
||||
' s=low(longint)+high(integer);',
|
||||
' t=succ(2)+pred(2);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstBitwiseOps;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=3;',
|
||||
' b=not a;',
|
||||
' c=not word(a);',
|
||||
' d=1 shl 2;',
|
||||
' e=13 shr 1;',
|
||||
' f=13 and 5;',
|
||||
' g=10 or 5;',
|
||||
' h=5 xor 7;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestIntegerTypeCast;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=longint(-11);',
|
||||
' b=not shortint(-12);',
|
||||
' c=word(-2);',
|
||||
' d=word(longword(-3));',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstBoolOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=true and false;',
|
||||
' b=true or false;',
|
||||
' c=true xor false;',
|
||||
' d=not b;',
|
||||
' e=a=b;',
|
||||
' f=a<>b;',
|
||||
' g=low(boolean) or high(boolean);',
|
||||
' h=succ(false) or pred(true);',
|
||||
' i=ord(false)+ord(true);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestBoolTypeCast;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('var');
|
||||
Add(' a: boolean = boolean(0);');
|
||||
Add(' b: boolean = boolean(1);');
|
||||
Add('begin');
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstFloatOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=4/2 + 6.1/3 + 8.1/4.1 + 10/5.1;',
|
||||
' b=(1.1+1) + (2.1+3.1) + (4+5.1);',
|
||||
' c=(1.1-1) + (2.1-3.1) + (4-5.1);',
|
||||
' d=4*2 + 6.1*3 + 8.1*4.1 + 10*5.1;',
|
||||
' e=a=b;',
|
||||
' f=a<>b;',
|
||||
' g=a>b;',
|
||||
' h=a>=b;',
|
||||
' i=a<b;',
|
||||
' j=a<=b;',
|
||||
' k=(1.1<1) or (2.1<3.1) or (4<5.1);',
|
||||
' l=(1.1=1) or (2.1=3.1) or (4=5.1);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestFloatTypeCast;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=-123456890123456789012345;',
|
||||
' b: double=-123456890123456789012345;',
|
||||
' c=single(double(-123456890123456789012345));',
|
||||
' d=single(-1);',
|
||||
' e=single(word(-1));',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestIntegerRange;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2217,75 +2354,6 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstIntOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' integer = longint;',
|
||||
'const',
|
||||
' a:byte=1+2;',
|
||||
' b:shortint=1-2;',
|
||||
' c:word=2*3;',
|
||||
' d:smallint=5 div 2;',
|
||||
' e:longword=5 mod 2;',
|
||||
' f:longint=5 shl 2;',
|
||||
' g:qword=5 shr 2;',
|
||||
' h:boolean=5=2;',
|
||||
' i:boolean=5<>2;',
|
||||
' j:boolean=5<2;',
|
||||
' k:boolean=5>2;',
|
||||
' l:boolean=5<=2;',
|
||||
' m:boolean=5>=2;',
|
||||
' n:longword=5 and 2;',
|
||||
' o:longword=5 or 2;',
|
||||
' p:longword=5 xor 2;',
|
||||
' q:longword=not (5 or not 2);',
|
||||
' r=low(word)+high(int64);',
|
||||
' s=low(longint)+high(integer);',
|
||||
' t=succ(2)+pred(2);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstBitwiseOps;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=3;',
|
||||
' b=not a;',
|
||||
' c=not word(a);',
|
||||
' d=1 shl 2;',
|
||||
' e=13 shr 1;',
|
||||
' f=13 and 5;',
|
||||
' g=10 or 5;',
|
||||
' h=5 xor 7;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestConstBoolOperators;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=true and false;',
|
||||
' b=true or false;',
|
||||
' c=true xor false;',
|
||||
' d=not b;',
|
||||
' e=a=b;',
|
||||
' f=a<>b;',
|
||||
' g=low(boolean) or high(boolean);',
|
||||
' h=succ(false) or pred(true);',
|
||||
' i=ord(false)+ord(true);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestChar_Ord;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -2396,7 +2464,16 @@ begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' a=''o''+''x'';',
|
||||
' a=''o''+''x''+''''+''ab'';',
|
||||
' b=#65#66;',
|
||||
' c=a=b;',
|
||||
' d=a<>b;',
|
||||
' e=a<b;',
|
||||
' f=a<=b;',
|
||||
' g=a>b;',
|
||||
' h=a>=b;',
|
||||
' i=a[1];',
|
||||
' j=length(a);',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
CheckResolverUnexpectedHints;
|
||||
|
||||
@ -267,7 +267,6 @@ ToDos:
|
||||
- pointer of record
|
||||
- nested types in class
|
||||
- asm: pas() - useful for overloads and protect an identifier from optimization
|
||||
- source maps
|
||||
- ifthen
|
||||
- stdcall of methods: pass original 'this' as first parameter
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user