pastojs fixed treating big ints as double

git-svn-id: trunk@41156 -

packages/pastojs/src/fppas2js.pp

@@ -1855,7 +1855,6 @@ type
       const LeftResolved, RightResolved: TPasResolverResult; var A,B: TJSElement): TJSElement; virtual;
     Function ConvertSubIdentExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertSubIdentExprCustom(El: TBinaryExpr; AContext: TConvertContext;
-      const LeftResolved: TPasResolverResult;
       const OnConvertRight: TConvertJSEvent = nil; Data: Pointer = nil): TJSElement; virtual;
     Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement; virtual;
@@ -7165,8 +7164,6 @@ function TPasToJSConverter.ConvertSubIdentExpression(El: TBinaryExpr;
   AContext: TConvertContext): TJSElement;
 // connect El.left and El.right with a dot.
 var
-  Left: TJSElement;
-  LeftResolved: TPasResolverResult;
   RightRef: TResolvedReference;
   RightEl: TPasExpr;
   RightRefDecl: TPasElement;
@@ -7179,55 +7176,108 @@ begin
   //       TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
 
   RightEl:=El.right;
-  RightRef:=nil;
-  RightRefDecl:=nil;
-  if (RightEl.ClassType=TPrimitiveExpr)
-      and (RightEl.CustomData is TResolvedReference) then
+  if (RightEl.ClassType<>TPrimitiveExpr) then
+    RaiseNotSupported(RightEl,AContext,20190131162250);
+  if not (RightEl.CustomData is TResolvedReference) then
+    RaiseNotSupported(RightEl,AContext,20190131162301);
+
+  RightRef:=TResolvedReference(RightEl.CustomData);
+  RightRefDecl:=RightRef.Declaration;
+  if aResolver.IsTObjectFreeMethod(RightEl) then
     begin
-    RightRef:=TResolvedReference(RightEl.CustomData);
-    RightRefDecl:=RightRef.Declaration;
-    if aResolver.IsTObjectFreeMethod(RightEl) then
-      begin
-      // e.g. Obj.Free;
-      Result:=ConvertTObjectFree_Bin(El,RightEl,AContext);
-      exit;
-      end
-    else if aResolver.IsExternalClassConstructor(RightRefDecl) then
-      begin
-      // e.g. mod.ExtClass.new;
-      if El.Parent is TParamsExpr then
-        // Note: ExtClass.new() is handled in ConvertFuncParams
-        RaiseNotSupported(El,AContext,20190116135818);
-      Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
-      exit;
-      end
-    else if RightRefDecl.ClassType=TPasProperty then
+    // e.g. Obj.Free;
+    Result:=ConvertTObjectFree_Bin(El,RightEl,AContext);
+    exit;
+    end
+  else if aResolver.IsExternalClassConstructor(RightRefDecl) then
+    begin
+    // e.g. mod.ExtClass.new;
+    if El.Parent is TParamsExpr then
+      // Note: ExtClass.new() is handled in ConvertFuncParams
+      RaiseNotSupported(El,AContext,20190116135818);
+    Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
+    exit;
+    end;
+
+  Result:=ConvertSubIdentExprCustom(El,AContext);
+end;
+
+function TPasToJSConverter.ConvertSubIdentExprCustom(El: TBinaryExpr;
+  AContext: TConvertContext; const OnConvertRight: TConvertJSEvent;
+  Data: Pointer): TJSElement;
+var
+  OldAccess: TCtxAccess;
+  Left: TJSElement;
+  DotContext: TDotContext;
+  Right: TJSElement;
+  aResolver: TPas2JSResolver;
+  LeftResolved: TPasResolverResult;
+  RightEl: TPasExpr;
+  RightRef: TResolvedReference;
+  RightRefDecl: TPasElement;
+begin
+  aResolver:=AContext.Resolver;
+
+  // Note: TPasParser guarantees that there is at most one TBinaryExpr between
+  //       TParamsExpr and its NameExpr. E.g. a.b.c() = ((a.b).c)()
+
+  RightEl:=El.right;
+  if (RightEl.ClassType<>TPrimitiveExpr) then
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.ConvertSubIdentExprCustom Bin=',El.OpCode,' El.Right=',GetObjName(RightEl));
+    {$ENDIF}
+    RaiseNotSupported(RightEl,AContext,20190131164529);
+    end;
+  if not (RightEl.CustomData is TResolvedReference) then
+    RaiseNotSupported(RightEl,AContext,20190131164530);
+
+  RightRef:=TResolvedReference(RightEl.CustomData);
+  RightRefDecl:=RightRef.Declaration;
+  if RightRefDecl.ClassType=TPasProperty then
+    begin
+    // redirect to Getter/Setter
+    case AContext.Access of
+    caAssign:
       begin
