* synchronize with trunk

git-svn-id: branches/unicodekvm@41395 -

compiler/utils/ppuutils/ppudump.pp

@@ -596,9 +596,9 @@ var
   s : string;
 begin
   s:='';
+  ntflags:=flags;
   if flags<>0 then
    begin
-     ntflags:=flags;
      first:=true;
      for i:=1to flagopts do
       if (flags and flagopt[i].mask)<>0 then
@@ -1033,6 +1033,9 @@ var
 begin
   with ppufile do
    begin
+     fileindex:=0;
+     line:=0;
+     column:=0;
      {
        info byte layout in bits:
        0-1 - amount of bytes for fileindex
@@ -2393,9 +2396,9 @@ begin
            write(', ');
          write(managementoperatoropt[i].str);
        end;
+     if not first then
+       writeln;
    end;
-  if not first then
-    writeln;
 end;
 
 
@@ -4131,12 +4134,12 @@ begin
                   'J':
                     begin
                       nostdout:=True;
-                      pout:=TPpuJsonOutput.Create(Output);
+                      pout:=TPpuJsonOutput.Create(StdOutputHandle);
                     end;
                   'X':
                     begin
                       nostdout:=True;
-                      pout:=TPpuXmlOutput.Create(Output);
+                      pout:=TPpuXmlOutput.Create(StdOutputHandle);
                     end;
                   else
                     begin

compiler/utils/ppuutils/ppujson.pp

@@ -47,7 +47,7 @@ type
     procedure WriteBool(const AName: string; AValue: boolean); override;
     procedure WriteNull(const AName: string); override;
   public
-    constructor Create(var OutFile: Text); override;
+    constructor Create(OutFileHandle: THandle); override;
     procedure IncI; override;
     procedure DecI; override;
   end;
@@ -214,9 +214,9 @@ begin
   Write('}');
 end;
 
-constructor TPpuJsonOutput.Create(var OutFile: Text);
+constructor TPpuJsonOutput.Create(OutFileHandle: THandle);
 begin
-  inherited Create(OutFile);
+  inherited Create(OutFileHandle);
   SetLength(FNeedDelim, 10);
   FNeedDelim[0]:=False;
 end;

compiler/utils/ppuutils/ppuout.pp

@@ -39,11 +39,14 @@ type
   { TPpuOutput }
   TPpuOutput = class
   private
-    FOutFile: ^Text;
+    FOutFileHandle: THandle;
+    FOutBuf: array[0..10000] of char;
+    FOutBufPos: integer;
     FIndent: integer;
     FIndentSize: integer;
     FIndStr: string;
     FNoIndent: boolean;
+    procedure Flush;
     procedure SetIndent(AValue: integer);
     procedure SetIndentSize(AValue: integer);
   protected
@@ -57,7 +60,7 @@ type
     procedure WriteBool(const AName: string; AValue: boolean); virtual;
     procedure WriteNull(const AName: string); virtual;
   public
-    constructor Create(var OutFile: Text); virtual;
+    constructor Create(OutFileHandle: THandle); virtual;
     destructor Destroy; override;
     procedure Write(const s: string);
     procedure WriteLn(const s: string = '');
@@ -1187,22 +1190,56 @@ begin
   DecI;
 end;
 
-constructor TPpuOutput.Create(var OutFile: Text);
+constructor TPpuOutput.Create(OutFileHandle: THandle);
 begin
-  FOutFile:=@OutFile;
+  FOutFileHandle:=OutFileHandle;
   FIndentSize:=2;
 end;
 
 destructor TPpuOutput.Destroy;
 begin
+  Flush;
   inherited Destroy;
 end;
 
+procedure TPpuOutput.Flush;
+var
+  i, len: integer;
+begin
+  i:=0;
+  while FOutBufPos > 0 do begin
+    len:=FileWrite(FOutFileHandle, FOutBuf[i], FOutBufPos);
+    if len < 0 then
+      raise Exception.CreateFmt('Error writing to file: ', [SysErrorMessage(GetLastOSError)]);
+    Inc(i, len);
+    Dec(FOutBufPos, len);
+  end;
+end;
+
 procedure TPpuOutput.Write(const s: string);
+var
+  ss: string;
+  i, len, len2: integer;
 begin
   if not FNoIndent then
-    System.Write(FOutFile^, FIndStr);
-  System.Write(FOutFile^, s);
+    ss:=FIndStr + s
+  else
+    ss:=s;
+  i:=1;
+  len:=Length(ss);
+  while len > 0 do begin
+    len2:=Length(FOutBuf) - FOutBufPos;
+    if len2 > 0 then begin
+      if len < len2 then
+        len2:=len;
+      Move(ss[i], FOutBuf[FOutBufPos], len2);
+      Inc(FOutBufPos, len2);
+    end;
+    if FOutBufPos = Length(FOutBuf) then
+      Flush;
+    Inc(i, len2);
+    Dec(len, len2);
+  end;
   FNoIndent:=True;
 end;
 
@@ -1228,6 +1265,7 @@ end;
 
 procedure TPpuOutput.Done;
 begin
+  Flush;
 end;
 
 { TPpuUnitDef }

compiler/utils/ppuutils/ppuxml.pp

@@ -41,7 +41,6 @@ type
     procedure WriteArrayEnd(const AName: string); override;
     procedure WriteStr(const AName, AValue: string); override;
   public
-    constructor Create(var OutFile: Text); override;
     procedure Init; override;
   end;
 
@@ -162,11 +161,6 @@ begin
     WriteLn(Format('</%s>', [GetTagName(Def.DefTypeName, 'object')]));
 end;
 
-constructor TPpuXmlOutput.Create(var OutFile: Text);
-begin
-  inherited Create(OutFile);
-end;
-
 procedure TPpuXmlOutput.Init;
 begin
   inherited Init;

packages/fcl-js/src/jsbase.pp

@@ -26,8 +26,8 @@ uses
   Classes;
 
 const
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 

packages/fcl-js/src/jswriter.pp

@@ -803,6 +803,15 @@ begin
             if (Code=0) and (D=AsNumber) then
               S:=S2;
             end;
+          else
+            if s[i-1]='0' then
+              begin
+              // 1.2340E...
+              S2:=LeftStr(S,i-2)+copy(S,i,length(S));
+              val(S2,D,Code);
+              if (Code=0) and (D=AsNumber) then
+                S:=S2;
+              end;
           end;
           end;
         // chomp default exponent E+000

packages/fcl-passrc/src/pasresolveeval.pas

@@ -361,9 +361,9 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
-  MaskUIntDouble = $fffffffffffff;
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
+  MaskUIntDouble = $1fffffffffffff;
 
 type
   { TResEvalValue }

packages/fcl-passrc/src/pastree.pp

@@ -197,7 +197,7 @@ type
      pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
   TExprOpCode = (eopNone,
-                 eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
+                 eopAdd,eopSubtract,eopMultiply,eopDivide{/}, eopDiv{div},eopMod, eopPower,// arithmetic
                  eopShr,eopShl, // bit operations
                  eopNot,eopAnd,eopOr,eopXor, // logical/bit
                  eopEqual, eopNotEqual,  // Logical

packages/fcl-passrc/tests/tcgenerics.pp

@@ -224,7 +224,7 @@ begin
   'begin',
   'end;',
   'begin',
-  '  specialize IfThen<word>(true,2,3);',
+  //'  specialize IfThen<word>(true,2,3);',
   '']);
   ParseModule;
 end;

