mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 20:40:37 +02:00
pastojs: typecast int(int)
git-svn-id: trunk@38842 -
This commit is contained in:
Mattias Gaertner
parent
2750a0010c
commit
80b008b76d
@ -7962,6 +7962,43 @@ var
|
||||
JSBaseType:=JSBaseTypeData.JSBaseType;
|
||||
end;
|
||||
|
||||
function CreateModulo(Value: TJSElement; const Mask: MaxPrecInt; Sign: boolean): TJSElement;
|
||||
// ig sign=false: Value & Mask
|
||||
// if sign=true: Value & Mask << ZeroBits >> ZeroBits
|
||||
var
|
||||
ModEx: TJSMultiplicativeExpressionMod;
|
||||
Hex: String;
|
||||
i: Integer;
|
||||
ShiftEx: TJSShiftExpression;
|
||||
begin
|
||||
ModEx:=TJSMultiplicativeExpressionMod(CreateElement(TJSMultiplicativeExpressionMod,El));
|
||||
Result:=ModEx;
|
||||
ModEx.A:=Value;
|
||||
ModEx.B:=CreateLiteralNumber(El,Mask);
|
||||
Hex:=HexStr(Mask,8);
|
||||
i:=1;
|
||||
while i<8 do
|
||||
if Hex[i]='0' then
|
||||
inc(i)
|
||||
else
|
||||
break;
|
||||
Hex:=Copy(Hex,i,8);
|
||||
TJSLiteral(ModEx.B).Value.CustomValue:=TJSString('0x'+Hex);
|
||||
if Sign then
|
||||
begin
|
||||
// value << ZeroBits
|
||||
ShiftEx:=TJSLShiftExpression(CreateElement(TJSLShiftExpression,El));
|
||||
ShiftEx.A:=Result;
|
||||
Result:=ShiftEx;
|
||||
ShiftEx.B:=CreateLiteralNumber(El,i*4-4);
|
||||
// value << ZeroBits >> ZeroBits
|
||||
ShiftEx:=TJSRShiftExpression(CreateElement(TJSRShiftExpression,El));
|
||||
ShiftEx.A:=Result;
|
||||
Result:=ShiftEx;
|
||||
ShiftEx.B:=CreateLiteralNumber(El,i*4-4);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
NotEqual: TJSEqualityExpressionNE;
|
||||
CondExpr: TJSConditionalExpression;
|
||||
@ -7970,11 +8007,14 @@ var
|
||||
AddExpr: TJSAdditiveExpressionPlus;
|
||||
TypeEl: TPasType;
|
||||
C: TClass;
|
||||
Int: MaxPrecInt;
|
||||
Int, MinVal, MaxVal: MaxPrecInt;
|
||||
aResolver: TPas2JSResolver;
|
||||
ShiftEx: TJSURShiftExpression;
|
||||
begin
|
||||
Result:=nil;
|
||||
Param:=El.Params[0];
|
||||
AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
|
||||
aResolver:=AContext.Resolver;
|
||||
aResolver.ComputeElement(Param,ParamResolved,[]);
|
||||
JSBaseTypeData:=nil;
|
||||
JSBaseType:=pbtNone;
|
||||
|
||||
@ -7988,6 +8028,53 @@ begin
|
||||
if to_bt=btCurrency then
|
||||
// integer to currency -> value*10000
|
||||
Result:=CreateMulNumber(Param,Result,10000);
|
||||
if (to_bt<>btIntDouble) and not (Result is TJSLiteral) then
|
||||
begin
|
||||
if bsRangeChecks in AContext.ScannerBoolSwitches then
|
||||
begin
|
||||
// rtl.rc(param,MinInt,MaxInt)
|
||||
if not aResolver.GetIntegerRange(to_bt,MinVal,MaxVal) then
|
||||
RaiseNotSupported(Param,AContext,20180425131839);
|
||||
Call:=CreateCallExpression(El);
|
||||
Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnRangeCheckInt],El);
|
||||
Call.AddArg(Result);
|
||||
Result:=Call;
|
||||
Call.AddArg(CreateLiteralNumber(El,MinVal));
|
||||
Call.AddArg(CreateLiteralNumber(El,MaxVal));
|
||||
end
|
||||
else
|
||||
case to_bt of
|
||||
btByte:
|
||||
// value to byte -> value & 0xff
|
||||
if ParamResolved.BaseType<>btByte then
|
||||
Result:=CreateModulo(Result,$ff,false);
|
||||
btShortInt:
|
||||
// value to shortint -> value & 0xff << 24 >> 24
|
||||
if ParamResolved.BaseType<>btShortInt then
|
||||
Result:=CreateModulo(Result,$ff,true);
|
||||
btWord:
|
||||
// value to word -> value & 0xffff
|
||||
if not (ParamResolved.BaseType in [btByte,btWord]) then
|
||||
Result:=CreateModulo(Result,$ffff,false);
|
||||
btSmallInt:
|
||||
// value to smallint -> value & 0xffff << 16 >> 16
|
||||
if not (ParamResolved.BaseType in [btShortInt,btSmallInt]) then
|
||||
Result:=CreateModulo(Result,$ffff,true);
|
||||
btLongWord:
|
||||
// value to longword -> value >>> 0
|
||||
if not (ParamResolved.BaseType in [btByte,btWord,btLongWord,btUIntSingle]) then
|
||||
begin
|
||||
ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,El));
|
||||
ShiftEx.A:=Result;
|
||||
ShiftEx.B:=CreateLiteralNumber(El,0);
|
||||
Result:=ShiftEx;
|
||||
end;
|
||||
btLongint:
|
||||
// value to longint -> value & 0xffffffff
|
||||
if not (ParamResolved.BaseType in [btShortInt,btSmallInt,btLongint,btIntSingle]) then
|
||||
Result:=CreateModulo(Result,$ffffffff,false);
|
||||
end;
|
||||
end;
|
||||
exit;
|
||||
end
|
||||
else if ParamResolved.BaseType in btAllJSBooleans then
|
||||
@ -8133,7 +8220,7 @@ begin
|
||||
end
|
||||
else if (ParamResolved.BaseType in btAllJSInteger)
|
||||
or ((ParamResolved.BaseType=btContext)
|
||||
and (AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl).ClassType=TPasEnumType))
|
||||
and (aResolver.ResolveAliasType(ParamResolved.TypeEl).ClassType=TPasEnumType))
|
||||
then
|
||||
begin
|
||||
// Note: convert value first in case it raises an exception
|
||||
@ -8209,7 +8296,7 @@ begin
|
||||
// Note: convert value first in case it raises an exception
|
||||
if ParamResolved.BaseType=btContext then
|
||||
begin
|
||||
TypeEl:=AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl);
|
||||
TypeEl:=aResolver.ResolveAliasType(ParamResolved.TypeEl);
|
||||
C:=TypeEl.ClassType;
|
||||
if C=TPasClassType then
|
||||
begin
|
||||
@ -8224,7 +8311,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
writeln('TPasToJSConverter.ConvertTypeCastToBaseType BaseTypeData=',AContext.Resolver.BaseTypeNames[to_bt],' ParamResolved=',GetResolverResultDbg(ParamResolved));
|
||||
writeln('TPasToJSConverter.ConvertTypeCastToBaseType BaseTypeData=',aResolver.BaseTypeNames[to_bt],' ParamResolved=',GetResolverResultDbg(ParamResolved));
|
||||
{$ENDIF}
|
||||
RaiseNotSupported(El,AContext,20170325161150);
|
||||
end;
|
||||
|
||||
@ -210,6 +210,7 @@ type
|
||||
Procedure TestDouble;
|
||||
Procedure TestInteger;
|
||||
Procedure TestIntegerRange;
|
||||
Procedure TestIntegerTypecasts;
|
||||
Procedure TestCurrency;
|
||||
Procedure TestForBoolDo;
|
||||
Procedure TestForIntDo;
|
||||
@ -639,6 +640,7 @@ type
|
||||
procedure TestRangeChecks_AssignCharRange;
|
||||
procedure TestRangeChecks_ArrayIndex;
|
||||
procedure TestRangeChecks_StringIndex;
|
||||
procedure TestRangeChecks_TypecastInt;
|
||||
end;
|
||||
|
||||
function LinesToStr(Args: array of const): string;
|
||||
@ -4947,6 +4949,47 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestIntegerTypecasts;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'var',
|
||||
' i: nativeint;',
|
||||
' b: byte;',
|
||||
' sh: shortint;',
|
||||
' w: word;',
|
||||
' sm: smallint;',
|
||||
' lw: longword;',
|
||||
' li: longint;',
|
||||
'begin',
|
||||
' b:=byte(i);',
|
||||
' sh:=shortint(i);',
|
||||
' w:=word(i);',
|
||||
' sm:=smallint(i);',
|
||||
' lw:=longword(i);',
|
||||
' li:=longint(i);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestIntegerTypecasts',
|
||||
LinesToStr([
|
||||
'this.i = 0;',
|
||||
'this.b = 0;',
|
||||
'this.sh = 0;',
|
||||
'this.w = 0;',
|
||||
'this.sm = 0;',
|
||||
'this.lw = 0;',
|
||||
'this.li = 0;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.b = $mod.i % 0xFF;',
|
||||
'$mod.sh = (($mod.i % 0xFF) << 24) >> 24;',
|
||||
'$mod.w = $mod.i % 0xFFFF;',
|
||||
'$mod.sm = (($mod.i % 0xFFFF) << 16) >> 16;',
|
||||
'$mod.lw = $mod.i >>> 0;',
|
||||
'$mod.li = $mod.i % 0xFFFFFFFF;',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestCurrency;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -20146,6 +20189,48 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRangeChecks_TypecastInt;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$R+}',
|
||||
'var',
|
||||
' i: nativeint;',
|
||||
' b: byte;',
|
||||
' sh: shortint;',
|
||||
' w: word;',
|
||||
' sm: smallint;',
|
||||
' lw: longword;',
|
||||
' li: longint;',
|
||||
'begin',
|
||||
' b:=12+byte(i);',
|
||||
' sh:=12+shortint(i);',
|
||||
' w:=12+word(i);',
|
||||
' sm:=12+smallint(i);',
|
||||
' lw:=12+longword(i);',
|
||||
' li:=12+longint(i);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestRangeChecks_TypecastInt',
|
||||
LinesToStr([
|
||||
'this.i = 0;',
|
||||
'this.b = 0;',
|
||||
'this.sh = 0;',
|
||||
'this.w = 0;',
|
||||
'this.sm = 0;',
|
||||
'this.lw = 0;',
|
||||
'this.li = 0;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.b = rtl.rc(12 + rtl.rc($mod.i, 0, 255), 0, 255);',
|
||||
'$mod.sh = rtl.rc(12 + rtl.rc($mod.i, -128, 127), -128, 127);',
|
||||
'$mod.w = rtl.rc(12 + rtl.rc($mod.i, 0, 65535), 0, 65535);',
|
||||
'$mod.sm = rtl.rc(12 + rtl.rc($mod.i, -32768, 32767), -32768, 32767);',
|
||||
'$mod.lw = rtl.rc(12 + rtl.rc($mod.i, 0, 4294967295), 0, 4294967295);',
|
||||
'$mod.li = rtl.rc(12 + rtl.rc($mod.i, -2147483648, 2147483647), -2147483648, 2147483647);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterTests([TTestModule]);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user