-      // redirect to Getter/Setter
-      case AContext.Access of
-      caAssign:
-        begin
-        RightRefDecl:=aResolver.GetPasPropertySetter(TPasProperty(RightRefDecl));
-        if RightRefDecl=nil then
-          RaiseNotSupported(RightEl,AContext,20190128153754);
-        end;
-      caRead:
-        begin
-        RightRefDecl:=aResolver.GetPasPropertyGetter(TPasProperty(RightRefDecl));
-        if RightRefDecl=nil then
-          RaiseNotSupported(RightEl,AContext,20190128153829);
-        end;
+      RightRefDecl:=aResolver.GetPasPropertySetter(TPasProperty(RightRefDecl));
+      if RightRefDecl=nil then
+        RaiseNotSupported(RightEl,AContext,20190128153754);
       end;
+    caRead:
+      begin
+      RightRefDecl:=aResolver.GetPasPropertyGetter(TPasProperty(RightRefDecl));
+      if RightRefDecl=nil then
+        RaiseNotSupported(RightEl,AContext,20190128153829);
       end;
-    if (AContext.Access=caAssign)
-        and aResolver.IsClassField(RightRefDecl) then
+    end;
+    end;
+  if (AContext.Access=caAssign)
+      and aResolver.IsClassField(RightRefDecl) then
+    begin
+    // e.g. "Something.aClassVar:=" -> "aClass.aClassVar:="
+    Left:=CreateReferencePathExpr(RightRefDecl.Parent,AContext);
+    Result:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+    TJSDotMemberExpression(Result).MExpr:=Left;
+    TJSDotMemberExpression(Result).Name:=TJSString(TransformVariableName(RightRefDecl,AContext));
+    exit;
+    end;
+  if (RightRefDecl.Parent.ClassType=TPasClassType)
+      and (TPasClassType(RightRefDecl.Parent).HelperForType<>nil) then
+    begin
+    // Left.HelperMember
+    if RightRefDecl is TPasVariable then
       begin
-      // e.g. "Something.aClassVar:=" -> "aClass.aClassVar:="
-      Left:=CreateReferencePathExpr(RightRefDecl.Parent,AContext);
-      Result:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-      TJSDotMemberExpression(Result).MExpr:=Left;
-      TJSDotMemberExpression(Result).Name:=TJSString(TransformVariableName(RightRefDecl,AContext));
+      // Left.HelperField
+      if Assigned(OnConvertRight) then
+        Result:=OnConvertRight(RightEl,AContext,Data)
+      else
+        Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,AContext);
       exit;
+      end
+    else
+      begin
+      RaiseNotSupported(El,AContext,20190131170119);
       end;
     end;
 
@@ -7235,27 +7285,14 @@ begin
     aResolver.ComputeElement(El.left,LeftResolved,[])
   else
     LeftResolved:=Default(TPasResolverResult);