packages/pastojs/src/fppas2js.pp

@@ -400,9 +400,14 @@ Works:
 - array of const, TVarRec
 
 ToDos:
+- range check:
+   type helper self:=
+- overflow check:
+   ?
 - cmd line param to set modeswitch
 - Result:=inherited;
 - asm-block annotate/reference
+  - pas()  test or use or read or write
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - $OPTIMIZATION ON|OFF
 - $optimization REMOVEEMPTYPROCS
@@ -412,14 +417,10 @@ ToDos:
 - static arrays
   - clone multi dim static array
 - RTTI
-  - class property
-- asm: pas() - useful for overloads and protect an identifier from optimization
+  - class property field/static/nonstatic
 - interfaces
   - array of interface
   - record member interface
-- range check:
-   arr[i]:=value  check if value is in range
-   astring[i]:=value check if value is in range
 - 1 as TEnum, ERangeError
 - ifthen<T>
 - stdcall of methods: pass original 'this' as first parameter
@@ -602,6 +603,7 @@ type
     pbifnValEnum,
     pbifnFreeLocalVar,
     pbifnFreeVar,
+    pbifnOverflowCheckInt,
     pbifnProcType_Create,
     pbifnProcType_Equal,
     pbifnProgramMain,
@@ -758,7 +760,8 @@ const
     'valEnum', // rtl.valEnum
     'freeLoc', // rtl.freeLoc
     'free', // rtl.free
-    'createCallback', // rtl.createCallback
+    'oc', //  rtl.oc  pbifnOverflowCheckInt
+    'createCallback', // rtl.createCallback  pbifnProcType_Create
     'eqCallback', // rtl.eqCallback
     '$main',
     'raiseE', // rtl.raiseE
@@ -1222,7 +1225,9 @@ const
       +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans;
   btAllJSValueTypeCastTo = btAllJSInteger
       +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans+[btPointer];
-
+  btAllJSRangeCheckTypes = btAllJSInteger + btAllJSChars;
+  btAllJSOverflowAddSubType = [btIntDouble,btUIntDouble,btCurrency];
+  btAllJSOverflowMultType = [btLongWord,btLongint,btIntDouble,btUIntDouble,btCurrency];
 
   DefaultPasResolverOptions = [
     proFixCaseOfOverrides,
@@ -1744,6 +1749,12 @@ type
       const aName: TJSString): TJSDotMemberExpression; virtual;
     Function CreateDotExpression(aParent: TPasElement; Left, Right: TJSElement;
       CheckRightIntfRef: boolean = false): TJSElement; virtual;
+    // range and overflow checks
+    Function CreateOverflowCheckCall(GetExpr: TJSElement; PosEl: TPasElement): TJSCallExpression; virtual;
+    Function CreateRangeCheckCall(GetExpr: TJSElement; MinVal, MaxVal: TMaxPrecInt;
+      RTLFunc: TPas2JSBuiltInName; PosEl: TPasElement): TJSCallExpression; virtual;
+    Function CreateRangeCheckCall_TypeRange(aType: TPasType; GetExpr: TJSElement;
+      AContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
     // reference
     Function CreateReferencePath(El: TPasElement; AContext : TConvertContext;
       Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
@@ -6695,117 +6706,117 @@ begin
     C:=BinClasses[El.OpCode];
     if C=nil then
       Case El.OpCode of
-        eopAs :
+      eopAs :
+        begin
+        // "A as B"
+        Call:=CreateCallExpression(El);
+        LeftTypeEl:=LeftResolved.LoTypeEl;
+        RightTypeEl:=RightResolved.LoTypeEl;
+        if LeftTypeEl is TPasClassType then
           begin
-          // "A as B"
-          Call:=CreateCallExpression(El);
-          LeftTypeEl:=LeftResolved.LoTypeEl;
-          RightTypeEl:=RightResolved.LoTypeEl;
-          if LeftTypeEl is TPasClassType then
-            begin
-            if RightTypeEl is TPasClassType then
-              case TPasClassType(LeftTypeEl).ObjKind of
+          if RightTypeEl is TPasClassType then
+            case TPasClassType(LeftTypeEl).ObjKind of
+            okClass:
+              case TPasClassType(RightTypeEl).ObjKind of
               okClass:
-                case TPasClassType(RightTypeEl).ObjKind of
-                okClass:
-                  // ClassInstVar is ClassType
-                  if TPasClassType(RightResolved.LoTypeEl).IsExternal then
-                    // B is external class -> "rtl.asExt(A,B)"
-                    Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAsExt),El)
-                  else
-                    // otherwise -> "rtl.as(A,B)"
-                    Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
-                okInterface:
+                // ClassInstVar is ClassType
+                if TPasClassType(RightResolved.LoTypeEl).IsExternal then
+                  // B is external class -> "rtl.asExt(A,B)"
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAsExt),El)
+                else
+                  // otherwise -> "rtl.as(A,B)"
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
+              okInterface:
+                begin
+                // ClassInstVar as IntfType
+                case TPasClassType(RightTypeEl).InterfaceType of
+                citCom:
                   begin
