mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 15:39:29 +02:00
pastojs: emulate compile time assign integer constant of different type
This commit is contained in:
mattias
Michaël Van Canneyt
parent
89d3d866d2
commit
4fdeada0a5
@ -787,7 +787,7 @@ type
|
||||
function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
|
||||
function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
|
||||
LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
|
||||
function LoHiValue(Value: TResEvalValue; ShiftSize: Integer; Mask: LongWord;
|
||||
function ShiftAndMaskValue(Value: TResEvalValue; ShiftSize: Integer; Mask: LongWord;
|
||||
ErrorEl: TPasElement): TResEvalValue; virtual;
|
||||
function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
|
||||
Flags: TResEvalFlags): TResEvalEnum; virtual;
|
||||
@ -5273,7 +5273,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResExprEvaluator.LoHiValue(Value: TResEvalValue; ShiftSize: Integer;
|
||||
function TResExprEvaluator.ShiftAndMaskValue(Value: TResEvalValue; ShiftSize: Integer;
|
||||
Mask: LongWord; ErrorEl: TPasElement): TResEvalValue;
|
||||
var
|
||||
uint: LongWord;
|
||||
|
||||
@ -20088,7 +20088,7 @@ begin
|
||||
try
|
||||
ComputeElement(Param,ResolvedParam,[]);
|
||||
Shift := GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType, Proc.BuiltIn=bfLo, Mask);
|
||||
Evaluated := fExprEvaluator.LoHiValue(Value,Shift,Mask,Params);
|
||||
Evaluated := fExprEvaluator.ShiftAndMaskValue(Value,Shift,Mask,Params);
|
||||
finally
|
||||
ReleaseEvalValue(Value);
|
||||
end;
|
||||
@ -27920,7 +27920,7 @@ begin
|
||||
writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
|
||||
{$ENDIF}
|
||||
case TUnaryExpr(El).OpCode of
|
||||
eopAdd, eopSubtract:
|
||||
eopAdd:
|
||||
if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
|
||||
exit
|
||||
else if IsGenericTemplType(ResolvedEl) then
|
||||
@ -27928,6 +27928,24 @@ begin
|
||||
else
|
||||
RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
[OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
|
||||
eopSubtract:
|
||||
if ResolvedEl.BaseType in (btAllSignedInteger+btAllFloats) then
|
||||
exit
|
||||
else if ResolvedEl.BaseType in btAllInteger then
|
||||
begin
|
||||
case ResolvedEl.BaseType of
|
||||
btByte,btWord:
|
||||
ResolvedEl.BaseType:=btLongint;
|
||||
btLongWord,btUIntDouble:
|
||||
ResolvedEl.BaseType:=btIntDouble;
|
||||
end;
|
||||
exit;
|
||||
end
|
||||
else if IsGenericTemplType(ResolvedEl) then
|
||||
exit
|
||||
else
|
||||
RaiseMsg(20210815225815,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
|
||||
[OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
|
||||
eopNot:
|
||||
begin
|
||||
if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
|
||||
|
||||
@ -462,6 +462,9 @@ unit FPPas2Js;
|
||||
{$define HasInt64}
|
||||
{$endif}
|
||||
|
||||
{$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
|
||||
{$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -2076,6 +2079,7 @@ type
|
||||
RTLFunc: TPas2JSBuiltInName; PosEl: TPasElement): TJSCallExpression; virtual;
|
||||
Function CreateRangeCheckCall_TypeRange(aType: TPasType; GetExpr: TJSElement;
|
||||
AContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
|
||||
Procedure PrepareAssignDifferentIntegers(El: TPasImplAssign; AssignContext: TAssignContext); virtual;
|
||||
// reference
|
||||
Function CreateReferencePath(El: TPasElement; AContext: TConvertContext;
|
||||
Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
|
||||
@ -13745,7 +13749,6 @@ begin
|
||||
end;
|
||||
btString:
|
||||
begin
|
||||
writeln('AAA1 TPasToJSConverter.ConvertBuiltIn_LowHigh ',IsLow);
|
||||
if isLow then
|
||||
// low(aString) -> 1
|
||||
Result:=CreateLiteralNumber(El,1)
|
||||
@ -14262,7 +14265,7 @@ begin
|
||||
RaiseInconsistency(20190129102200,El);
|
||||
Param := El.Params[0];
|
||||
AContext.Resolver.ComputeElement(Param,ResolvedParam,[]);
|
||||
if not (ResolvedParam.BaseType in btAllInteger) then
|
||||
if not (ResolvedParam.BaseType in btAllJSInteger) then
|
||||
DoError(20190129121100,nXExpectedButYFound,sXExpectedButYFound,['integer type',
|
||||
AContext.Resolver.GetResolverResultDescription(ResolvedParam)],Param);
|
||||
Shift := AContext.Resolver.GetShiftAndMaskForLoHiFunc(ResolvedParam.BaseType,IsLoFunc,Mask);
|
||||
@ -22301,6 +22304,7 @@ begin
|
||||
end;
|
||||
if AssignContext.RightSide=nil then
|
||||
AssignContext.RightSide:=ConvertExpression(El.right,AContext);
|
||||
|
||||
if (AssignContext.RightResolved.BaseType in [btSet,btArrayOrSet])
|
||||
and (AssignContext.RightResolved.IdentEl<>nil) then
|
||||
begin
|
||||
@ -22335,6 +22339,13 @@ begin
|
||||
// e.g. double := currency -> double := currency/10000
|
||||
AssignContext.RightSide:=CreateDivideNumber(El,AssignContext.RightSide,10000);
|
||||
end
|
||||
else if (AssignContext.LeftResolved.BaseType<>AssignContext.RightResolved.BaseType)
|
||||
and (AssignContext.LeftResolved.BaseType in btAllJSInteger)
|
||||
and (AssignContext.RightResolved.BaseType in btAllJSInteger) then
|
||||
begin
|
||||
// AnInteger := OtherInteger
|
||||
PrepareAssignDifferentIntegers(El,AssignContext);
|
||||
end
|
||||
else if AssignContext.RightResolved.BaseType in btAllStringAndChars then
|
||||
begin
|
||||
if AssignContext.LeftResolved.BaseType=btContext then
|
||||
@ -22539,6 +22550,7 @@ begin
|
||||
if (bsRangeChecks in AContext.ScannerBoolSwitches)
|
||||
and not (T.Expr is TJSLiteral) then
|
||||
begin
|
||||
// range checks
|
||||
if AssignContext.LeftResolved.BaseType in btAllJSInteger then
|
||||
begin
|
||||
if LeftTypeEl is TPasUnresolvedSymbolRef then
|
||||
@ -24800,6 +24812,97 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasToJSConverter.PrepareAssignDifferentIntegers(El: TPasImplAssign;
|
||||
AssignContext: TAssignContext);
|
||||
|
||||
function CutToUIntDouble(IntValue: TMaxPrecInt): TMaxPrecInt;
|
||||
begin
|
||||
{$IFDEF pas2js}
|
||||
Result:=((IntValue div $80000000) and $003fffff)*$80000000 +(IntValue and $7FFFFFFF);
|
||||
{$ELSE}
|
||||
Result:=IntValue and MaxSafeIntDouble;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
var
|
||||
aResolver: TPas2JSResolver;
|
||||
LeftBT, RightBT: TResolverBaseType;
|
||||
Value: TResEvalValue;
|
||||
IntValue, LeftMinVal, LeftMaxVal, RightMinVal, RightMaxVal: TMaxPrecInt;
|
||||
begin
|
||||
aResolver:=AssignContext.Resolver;
|
||||
LeftBT:=AssignContext.LeftResolved.BaseType;
|
||||
RightBT:=AssignContext.RightResolved.BaseType;
|
||||
|
||||
if not aResolver.GetIntegerRange(LeftBT,LeftMinVal,LeftMaxVal) then
|
||||
RaiseNotSupported(El.left,AssignContext,20210815195159);
|
||||
if not aResolver.GetIntegerRange(RightBT,RightMinVal,RightMaxVal) then
|
||||
RaiseNotSupported(El.right,AssignContext,20210815195228);
|
||||
if (LeftMinVal<=RightMinVal) and (LeftMaxVal>=RightMaxVal) then
|
||||
exit; // right is subset of left
|
||||
|
||||
// right might not fit into left
|
||||
|
||||
Value:=aResolver.Eval(El.right,[]);
|
||||
try
|
||||
if Value<>nil then
|
||||
begin
|
||||
if Value.Kind=revkInt then
|
||||
begin
|
||||
IntValue:=TResEvalInt(Value).Int;
|
||||
if (IntValue>=LeftMinVal) and (IntValue<=LeftMaxVal) then
|
||||
exit;
|
||||
end
|
||||
else if Value.Kind=revkUInt then
|
||||
begin
|
||||
if TResEvalUInt(Value).UInt<=HighIntAsUInt then
|
||||
begin
|
||||
IntValue:=TMaxPrecInt(TResEvalUInt(Value).UInt);
|
||||
if (IntValue>=LeftMinVal) and (IntValue<=LeftMaxVal) then
|
||||
exit;
|
||||
end
|
||||
else
|
||||
{$IFDEF Pas2js}
|
||||
RaiseNotSupported(El.right,AssignContext,20210815214534);
|
||||
{$ELSE}
|
||||
IntValue:=PMaxPrecInt(@TResEvalUInt(Value).UInt)^;
|
||||
{$ENDIF}
|
||||
end
|
||||
else
|
||||
RaiseNotSupported(El.right,AssignContext,20210815204203,'right='+Value.AsDebugString);
|
||||
|
||||
case LeftBT of
|
||||
btByte: IntValue:=IntValue and $FF; // Note: "and" handles negative numbers
|
||||
btShortInt:
|
||||
begin
|
||||
IntValue:=(IntValue and $FF);
|
||||
if IntValue>$7F then IntValue:=IntValue-$100;
|
||||
end;
|
||||
btWord: IntValue:=IntValue and $FFFF;
|
||||
btSmallInt:
|
||||
begin
|
||||
IntValue:=(IntValue and $FFFF);
|
||||
if IntValue>$7FFF then IntValue:=IntValue-$10000;
|
||||
end;
|
||||
btLongWord: IntValue:=IntValue and $FFFFFFFF;
|
||||
btLongint:
|
||||
begin
|
||||
IntValue:=(IntValue and $FFFFFFFF);
|
||||
if IntValue>$7FFFFFFF then IntValue:=IntValue-$100000000;
|
||||
end;
|
||||
btUIntDouble:
|
||||
IntValue:=CutToUIntDouble(IntValue);
|
||||
btIntDouble:
|
||||
IntValue:=CutToUIntDouble(IntValue);
|
||||
end;
|
||||
|
||||
AssignContext.RightSide:=CreateLiteralNumber(El.right,IntValue);
|
||||
end;
|
||||
finally
|
||||
ReleaseEvalValue(Value);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateReferencePath(El: TPasElement;
|
||||
AContext: TConvertContext; Kind: TRefPathKind; Full: boolean;
|
||||
Ref: TResolvedReference): string;
|
||||
|
||||
@ -277,6 +277,7 @@ type
|
||||
Procedure TestInteger_BitwiseShrNativeInt;
|
||||
Procedure TestInteger_BitwiseShlNativeInt;
|
||||
Procedure TestInteger_SystemFunc;
|
||||
Procedure TestInteger_AssignOutsideConst;
|
||||
Procedure TestCurrency;
|
||||
Procedure TestForBoolDo;
|
||||
Procedure TestForIntDo;
|
||||
@ -3159,8 +3160,8 @@ begin
|
||||
'this.HiByte2 = (0x1234 >> 8) & 0xFF;',
|
||||
'this.LoWord1 = 0x1234CDEF & 0xFFFF;',
|
||||
'this.HiWord1 = (0x1234CDEF >> 16) & 0xFFFF;',
|
||||
'this.LoWord2 = -0x1234CDEF & 0xFFFF;',
|
||||
'this.HiWord2 = (-0x1234CDEF >> 16) & 0xFFFF;',
|
||||
'this.LoWord2 = -0x1234CDEF >>> 0;',
|
||||
'this.HiWord2 = Math.floor(-0x1234CDEF / 4294967296) >>> 0;',
|
||||
'this.lo4 = 0x34 & 0xF;',
|
||||
'this.hi4 = (0x34 >> 4) & 0xF;',
|
||||
'this.lo5 = (((-0x34 & 255) << 24) >> 24) & 0xFF;',
|
||||
@ -7463,6 +7464,106 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestInteger_AssignOutsideConst;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'const',
|
||||
' MinInt = low(longint);',
|
||||
' MaxInt = high(longint);',
|
||||
'type',
|
||||
' {#TMyInt}TMyInt = MinInt..MaxInt;',
|
||||
'var',
|
||||
' i: TMyInt;',
|
||||
' aByte: byte;',
|
||||
' aShortInt: shortint;',
|
||||
' aWord: word;',
|
||||
' aSmallInt: smallint;',
|
||||
' aLongWord: longword;',
|
||||
' aLongInt: longint;',
|
||||
' aNativeInt: nativeint;',
|
||||
' aNativeUInt: nativeuint;',
|
||||
'begin',
|
||||
' aByte:=$FF;',
|
||||
' aByte:=$100;',
|
||||
' aByte:=-1;',
|
||||
' aByte:=-127;',
|
||||
' aByte:=-128;',
|
||||
' aByte:=-254;',
|
||||
' aByte:=-255;',
|
||||
' aByte:=-256;',
|
||||
' aShortInt:=127;',
|
||||
' aShortInt:=128;',
|
||||
' aShortInt:=-128;',
|
||||
' aShortInt:=-129;',
|
||||
' aWord:=$ffff;',
|
||||
' aWord:=$10000;',
|
||||
' aWord:=-1;',
|
||||
' aWord:=-$ffff;',
|
||||
' aWord:=-$10000;',
|
||||
' aWord:=-$10001;',
|
||||
' aSmallInt:=$7fff;',
|
||||
' aSmallInt:=$8000;',
|
||||
' aSmallInt:=-$8000;',
|
||||
' aSmallInt:=-$8001;',
|
||||
' aLongWord:=$ffffffff;',
|
||||
' aLongWord:=$100000000;',
|
||||
' aLongWord:=-1;',
|
||||
' aLongWord:=-$ffffffff;',
|
||||
' aNativeInt:=$1fffffffffffff;',
|
||||
' aNativeInt:=-$1fffffffffffff;',
|
||||
' aNativeUInt:=$1fffffffffffff;',
|
||||
' aNativeUInt:=-$1fffffffffffff;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestInteger_AssignOutsideConst',
|
||||
LinesToStr([
|
||||
'this.MinInt = -2147483648;',
|
||||
'this.MaxInt = 2147483647;',
|
||||
'this.i = 0;',
|
||||
'this.aByte = 0;',
|
||||
'this.aShortInt = 0;',
|
||||
'this.aWord = 0;',
|
||||
'this.aSmallInt = 0;',
|
||||
'this.aLongWord = 0;',
|
||||
'this.aLongInt = 0;',
|
||||
'this.aNativeInt = 0;',
|
||||
'this.aNativeUInt = 0;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.aByte = 0xFF;',
|
||||
'$mod.aByte = 0;',
|
||||
'$mod.aByte = 255;',
|
||||
'$mod.aByte = 129;',
|
||||
'$mod.aByte = 128;',
|
||||
'$mod.aByte = 2;',
|
||||
'$mod.aByte = 1;',
|
||||
'$mod.aByte = 0;',
|
||||
'$mod.aShortInt = 127;',
|
||||
'$mod.aShortInt = -128;',
|
||||
'$mod.aShortInt = -128;',
|
||||
'$mod.aShortInt = 127;',
|
||||
'$mod.aWord = 0xffff;',
|
||||
'$mod.aWord = 0;',
|
||||
'$mod.aWord = 65535;',
|
||||
'$mod.aWord = 1;',
|
||||
'$mod.aWord = 0;',
|
||||
'$mod.aWord = 65535;',
|
||||
'$mod.aSmallInt = 0x7fff;',
|
||||
'$mod.aSmallInt = -32768;',
|
||||
'$mod.aSmallInt = -0x8000;',
|
||||
'$mod.aSmallInt = 32767;',
|
||||
'$mod.aLongWord = 0xffffffff;',
|
||||
'$mod.aLongWord = 0;',
|
||||
'$mod.aLongWord = 4294967295;',
|
||||
'$mod.aLongWord = 1;',
|
||||
'$mod.aNativeInt = 0x1fffffffffffff;',
|
||||
'$mod.aNativeInt = -0x1fffffffffffff;',
|
||||
'$mod.aNativeUInt = 0x1fffffffffffff;',
|
||||
'$mod.aNativeUInt = 1;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestCurrency;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user