-
-  Result:=ConvertSubIdentExprCustom(El,AContext,LeftResolved);
-end;
-
-function TPasToJSConverter.ConvertSubIdentExprCustom(El: TBinaryExpr;
-  AContext: TConvertContext; const LeftResolved: TPasResolverResult;
-  const OnConvertRight: TConvertJSEvent; Data: Pointer): TJSElement;
-var
-  OldAccess: TCtxAccess;
-  Left: TJSElement;
-  DotContext: TDotContext;
-  Right: TJSElement;
-begin
   if LeftResolved.BaseType=btModule then
     begin
     // e.g. system.inttostr()
     // module path is created automatically
     if Assigned(OnConvertRight) then
-      Result:=OnConvertRight(El.right,AContext,Data)
+      Result:=OnConvertRight(RightEl,AContext,Data)
     else
-      Result:=ConvertExpression(El.right,AContext);
+      Result:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,AContext);
     exit;
     end;
 
@@ -7273,16 +7310,9 @@ begin
   try
     DotContext.LeftResolved:=LeftResolved;
     if Assigned(OnConvertRight) then
-      Right:=OnConvertRight(El.right,DotContext,Data)
-    else if El.right.ClassType=TPrimitiveExpr then
-      Right:=ConvertPrimitiveExpression(TPrimitiveExpr(El.right),DotContext)
+      Right:=OnConvertRight(RightEl,DotContext,Data)
     else
-      begin
-      {$IFDEF VerbosePas2JS}
-      writeln('TPasToJSConverter.ConvertSubIdentExprCustom Bin=',El.OpCode,' El.Right=',GetObjName(El.right));
-      {$ENDIF}
-      RaiseNotSupported(El,AContext,20190130101045);
-      end;
+      Right:=ConvertIdentifierExpr(RightEl,TPrimitiveExpr(RightEl).Value,DotContext);
     if DotContext.JS<>nil then
       begin
       Left:=nil;
@@ -8620,7 +8650,6 @@ var
     aResolver: TPas2JSResolver;
     TypeEl: TPasType;
     Bin: TBinaryExpr;
-    LeftResolved: TPasResolverResult;
     CreateRefPathData: TCreateRefPathData;
   begin
     Result:=nil;
@@ -8664,11 +8693,10 @@ var
           Bin:=TBinaryExpr(El.Value);
           if Bin.OpCode<>eopSubIdent then
             RaiseNotSupported(El,AContext,20190116100510);
-          aResolver.ComputeElement(Bin.left,LeftResolved,[]);
           CreateRefPathData.El:=AccessEl;
           CreateRefPathData.Full:=false;
           CreateRefPathData.Ref:=GetValueReference;