-                  // ClassInstVar as IntfType
-                  case TPasClassType(RightTypeEl).InterfaceType of
-                  citCom:
-                    begin
-                    // COM:  $ir.ref(rtl.queryIntfT(objVar,intftype),"id")
-                    Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfQueryIntfT),El);
-                    Call.AddArg(A);
-                    Call.AddArg(B);
-                    Call:=CreateIntfRef(Call,AContext,El);
-                    Result:=Call;
-                    exit;
-                    end;
-                  citCorba:
-                    // CORBA:  rtl.getIntfT(objVar,intftype)
-                    Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfGetIntfT),El);
-                  else RaiseNotSupported(El,AContext,20180401225752);
+                  // COM:  $ir.ref(rtl.queryIntfT(objVar,intftype),"id")
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfQueryIntfT),El);
+                  Call.AddArg(A);
+                  Call.AddArg(B);
+                  Call:=CreateIntfRef(Call,AContext,El);
+                  Result:=Call;
+                  exit;
                   end;
-                  end
-                else
-                  NotSupportedRes(20180327214535);
+                citCorba:
+                  // CORBA:  rtl.getIntfT(objVar,intftype)
+                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfGetIntfT),El);
+                else RaiseNotSupported(El,AContext,20180401225752);
                 end;
+                end
+              else
+                NotSupportedRes(20180327214535);
+              end;
+            okInterface:
+              case TPasClassType(RightTypeEl).ObjKind of
+              okClass:
+                // IntfVar as ClassType ->  rtl.intfAsClass(intfvar,classtype)
+                Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsClass),El);
               okInterface:
-                case TPasClassType(RightTypeEl).ObjKind of
-                okClass:
-                  // IntfVar as ClassType ->  rtl.intfAsClass(intfvar,classtype)
-                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnIntfAsClass),El);
-                okInterface:
-                  // IntfVar as IntfType -> "rtl.as(A,B)"
-                  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
-                else
-                  NotSupportedRes(20180327214545);
-                end;
+                // IntfVar as IntfType -> "rtl.as(A,B)"
+                Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
               else
-                NotSupportedRes(20180327214559);
-              end
-            else if RightTypeEl is TPasClassOfType then
-              begin
-              // ClassInstVar is ClassOfType -> "rtl.as(A,B)"
-              Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
+                NotSupportedRes(20180327214545);
               end;
-            end;
-          Call.AddArg(A);
-          Call.AddArg(B);
-          Result:=Call;
-          exit;
-          end;
-        eopAnd,
-        eopOr,
-        eopXor:
-          begin
-          if aResolver<>nil then
-            begin
-            UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
-                       or (RightResolved.BaseType in btAllJSInteger));
-            if UseBitwiseOp
-                and (LeftResolved.BaseType in [btIntDouble,btUIntDouble])
-                and (RightResolved.BaseType in [btIntDouble,btUIntDouble]) then
-              aResolver.LogMsg(20190124233439,mtWarning,nBitWiseOperationsAre32Bit,
-                sBitWiseOperationsAre32Bit,[],El);
-            end
-          else
-            UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
-              or (GetExpressionValueType(El.right,AContext)=jstNumber);
-          if UseBitwiseOp then
-            Case El.OpCode of
-              eopAnd : C:=TJSBitwiseAndExpression;
-              eopOr : C:=TJSBitwiseOrExpression;
-              eopXor : C:=TJSBitwiseXOrExpression;
-            end
-          else
-            Case El.OpCode of
-              eopAnd : C:=TJSLogicalAndExpression;
-              eopOr : C:=TJSLogicalOrExpression;
-              eopXor : C:=TJSBitwiseXOrExpression;
             else
-              DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
+              NotSupportedRes(20180327214559);
+            end
+          else if RightTypeEl is TPasClassOfType then
+            begin
+            // ClassInstVar is ClassOfType -> "rtl.as(A,B)"
+            Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnAs),El);
             end;
           end;
-        eopPower:
+        Call.AddArg(A);
+        Call.AddArg(B);
+        Result:=Call;
+        exit;
+        end;
+      eopAnd,
+      eopOr,
+      eopXor:
+        begin
+        if aResolver<>nil then
           begin
-          Call:=CreateCallExpression(El);
-          Call.Expr:=CreatePrimitiveDotExpr('Math.pow',El);
-          Call.AddArg(A);
-          Call.AddArg(B);
-          Result:=Call;
+          UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+                     or (RightResolved.BaseType in btAllJSInteger));
+          if UseBitwiseOp
+              and (LeftResolved.BaseType in [btIntDouble,btUIntDouble])
+              and (RightResolved.BaseType in [btIntDouble,btUIntDouble]) then
+            aResolver.LogMsg(20190124233439,mtWarning,nBitWiseOperationsAre32Bit,
+              sBitWiseOperationsAre32Bit,[],El);
           end
         else
-          if C=nil then
-            DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
+          UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+            or (GetExpressionValueType(El.right,AContext)=jstNumber);
+        if UseBitwiseOp then
+          Case El.OpCode of
+            eopAnd : C:=TJSBitwiseAndExpression;
+            eopOr : C:=TJSBitwiseOrExpression;
+            eopXor : C:=TJSBitwiseXOrExpression;
+          end
+        else
+          Case El.OpCode of
+            eopAnd : C:=TJSLogicalAndExpression;
+            eopOr : C:=TJSLogicalOrExpression;
+            eopXor : C:=TJSBitwiseXOrExpression;
+          else
+            DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
+          end;
+        end;
+      eopPower:
+        begin
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreatePrimitiveDotExpr('Math.pow',El);
+        Call.AddArg(A);
+        Call.AddArg(B);
+        Result:=Call;
+        end
+      else
+        if C=nil then
+          DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
       end;
     if (Result=Nil) and (C<>Nil) then
       begin
@@ -6819,6 +6830,18 @@ begin
         // convert "a div b" to "Math.floor(a/b)"
         Result:=CreateMathFloor(El,Result);
         end;
+
+      if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then
+        case El.OpCode of
+        eopAdd,eopSubtract:
+          if (LeftResolved.BaseType in btAllJSOverflowAddSubType)
+              or (RightResolved.BaseType in btAllJSOverflowAddSubType) then
+            Result:=CreateOverflowCheckCall(Result,El);
+        eopMultiply:
+          if (LeftResolved.BaseType in btAllJSOverflowMultType)
+              or (RightResolved.BaseType in btAllJSOverflowMultType) then
+            Result:=CreateOverflowCheckCall(Result,El);
+        end;
       end;
   finally
     if Result=nil then
