pastojs: typecast int(int)

git-svn-id: trunk@38842 -

packages/pastojs/src/fppas2js.pp

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

packages/pastojs/tests/tcmodules.pas

@@ -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.