-          Call.Expr:=ConvertSubIdentExprCustom(Bin,AContext,LeftResolved,
+          Call.Expr:=ConvertSubIdentExprCustom(Bin,AContext,
             @OnCreateReferencePathExpr,@CreateRefPathData);
           end
         else
@@ -8953,7 +8981,7 @@ var
   TargetProcType: TPasProcedureType;
   JsArrLit: TJSArrayLiteral;
   OldAccess: TCtxAccess;
-  DeclResolved, ParamResolved, ValueResolved, LeftResolved: TPasResolverResult;
+  DeclResolved, ParamResolved, ValueResolved: TPasResolverResult;
   Param, Value: TPasExpr;
   JSBaseType: TPas2jsBaseType;
   C: TClass;
@@ -9316,15 +9344,8 @@ begin
     if Call.Expr=nil then
       begin
       if DotBin<>nil then
-        begin
-        aResolver.ComputeElement(DotBin.left,LeftResolved,[]);
-        if LeftResolved.BaseType=btModule then
-          // e.g. system.inttostr()
-          // module path is created automatically
-        else
-          Call.Expr:=ConvertSubIdentExprCustom(DotBin,AContext,LeftResolved);
-        end;
-      if Call.Expr=nil then
+        Call.Expr:=ConvertSubIdentExprCustom(DotBin,AContext)
+      else
         Call.Expr:=ConvertExpression(El.Value,AContext);
       end;
     //if Call.Expr is TPrimitiveExpr then
@@ -9587,6 +9608,12 @@ begin
   JSBaseType:=pbtNone;
 
   to_bt:=ToBaseTypeData.BaseType;
+  if to_bt=ParamResolved.BaseType then
+    begin
+    Result:=ConvertExpression(Param,AContext);
+    exit;
+    end;
+
   if to_bt in btAllJSInteger then
     begin
     if ParamResolved.BaseType in btAllJSInteger then
@@ -19202,6 +19229,18 @@ function TPasToJSConverter.CreateReferencePath(El: TPasElement;
     aPath:=Prefix+aPath;
   end;
 
+  function NeedsWithExpr: boolean;
+  var
+    Parent: TPasElement;
+  begin
+    if (Ref=nil) or (Ref.WithExprScope=nil) then exit(false);
+    Parent:=El.Parent;
+    if (Parent<>nil) and (Parent.ClassType=TPasClassType)
+        and (TPasClassType(Parent).HelperForType<>nil) then
+      exit(false);
+    Result:=true;
+  end;
+
   function IsClassFunction(Proc: TPasElement): boolean;
   var
     C: TClass;
@@ -19319,12 +19358,6 @@ begin
         end;
       end;
     end
-  else if (Ref<>nil) and (Ref.WithExprScope<>nil) then
-    begin
-    // using local WITH var
-    WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
-    Prepend(Result,WithData.WithVarName);
-    end
   else if IsLocalVar then
     begin
     // El is local var -> does not need path
@@ -19332,7 +19365,7 @@ begin
   else if ElClass.InheritsFrom(TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil)
       and not (El.Parent is TPasMembersType) then
     begin
-    // an external function -> use the literal
+    // an external global function -> use the literal
     if Kind=rpkPathAndName then
       Result:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,AContext,true)
     else
@@ -19342,7 +19375,7 @@ begin
   else if ElClass.InheritsFrom(TPasVariable) and (TPasVariable(El).ExportName<>nil)
       and not (El.Parent is TPasMembersType) then
     begin
-    // an external var -> use the literal
+    // an external global var -> use the literal
     if Kind=rpkPathAndName then
       Result:=ComputeConstString(TPasVariable(El).ExportName,AContext,true)
     else
@@ -19355,6 +19388,12 @@ begin
     Result:=TPasClassType(El).ExternalName;
     exit;
     end
+  else if NeedsWithExpr then
+    begin
+    // using local WITH var
+    WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
+    Prepend(Result,WithData.WithVarName);
+    end
   else
     begin
     // need full path

packages/pastojs/tests/tcmodules.pas

@@ -2369,9 +2369,9 @@ begin
   Add('  d2: double = 5.6;');
   Add('  i3: longint = $707;');
   Add('  i4: nativeint = 4503599627370495;');
-  Add('  i5: nativeint = -4503599627370496;');
+  Add('  i5: nativeint = -4503599627370495-1;');
   Add('  i6: nativeint =   $fffffffffffff;');
-  Add('  i7: nativeint = -$10000000000000;');
+  Add('  i7: nativeint = -$fffffffffffff-1;');
   Add('  i8: byte = 00;');
   Add('  u8: nativeuint =  $fffffffffffff;');
   Add('  u9: nativeuint =  $0000000000000;');
@@ -2392,9 +2392,9 @@ begin
     'this.d2 = 5.6;',
     'this.i3 = 0x707;',
     'this.i4 = 4503599627370495;',
-    'this.i5 = -4503599627370496;',
+    'this.i5 = -4503599627370495-1;',
     'this.i6 = 0xfffffffffffff;',
-    'this.i7 =-0x10000000000000;',
+    'this.i7 =-0xfffffffffffff-1;',
     'this.i8 = 0;',
     'this.u8 = 0xfffffffffffff;',
     'this.u9 = 0x0;',
@@ -2703,10 +2703,10 @@ begin
   '  hi4:byte=hi(byte($34));',
   '  lo5:byte=lo(shortint(-$34));',
   '  hi5:byte=hi(shortint(-$34));',
-  '  lo6:longword=lo($123456789ABCDE);',
-  '  hi6:longword=hi($123456789ABCDE);',
-  '  lo7:longword=lo(-$123456789ABCDE);',
-  '  hi7:longword=hi(-$123456789ABCDE);',
+  '  lo6:longword=lo($123456789ABCD);',
+  '  hi6:longword=hi($123456789ABCD);',
+  '  lo7:longword=lo(-$123456789ABCD);',
+  '  hi7:longword=hi(-$123456789ABCD);',
   'var',
   '  b: Byte;',
   '  ss: shortint;',
@@ -2728,7 +2728,7 @@ begin
   '  lw := $1234CDEF;',
   '  w := lo(lw);',
   '  w := hi(lw);',
-  '  ni := $123456789ABCDE;',
+  '  ni := $123456789ABCD;',
   '  lw := lo(ni);',
   '  lw := hi(ni);',
   '']);