@@ -6984,6 +7007,9 @@ begin
       if RightResolved.BaseType<>btCurrency then
         B:=CreateMulNumber(El,B,10000);
       TJSBinary(Result).B:=B; B:=nil;
+      if (bsOverflowChecks in AContext.ScannerBoolSwitches)
+        and (El.OpCode in [eopAdd,eopSubtract]) then
+          Result:=CreateOverflowCheckCall(Result,El);
       exit;
       end;
     eopMultiply:
@@ -6996,6 +7022,8 @@ begin
       TJSBinaryExpression(Result).B:=B; B:=nil;
       if (LeftResolved.BaseType=btCurrency) and (RightResolved.BaseType=btCurrency) then
         Result:=CreateDivideNumber(El,Result,10000);
+      if (bsOverflowChecks in AContext.ScannerBoolSwitches) then
+        Result:=CreateOverflowCheckCall(Result,El);
       exit;
       end;
     eopDivide:
@@ -13763,47 +13791,13 @@ var
     BodyJS.A:=FirstSt;
   end;
 
-  procedure AddRangeCheck(Arg: TPasArgument; MinVal, MaxVal: TMaxPrecInt;
-    RTLFunc: TPas2JSBuiltInName);
+  procedure AddRangeCheckType(Arg: TPasArgument; aType: TPasType;
+    AContext: TConvertContext);
   var
-    Call: TJSCallExpression;
+    GetExpr: TJSElement;
   begin
-    // use Arg as PosEl, so that user knows which Arg is out of range
-    Call:=CreateCallExpression(Arg);
-    Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(RTLFunc),El);
-    AddBodyStatement(Call,Arg);
-    Call.AddArg(CreateArgumentAccess(Arg,AContext,Arg));
-    Call.AddArg(CreateLiteralNumber(Arg,MinVal));
-    Call.AddArg(CreateLiteralNumber(Arg,MaxVal));
-  end;
-
-  procedure AddRangeCheckType(Arg: TPasArgument; aType: TPasType);
-  var
-    Value: TResEvalValue;
-  begin
-    Value:=AContext.Resolver.EvalTypeRange(aType,[refConst]);
-    if Value=nil then
-      RaiseNotSupported(Arg,AContext,20180424111936,'range checking '+GetObjName(aType));
-    try
-      case Value.Kind of
-      revkRangeInt:
-        case TResEvalRangeInt(Value).ElKind of
-          revskEnum, revskInt:
-            AddRangeCheck(Arg,TResEvalRangeInt(Value).RangeStart,
-              TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckInt);
-          revskChar:
-            AddRangeCheck(Arg,TResEvalRangeInt(Value).RangeStart,
-              TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckChar);
-        end;
-      revkRangeUInt:
-        AddRangeCheck(Arg,TResEvalRangeUInt(Value).RangeStart,
-          TResEvalRangeUInt(Value).RangeEnd,pbifnRangeCheckInt);
-      else
-        RaiseNotSupported(Arg,AContext,20180424112010,'range checking '+Value.AsDebugString);
-      end;
-    finally
-      ReleaseEvalValue(Value);
-    end;
+    GetExpr:=CreateArgumentAccess(Arg,AContext,Arg);
+    AddBodyStatement(CreateRangeCheckCall_TypeRange(aType,GetExpr,AContext,Arg),Arg);
   end;
 
 Var
@@ -13821,7 +13815,6 @@ Var
   Call: TJSCallExpression;
   ClassPath: String;
   ArgResolved: TPasResolverResult;
-  MinVal, MaxVal: TMaxPrecInt;
   Lit: TJSLiteral;
   ConstSrcElems: TJSSourceElements;
   ArgTypeEl, HelperForType: TPasType;
@@ -13926,30 +13919,19 @@ begin
           aResolver.ComputeElement(Arg,ArgResolved,[rcType]);
           ArgTypeEl:=ArgResolved.LoTypeEl;
           if ArgTypeEl=nil then continue;
-          if ArgResolved.BaseType in btAllJSInteger then
-            begin
-            if ArgTypeEl is TPasUnresolvedSymbolRef then
-              begin
-              if not aResolver.GetIntegerRange(ArgResolved.BaseType,MinVal,MaxVal) then
-                RaiseNotSupported(Arg,AContext,20180119192608);
-              AddRangeCheck(Arg,MinVal,MaxVal,pbifnRangeCheckInt);
-              end
-            else if ArgTypeEl.ClassType=TPasRangeType then
-              AddRangeCheckType(Arg,ArgTypeEl);
-            end
-          else if ArgResolved.BaseType in btAllJSChars then
-            AddRangeCheckType(Arg,ArgTypeEl)
+          if ArgResolved.BaseType in btAllJSRangeCheckTypes then
+            AddRangeCheckType(Arg,ArgTypeEl,FuncContext)
           else if ArgResolved.BaseType=btContext then
             begin
             if ArgTypeEl.ClassType=TPasEnumType then
-              AddRangeCheckType(Arg,ArgTypeEl);
+              AddRangeCheckType(Arg,ArgTypeEl,FuncContext);
             end
           else if ArgResolved.BaseType=btRange then
             begin
-            if ArgResolved.SubType in btAllJSChars then
-              AddRangeCheckType(Arg,ArgTypeEl)
+            if ArgResolved.SubType in btAllJSRangeCheckTypes then
+              AddRangeCheckType(Arg,ArgTypeEl,FuncContext)
             else if ArgResolved.SubType=btContext then
-              AddRangeCheckType(Arg,ArgTypeEl)
+              AddRangeCheckType(Arg,ArgTypeEl,FuncContext)
             else
               begin
               {$IFDEF VerbosePas2JS}
@@ -17393,15 +17375,58 @@ var
       end;
   end;
 
-  function CreateRefObj(PosEl: TPasElement;
+  function CreateRefObj(PosEl: TPasElement; PathExpr: TJSElement;
     GetExpr, SetExpr: TJSElement; SetterArgName: string;
-    PathExpr: TJSElement = nil): TJSObjectLiteral;
+    const LeftResolved: TPasResolverResult): TJSObjectLiteral;
+
+    function CreateRgCheck(aType: TPasType): TJSElement;
+    begin
+      Result:=CreateRangeCheckCall_TypeRange(aType,
+        CreatePrimitiveDotExpr(SetterArgName,PosEl),AContext,PosEl);
+    end;
+
   var
     Obj: TJSObjectLiteral;
     ObjLit: TJSObjectLiteralElement;
     FuncSt: TJSFunctionDeclarationStatement;
     RetSt: TJSReturnStatement;
+    TypeEl: TPasType;
+    RgCheck: TJSElement;
+    List: TJSStatementList;
   begin
+    RgCheck:=nil;
+    writeln('AAA1 CreateRefObj SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName,' ',bsRangeChecks in AContext.ScannerBoolSwitches);
+    if (SetExpr is TJSSimpleAssignStatement)
+        and (SetterArgName<>'')
+        and (bsRangeChecks in AContext.ScannerBoolSwitches) then
+      begin
+      TypeEl:=LeftResolved.LoTypeEl;
+      if TypeEl<>nil then
+        begin
+        if LeftResolved.BaseType in btAllJSRangeCheckTypes then
+          RgCheck:=CreateRgCheck(TypeEl)
+        else if LeftResolved.BaseType=btContext then
+          begin
+          if TypeEl.ClassType=TPasEnumType then
+            RgCheck:=CreateRgCheck(TypeEl);
+          end
+        else if LeftResolved.BaseType=btRange then
+          begin
+          if LeftResolved.SubType in btAllJSRangeCheckTypes then
+            RgCheck:=CreateRgCheck(TypeEl)
+          else if LeftResolved.SubType=btContext then
+            RgCheck:=CreateRgCheck(TypeEl)
+          else
+            begin
+            {$IFDEF VerbosePas2JS}
+            writeln('TPasToJSConverter.CreateCallHelperMethod ',GetResolverResultDbg(LeftResolved));
+            RaiseNotSupported(PosEl,AContext,20190220011900);
+            {$ENDIF}
+            end;
+          end;
+        end;
+      end;
+
     Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,PosEl));
     Result:=Obj;
 
@@ -17429,6 +17454,13 @@ var
     ObjLit.Expr:=FuncSt;
     if SetterArgName<>'' then
       FuncSt.AFunction.Params.Add(SetterArgName);
+    if RgCheck<>nil then
+      begin
+      List:=TJSStatementList(CreateElement(TJSStatementList,PosEl));
+      List.A:=RgCheck;
+      List.B:=SetExpr;
+      SetExpr:=List;
+      end;
     FuncSt.AFunction.Body.A:=SetExpr;
   end;
 
@@ -17440,7 +17472,7 @@ var
     AssignSt: TJSSimpleAssignStatement;
     Arg: TPasArgument;
   begin
-    // implicit Left (e.g. with Left do proc, or Self.proc)
+    // implicit Left (e.g. with Left do proc, or (Self.)proc)
 
     if LeftResolved.IdentEl is TPasArgument then
       begin
@@ -17476,7 +17508,7 @@ var
       SetExpr:=CreateRaisePropReadOnly(PosEl);
       end;
 
-    Result:=CreateRefObj(PosEl,GetExpr,SetExpr,SetterArgName);
+    Result:=CreateRefObj(PosEl,nil,GetExpr,SetExpr,SetterArgName,LeftResolved);
   end;
 
   function CreatePropertyReference(PosEl: TPasElement;
@@ -17549,7 +17581,7 @@ var
     else
       RaiseNotSupported(PosEl,AContext,20190210193605,GetObjName(LeftJS));
 
-    Result:=CreateRefObj(PosEl,GetExpr,SetExpr,SetterArgName,PathExpr);
+    Result:=CreateRefObj(PosEl,PathExpr,GetExpr,SetExpr,SetterArgName,LeftResolved);
   end;
 
   function CreateReference(PosEl: TPasElement;
@@ -18148,7 +18180,7 @@ function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
     Call.AddArg(CreateLiteralNumber(El.right,MaxVal));
   end;
 
-  function CreateRangeCheckType(AssignSt: TJSElement; aType: TPasType): TJSElement;
+  function ApplyRangeCheck_Type(AssignSt: TJSElement; aType: TPasType): TJSElement;
   var
     Value: TResEvalValue;
   begin
@@ -18166,10 +18198,10 @@ function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
           revskChar:
             Result:=CreateRangeCheck(AssignSt,TResEvalRangeInt(Value).RangeStart,
               TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckChar);
+          revskBool: ; // maybe check for type?
+        else
+          RaiseNotSupported(El,AContext,20190220003746,'range checking '+Value.AsDebugString);
         end;
-      revkRangeUInt:
-        Result:=CreateRangeCheck(AssignSt,TResEvalRangeUInt(Value).RangeStart,
-          TResEvalRangeUInt(Value).RangeEnd,pbifnRangeCheckInt);
       else
         RaiseNotSupported(El,AContext,20180424111037,'range checking '+Value.AsDebugString);
       end;
@@ -18448,21 +18480,21 @@ begin
             Result:=CreateRangeCheck(Result,MinVal,MaxVal,pbifnRangeCheckInt);
             end
           else if LeftTypeEl.ClassType=TPasRangeType then
-            Result:=CreateRangeCheckType(Result,LeftTypeEl);
+            Result:=ApplyRangeCheck_Type(Result,LeftTypeEl);
           end
         else if AssignContext.LeftResolved.BaseType in btAllJSChars then
-          Result:=CreateRangeCheckType(Result,LeftTypeEl)
+          Result:=ApplyRangeCheck_Type(Result,LeftTypeEl)
         else if AssignContext.LeftResolved.BaseType=btContext then
           begin
           if LeftTypeEl.ClassType=TPasEnumType then
-            Result:=CreateRangeCheckType(Result,LeftTypeEl);
+            Result:=ApplyRangeCheck_Type(Result,LeftTypeEl);
           end
         else if AssignContext.LeftResolved.BaseType=btRange then
           begin
-          if AssignContext.LeftResolved.SubType in btAllJSChars then
-            Result:=CreateRangeCheckType(Result,LeftTypeEl)
+          if AssignContext.LeftResolved.SubType in btAllJSRangeCheckTypes then
+            Result:=ApplyRangeCheck_Type(Result,LeftTypeEl)
           else if AssignContext.LeftResolved.SubType=btContext then
-            Result:=CreateRangeCheckType(Result,LeftTypeEl)
+            Result:=ApplyRangeCheck_Type(Result,LeftTypeEl)
           else
             begin
             {$IFDEF VerbosePas2JS}
@@ -20457,6 +20489,65 @@ begin
   end;
 end;
 
+function TPasToJSConverter.CreateOverflowCheckCall(GetExpr: TJSElement;
+  PosEl: TPasElement): TJSCallExpression;
+var
+  Call: TJSCallExpression;
+begin
+  Call:=CreateCallExpression(PosEl);
+  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnOverflowCheckInt),PosEl);
+  Call.AddArg(GetExpr);
+  Result:=Call;
+end;
+
+function TPasToJSConverter.CreateRangeCheckCall(GetExpr: TJSElement; MinVal,
+  MaxVal: TMaxPrecInt; RTLFunc: TPas2JSBuiltInName; PosEl: TPasElement
+  ): TJSCallExpression;
+var
+  Call: TJSCallExpression;
+begin
+  Call:=CreateCallExpression(PosEl);
+  Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(RTLFunc),PosEl);
+  Call.AddArg(GetExpr);
+  Call.AddArg(CreateLiteralNumber(PosEl,MinVal));
+  Call.AddArg(CreateLiteralNumber(PosEl,MaxVal));
+  Result:=Call;
+end;
+
+function TPasToJSConverter.CreateRangeCheckCall_TypeRange(aType: TPasType;
+  GetExpr: TJSElement; AContext: TConvertContext; PosEl: TPasElement
+  ): TJSCallExpression;
+var
+  Value: TResEvalValue;
+begin
+  Result:=nil;
+  Value:=AContext.Resolver.EvalTypeRange(aType,[refConst]);
+  try
+    if Value=nil then
+      RaiseNotSupported(PosEl,AContext,20180424111936,'range checking '+GetObjName(aType));
+    case Value.Kind of
+    revkRangeInt:
+      case TResEvalRangeInt(Value).ElKind of
+        revskEnum, revskInt:
+          Result:=CreateRangeCheckCall(GetExpr,TResEvalRangeInt(Value).RangeStart,
+            TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckInt,PosEl);
+        revskChar:
+          Result:=CreateRangeCheckCall(GetExpr,TResEvalRangeInt(Value).RangeStart,
+            TResEvalRangeInt(Value).RangeEnd,pbifnRangeCheckChar,PosEl);
+        revskBool: ; // range check not needed
+      else
+        RaiseNotSupported(PosEl,AContext,20190220002007,'range checking '+Value.AsDebugString);
+      end;
+    else
+      RaiseNotSupported(PosEl,AContext,20180424112010,'range checking '+Value.AsDebugString);
+    end;
+  finally
+    ReleaseEvalValue(Value);
+    if Result=nil then
+      GetExpr.Free;
+  end;
+end;
+
 function TPasToJSConverter.CreateReferencePath(El: TPasElement;
   AContext: TConvertContext; Kind: TRefPathKind; Full: boolean;
   Ref: TResolvedReference): string;