@@ -2747,10 +2747,10 @@ begin
     'this.hi4 = (0x34 >> 4) & 0xF;',
     'this.lo5 = (((-0x34 & 255) << 24) >> 24) & 0xFF;',
     'this.hi5 = ((((-0x34 & 255) << 24) >> 24) >> 8) & 0xFF;',
-    'this.lo6 = 0x123456789ABCDE >>> 0;',
-    'this.hi6 = 1193046 >>> 0;',
-    'this.lo7 = -0x123456789ABCDE >>> 0;',
-    'this.hi7 = Math.floor(-0x123456789ABCDE / 4294967296) >>> 0;',
+    'this.lo6 = 0x123456789ABCD >>> 0;',
+    'this.hi6 = 74565 >>> 0;',
+    'this.lo7 = -0x123456789ABCD >>> 0;',
+    'this.hi7 = Math.floor(-0x123456789ABCD / 4294967296) >>> 0;',
     'this.b = 0;',
     'this.ss = 0;',
     'this.w = 0;',
@@ -2772,7 +2772,7 @@ begin
     '$mod.lw = 0x1234CDEF;',
     '$mod.w = $mod.lw & 0xFFFF;',
     '$mod.w = ($mod.lw >> 16) & 0xFFFF;',
-    '$mod.ni = 0x123456789ABCDE;',
+    '$mod.ni = 0x123456789ABCD;',
     '$mod.lw = $mod.ni >>> 0;',
     '$mod.lw = Math.floor($mod.ni / 4294967296) >>> 0;',
     '']));
@@ -6011,6 +6011,7 @@ begin
   '  maxdouble = 1.7e+308;',
   '  mindouble = -1.7e+308;',
   '  MinSafeIntDouble = -$10000000000000;',
+  '  MinSafeIntDouble2 = -$fffffffffffff-1;',
   '  MaxSafeIntDouble =   $fffffffffffff;',
   '  DZeroResolution = 1E-12;',
   '  Minus1 = -1E-12;',
@@ -6053,6 +6054,9 @@ begin
   '  d:=maxdouble;',
   '  d:=mindouble;',
   '  d:=MinSafeIntDouble;',
+  '  d:=double(MinSafeIntDouble);',
+  '  d:=MinSafeIntDouble2;',
+  '  d:=double(MinSafeIntDouble2);',
   '  d:=MaxSafeIntDouble;',
   '  d:=default(double);',
   '']);
@@ -6077,6 +6081,7 @@ begin
     'this.maxdouble = 1.7e+308;',
     'this.mindouble = -1.7e+308;',
     'this.MinSafeIntDouble = -0x10000000000000;',