@@ -21138,10 +21229,50 @@ var
     Result:=ParamContext.Setter;
   end;
 
+  function CreateRgCheck(const SetterArgName: string): TJSElement;
+
+    function CreateRgCheckSt(aType: TPasType): TJSElement;
+    begin
+      Result:=CreateRangeCheckCall_TypeRange(aType,
+        CreatePrimitiveDotExpr(SetterArgName,El),AContext,El);
+    end;
+
+  var
+    ArgResolved: TPasResolverResult;
+    TypeEl: TPasType;
+  begin
+    Result:=nil;
+    if TargetArg.ArgType=nil then exit;
+    AContext.Resolver.ComputeElement(TargetArg,ArgResolved,[]);
+    TypeEl:=ArgResolved.LoTypeEl;
+    if TypeEl=nil then exit;
+    if ArgResolved.BaseType in btAllJSRangeCheckTypes then
+      Result:=CreateRgCheckSt(TypeEl)
+    else if ArgResolved.BaseType=btContext then
+      begin
+      if TypeEl.ClassType=TPasEnumType then
+        Result:=CreateRgCheckSt(TypeEl);
+      end
+    else if ArgResolved.BaseType=btRange then
+      begin
+      if ArgResolved.SubType in btAllJSRangeCheckTypes then
+        Result:=CreateRgCheckSt(TypeEl)
+      else if ArgResolved.SubType=btContext then
+        Result:=CreateRgCheckSt(TypeEl)
+      else
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateProcCallArgRef ',GetResolverResultDbg(ArgResolved));
+        RaiseNotSupported(El,AContext,20190220014806);
+        {$ENDIF}
+        end;
+      end;
+  end;
+
 var
   ParamContext: TParamContext;
   FullGetter, GetPathExpr, SetPathExpr, GetExpr, SetExpr, ParamExpr,
-    RHS: TJSElement;
+    RHS, RgCheck: TJSElement;
   AssignSt: TJSSimpleAssignStatement;
   ObjLit: TJSObjectLiteralElement;
   FuncSt: TJSFunctionDeclarationStatement;
@@ -21155,6 +21286,7 @@ var
   FuncContext: TFunctionContext;
   IsCOMIntf, HasCustomSetter: Boolean;
   Call: TJSCallExpression;
+  StList: TJSStatementList;
 begin
   // pass reference -> create a temporary JS object with a getter and setter
   Obj:=nil;
@@ -21165,6 +21297,7 @@ begin
   GetExpr:=nil;
   SetExpr:=nil;
   SetterArgName:=TempRefObjSetterArgName;
+  RgCheck:=nil;
   try
     // create FullGetter and setter
     ParamContext.Access:=caByReference;
@@ -21376,7 +21509,11 @@ begin
             FuncContext.ResultNeedsIntfRelease:=true
           else
             FuncContext.Add_InterfaceRelease(ResolvedEl.IdentEl);
-          end;
+          end
+        else if (SetExpr is TJSSimpleAssignStatement)
+            and (SetterArgName<>'')
+            and (bsRangeChecks in AContext.ScannerBoolSwitches) then
+          RgCheck:=CreateRgCheck(SetterArgName);
         end;
       end
     else if (SetExpr.ClassType=TJSCallExpression) then
@@ -21405,7 +21542,15 @@ begin
     ObjLit.Name:=TempRefObjSetterName;
     FuncSt:=CreateFunctionSt(El);
     ObjLit.Expr:=FuncSt;
-    FuncSt.AFunction.Params.Add(SetterArgName);
+    if SetterArgName<>'' then
+      FuncSt.AFunction.Params.Add(SetterArgName);
+    if RgCheck<>nil then
+      begin
+      StList:=TJSStatementList(CreateElement(TJSStatementList,El));
+      StList.A:=RgCheck;
+      StList.B:=SetExpr;
+      SetExpr:=StList;
+      end;
     FuncSt.AFunction.Body.A:=SetExpr;
     SetExpr:=nil;
 

packages/pastojs/tests/tcmodules.pas

@@ -806,6 +806,7 @@ type
     procedure TestAssert;
     procedure TestAssert_SysUtils;
     procedure TestObjectChecks;
+    procedure TestOverflowChecks_Int;
     procedure TestRangeChecks_AssignInt;
     procedure TestRangeChecks_AssignIntRange;
     procedure TestRangeChecks_AssignEnum;
@@ -816,6 +817,7 @@ type
     procedure TestRangeChecks_ArrayOfRecIndex;
     procedure TestRangeChecks_StringIndex;
     procedure TestRangeChecks_TypecastInt;
+    procedure TestRangeChecks_TypeHelperInt;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -2520,8 +2522,8 @@ begin
   Add('  b2: boolean = true;');
   Add('  d2: double = 5.6;');
   Add('  i3: longint = $707;');
-  Add('  i4: nativeint = 4503599627370495;');
-  Add('  i5: nativeint = -4503599627370495-1;');
+  Add('  i4: nativeint = 9007199254740991;');
+  Add('  i5: nativeint = -9007199254740991-1;');
   Add('  i6: nativeint =   $fffffffffffff;');
   Add('  i7: nativeint = -$fffffffffffff-1;');
   Add('  i8: byte = 00;');
@@ -2543,8 +2545,8 @@ begin
     'this.b2 = true;',
     'this.d2 = 5.6;',
     'this.i3 = 0x707;',
-    'this.i4 = 4503599627370495;',
-    'this.i5 = -4503599627370495-1;',
+    'this.i4 = 9007199254740991;',
+    'this.i5 = -9007199254740991-1;',
     'this.i6 = 0xfffffffffffff;',
     'this.i7 =-0xfffffffffffff-1;',
     'this.i8 = 0;',
@@ -6165,9 +6167,9 @@ begin
   '  fn1_0En12 = -1E-12;',
   '  maxdouble = 1.7e+308;',
   '  mindouble = -1.7e+308;',
-  '  MinSafeIntDouble = -$10000000000000;',
-  '  MinSafeIntDouble2 = -$fffffffffffff-1;',
-  '  MaxSafeIntDouble =   $fffffffffffff;',
+  '  MinSafeIntDouble  = -$1fffffffffffff;',
+  '  MinSafeIntDouble2 = -$20000000000000-1;',
+  '  MaxSafeIntDouble =   $1fffffffffffff;',
   '  DZeroResolution = 1E-12;',
   '  Minus1 = -1E-12;',
   '  EPS = 1E-9;',
@@ -6235,9 +6237,9 @@ begin
     'this.fn1_0En12 = -1E-12;',
     'this.maxdouble = 1.7e+308;',
     'this.mindouble = -1.7e+308;',
-    'this.MinSafeIntDouble = -0x10000000000000;',
-    'this.MinSafeIntDouble2 = -0xfffffffffffff - 1;',
-    'this.MaxSafeIntDouble = 0xfffffffffffff;',
+    'this.MinSafeIntDouble = -0x1fffffffffffff;',
+    'this.MinSafeIntDouble2 = -0x20000000000000 - 1;',
+    'this.MaxSafeIntDouble = 0x1fffffffffffff;',
     'this.DZeroResolution = 1E-12;',
     'this.Minus1 = -1E-12;',
     'this.EPS = 1E-9;',
@@ -6278,11 +6280,11 @@ begin
     '$mod.d = -1E-12;',
     '$mod.d = 1.7E308;',
     '$mod.d = -1.7E308;',
-    '$mod.d = -4503599627370496;',
-    '$mod.d = -4503599627370496;',
-    '$mod.d = -4503599627370496;',
-    '$mod.d = -4503599627370496;',
-    '$mod.d = 4503599627370495;',
+    '$mod.d = -9007199254740991;',
+    '$mod.d = -9007199254740991;',
+    '$mod.d = -9.007199254740992E15;',
+    '$mod.d = -9.007199254740992E15;',
+    '$mod.d = 9007199254740991;',
     '$mod.d = 0.0;',
     '']));
 end;
@@ -6308,15 +6310,15 @@ begin
   ConvertProgram;
   CheckSource('TestIntegerRange',
     LinesToStr([
-    'this.MinInt = -4503599627370496;',
-    'this.MaxInt = 4503599627370495;',
-    'this.a = -4503599627370496 + 4503599627370495;',
+    'this.MinInt = -9007199254740991;',
+    'this.MaxInt = 9007199254740991;',
+    'this.a = -9007199254740991 + 9007199254740991;',
     'this.i = 0;',
     '']),
     LinesToStr([
-    '$mod.i = - -4503599627370496;',
-    '$mod.i = -4503599627370496;',
-    '$mod.i = -4503599627370496 + 4503599627370495;',
+    '$mod.i = - -9007199254740991;',
+    '$mod.i = -9007199254740991;',
+    '$mod.i = -9007199254740991 + 9007199254740991;',
     '']));
 end;
 
@@ -28656,6 +28658,55 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestOverflowChecks_Int;
+begin
+  Scanner.CurrentBoolSwitches:=Scanner.CurrentBoolSwitches+[bsOverflowChecks];
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var',
+  '  b: byte;',
+  '  n: nativeint;',
+  '  u: nativeuint;',
+  '  c: currency;',
+  'begin',
+  '  n:=n+n;',
+  '  n:=n-n;',
+  '  n:=n+b;',
+  '  n:=b-n;',
+  '  n:=n*n;',
+  '  n:=n*u;',
+  '  c:=c+b;',
+  '  c:=b+c;',
+  '  c:=c*b;',
+  '  c:=b*c;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestOverflowChecks_Int',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var b = 0;',
+    '  var n = 0;',
+    '  var u = 0;',
+    '  var c = 0;',
+    '  n = rtl.oc(n + n);',
+    '  n = rtl.oc(n - n);',
+    '  n = rtl.oc(n + b);',
+    '  n = rtl.oc(b - n);',
+    '  n = rtl.oc(n * n);',
+    '  n = rtl.oc(n * u);',
+    '  c = rtl.oc(c + (b * 10000));',
+    '  c = rtl.oc((b * 10000) + c);',
+    '  c = rtl.oc(c * b);',
+    '  c = rtl.oc(b * c);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRangeChecks_AssignInt;
 begin
   Scanner.Options:=Scanner.Options+[po_CAssignments];