+    'this.MinSafeIntDouble2 = -0xfffffffffffff - 1;',
     'this.MaxSafeIntDouble = 0xfffffffffffff;',
     'this.DZeroResolution = 1E-12;',
     'this.Minus1 = -1E-12;',
@@ -6119,6 +6124,9 @@ begin
     '$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 = 0.0;',
     '']));
@@ -18538,8 +18546,6 @@ end;
 
 procedure TTestModule.TestClassHelper_ClassVar;
 begin
-  exit;
-
   StartProgram(false);
   Add([
   'type',
@@ -18555,41 +18561,82 @@ begin
   '  end;',
   'function THelper.foo(w: word): word;',
   'begin',
-  //'  Result:=w;',
-  //'  Two:=One+w;',
-  //'  Glob:=Glob;',
-  //'  Self.Glob:=Self.Glob;',
-  'Result:=Self.Glob;',
-  //'  with Self do Self.Glob:=Self.Glob;',
+  '  Result:=w;',
+  '  Two:=One+w;',
+  '  Glob:=Glob;',
+  '  Result:=Self.Glob;',
+  '  Self.Glob:=Self.Glob;',
+  '  with Self do Glob:=Glob;',
   'end;',
   'class function THelper.bar(w: word): word;',
   'begin',
   '  Result:=w;',
-  //'  Two:=One;',
-  //'  Glob:=Glob;',
-  //'  Self.Glob:=Self.Glob;',
-  //'  with Self do Self.Glob:=Self.Glob;',
+  '  Two:=One;',
+  '  Glob:=Glob;',
+  '  Self.Glob:=Self.Glob;',
+  '  with Self do Glob:=Glob;',
   'end;',
   'var o: TObject;',
   'begin',
-  //'  tobject.two:=tobject.one;',
-  //'  tobject.Glob:=tobject.Glob;',
-  //'  with tobject do begin',
-  //'    two:=one;',
-  //'    Glob:=Glob;',
-  //'  end;',
-  //'  o.two:=o.one;',
-  //'  o.Glob:=o.Glob;',
-  //'  with o do begin',
-  //'    two:=one;',
-  //'    Glob:=Glob;',
-  //'  end;',
+  '  tobject.two:=tobject.one;',
+  '  tobject.Glob:=tobject.Glob;',
+  '  with tobject do begin',
+  '    two:=one;',
+  '    Glob:=Glob;',
+  '  end;',
+  '  o.two:=o.one;',
+  '  o.Glob:=o.Glob;',
+  '  with o do begin',
+  '    two:=one;',
+  '    Glob:=Glob;',
+  '  end;',
   '']);
   ConvertProgram;
   CheckSource('TestClassHelper',
     LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.One = 1;',
+    '  this.Two = 2;',
+    '  this.Glob = 0;',
+    '  this.Foo = function (w) {',
+    '    var Result = 0;',
+    '    Result = w;',
+    '    $mod.THelper.Two = 1 + w;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    Result = $mod.THelper.Glob;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    return Result;',
+    '  };',
+    '  this.Bar = function (w) {',
+    '    var Result = 0;',
+    '    Result = w;',
+    '    $mod.THelper.Two = 1;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    $mod.THelper.Glob = $mod.THelper.Glob;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.o = null;',
     '']),
     LinesToStr([ // $mod.$main
+    '$mod.THelper.Two = 1;',
+    '$mod.THelper.Glob = $mod.THelper.Glob;',
+    'var $with1 = $mod.TObject;',
+    '$mod.THelper.Two = 1;',
+    '$mod.THelper.Glob = $mod.THelper.Glob;',
+    '$mod.THelper.Two = 1;',
+    '$mod.THelper.Glob = $mod.THelper.Glob;',
+    'var $with2 = $mod.o;',
+    '$mod.THelper.Two = 1;',
+    '$mod.THelper.Glob = $mod.THelper.Glob;',
     '']));
 end;