@@ -29170,6 +29221,103 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRangeChecks_TypeHelperInt;
+begin
+  Scanner.Options:=Scanner.Options+[po_CAssignments];
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  '{$R+}',
+  'type',
+  '  TObject = class',
+  '    FSize: byte;',
+  '    property Size: byte read FSize;',
+  '  end;',
+  '  THelper = type helper for byte',
+  '    procedure SetIt(w: word);',
+  '  end;',
+  'procedure THelper.SetIt(w: word);',
+  'begin',
+  '  Self:=w;',
+  'end;',
+  'function GetIt: byte;',
+  'begin',
+  '  Result.SetIt(2);',
+  'end;',
+  'var',
+  '  b: byte = 3;',
+  '  o: TObject;',
+  'begin',
+  '  b.SetIt(14);',
+  '  with b do SetIt(15);',
+  '  o.Size.SetIt(16);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRangeChecks_AssignInt',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FSize = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.SetIt = function (w) {',
+    '    rtl.rc(w, 0, 65535);',
+    '    this.set(w);',
+    '  };',
+    '});',
+    'this.GetIt = function () {',
+    '  var Result = 0;',
+    '  $mod.THelper.SetIt.call({',
+    '    get: function () {',
+    '        return Result;',
+    '      },',
+    '    set: function (v) {',
+    '        rtl.rc(v, 0, 255);',
+    '        Result = v;',
+    '      }',
+    '  }, 2);',
+    '  return Result;',
+    '};',
+    'this.b = 3;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.THelper.SetIt.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.b;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.rc(v, 0, 255);',
+    '      this.p.b = v;',
+    '    }',
+    '}, 14);',
+    'var $with1 = $mod.b;',
+    '$mod.THelper.SetIt.call({',
+    '  get: function () {',
+    '      return $with1;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.rc(v, 0, 255);',
+    '      $with1 = v;',
+    '    }',
+    '}, 15);',
+    '$mod.THelper.SetIt.call({',
+    '  p: $mod.o,',
+    '  get: function () {',
+    '      return this.p.FSize;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.rc(v, 0, 255);',
+    '      this.p.FSize = v;',
+    '    }',
+    '}, 16);',
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestModule]);
 end.

utils/pas2jni/writer.pas

@@ -1143,6 +1143,7 @@ procedure TWriter.WriteVar(d: TVarDef; AParent: TDef);
         if (VarType.DefType = dtType) and (TTypeDef(VarType).BasicType in [btByte, btShortInt, btSmallInt]) then
           VarType:=FIntegerType;
         VarOpt:=[voRead];
+        IsUsed:=True;
       end;
       Result:=ad.ElType;
       ad:=TArrayDef(Result);
@@ -1651,12 +1652,15 @@ begin
 
       for i:=0 to u.Count - 1 do begin
         d:=u[i];
-        if (d.DefType = dtType) and (TTypeDef(d).BasicType = btLongInt) then begin
+        if (d.DefType = dtType) and (TTypeDef(d).BasicType = btLongInt) and (Copy(d.Name, 1, 1) <> '$') then begin
           FIntegerType:=d;
           break;
         end;
       end;
 
+      if FIntegerType = nil then
+        raise Exception.Create('LongInt type has not been found in the System unit.');
+
       if LibAutoLoad then begin
         Fjs.WriteLn('static private boolean _JniLibLoaded = false;');
         Fjs.WriteLn('public static void InitJni() {');
@@ -2041,9 +2045,9 @@ begin
 
       Fjs.WriteLn('private native static long InterfaceCast(long objptr, String objid);');
       Fjs.WriteLn;
-      Fjs.WriteLn('public static class PascalInterface extends PascalObjectEx {');
+      Fjs.WriteLn('public static abstract class PascalInterface extends PascalObjectEx {');
       Fjs.IncI;
-      Fjs.WriteLn('protected void __Init() { }');
+      Fjs.WriteLn('abstract protected void __Init();');
       Fjs.WriteLn('public void __TypeCast(PascalObject obj, String intfId) {');
       Fjs.WriteLn('if (obj != null) {', 1);
       Fjs.WriteLn('if (obj instanceof PascalInterface) {', 2);

utils/pas2js/dist/rtl.js

@@ -442,6 +442,7 @@ var rtl = {
   EInvalidCast: null,
   EAbstractError: null,
   ERangeError: null,
+  EIntOverflow: null,
   EPropWriteOnly: null,
 
   raiseE: function(typename){
@@ -728,6 +729,12 @@ var rtl = {
     rtl.raiseE("EInvalidCast");
   },
 
+  oc: function(i){
+    // overflow check integer
+    if ((Math.floor(i)===i) && (i>=-0x1fffffffffffff) && (i<=0x1fffffffffffff)) return i;
+    rtl.raiseE('EIntOverflow');
+  },
+
   rc: function(i,minval,maxval){
     // range check integer
     if ((Math.floor(i)===i) && (i>=minval) && (i<=maxval)) return i;

utils/pas2js/docs/translation.html

@@ -515,7 +515,7 @@ function(){
     <li><b>Integers overflows</b> at runtime differ from Delphi/FPC, due to the double format.
       For example adding <i>var i: byte = 200; ... i:=i+100;</i> will result in
       <i>i=300</i> instead of <i>i=44</i> as in Delphi/FPC.
-      When range checking <i>{$R+}</i> is enabled <i>i=300</i> will raise an ERangeError.</li>
+      When range checking <i>{$R+}</i> is enabled <i>i:=300</i> will raise an ERangeError.</li>
     <li><b>type cast integer to integer</b>, e.g. <i>byte(aLongInt)</i>
       <ul>
         <li>with range checking enabled: error if outside range</li>
@@ -3102,7 +3102,6 @@ End.
     <li>Package</li>
     <li>Resources</li>
     <li>RTTI extended, $RTTI</li>
-    <li>Runtime checks: Overflow -Co, $Q</li>
     <li>Variant records</li>
     <li>Variants</li>
     </ul>