pastojs: overload distance for jsvalue

git-svn-id: trunk@35932 -

packages/pastojs/src/fppas2js.pp

@@ -246,6 +246,7 @@ Works:
   - use 0o for octal literals
 
 ToDos:
+- overload: jsvalue last,
 - constant evaluation
 - integer ranges
 - static arrays
@@ -696,8 +697,8 @@ const
 
 const
   ClassVarModifiersType = [vmClass,vmStatic];
-  LowJSNativeInt = -$10000000000000;
-  HighJSNativeInt = $fffffffffffff;
+  LowJSNativeInt = MinSafeIntDouble;
+  HighJSNativeInt = MaxSafeIntDouble;
   LowJSBoolean = false;
   HighJSBoolean = true;
 Type
@@ -860,6 +861,8 @@ type
     procedure AddExternalPath(aName: string; El: TPasElement);
     procedure ClearElementData; virtual;
   protected
+    const
+      cJSValueConversion = 2*cTypeConversion;
     // additional base types
     function AddJSBaseType(const aName: string; Typ: TPas2jsBaseType): TResElDataPas2JSBaseType;
     function IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType): boolean;
@@ -2325,14 +2328,14 @@ begin
         begin
         // RHS is a value
         if (RHS.BaseType in btAllJSValueSrcTypes) then
-          Result:=cExact+1 // type cast to JSValue
+          Result:=cJSValueConversion // type cast to JSValue
         else if RHS.BaseType=btCustom then
           begin
           if IsJSBaseType(RHS,pbtJSValue) then
             Result:=cExact;
           end
         else if RHS.BaseType=btContext then
-          Result:=cExact+1;
+          Result:=cJSValueConversion;
         end
       else if RHS.BaseType=btContext then
         begin
@@ -2340,7 +2343,7 @@ begin
         if RHS.IdentEl<>nil then
           begin
           if RHS.IdentEl.ClassType=TPasClassType then
-            Result:=cExact+1; // RHS is a class type
+            Result:=cJSValueConversion; // RHS is a class type
           end;
         end;
       end;
@@ -2358,7 +2361,7 @@ begin
       begin
       // array of jsvalue := array
       Handled:=true;
-      Result:=cExact+1;
+      Result:=cJSValueConversion;
       end;
     end;
 
@@ -2377,7 +2380,7 @@ begin
   ClassScope:=ToClass.CustomData as TPasClassScope;
   if ClassScope.AncestorScope=nil then
     // type cast to root class
-    Result:=cExact+1
+    Result:=cTypeConversion+1
   else
     Result:=cIncompatible;
   if ErrorEl=nil then ;
@@ -2409,14 +2412,14 @@ begin
         if (rrfReadable in RHS.Flags) then
           begin
           if RHS.BaseType in btAllJSValueSrcTypes then
-            Result:=cExact
+            Result:=cJSValueConversion
           else if RHS.BaseType=btCustom then
             begin
             if IsJSBaseType(RHS,pbtJSValue) then
               Result:=cExact;
             end
           else if RHS.BaseType=btContext then
-            Result:=cExact+1;
+            Result:=cJSValueConversion;
           end
         else if RHS.BaseType=btContext then
           begin
@@ -2424,7 +2427,7 @@ begin
           if RHS.IdentEl<>nil then
             begin
             if RHS.IdentEl.ClassType=TPasClassType then
-              Result:=cExact+1; // RHS is a class
+              Result:=cJSValueConversion; // RHS is a class
             end;
           end;
         end;

packages/pastojs/tests/tcmodules.pas

@@ -447,6 +447,12 @@ type
     Procedure TestJSValue_ProcType_Assign;
     Procedure TestJSValue_ProcType_Equal;
     Procedure TestJSValue_AssignToPointerFail;
+    Procedure TestJSValue_OverloadDouble;
+    Procedure TestJSValue_OverloadNativeInt;
+    Procedure TestJSValue_OverloadWord;
+    Procedure TestJSValue_OverloadString;
+    Procedure TestJSValue_OverloadChar;
+    Procedure TestJSValue_OverloadPointer;
 
     // RTTI
     Procedure TestRTTI_ProcType;
@@ -11769,6 +11775,317 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestJSValue_OverloadDouble;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  tdatetime = double;',
+  'procedure DoIt(d: double); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadDouble',
+    LinesToStr([ // statements
+    'this.DoIt = function (d) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.d);',
+    '$mod.DoIt($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadNativeInt;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(n: nativeint); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadNativeInt',
+    LinesToStr([ // statements
+    'this.DoIt = function (n) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadWord;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(w: word); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadWord',
+    LinesToStr([ // statements
+    'this.DoIt = function (w) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt$1($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt$1($mod.smi);',
+    '$mod.DoIt$1($mod.lw);',
+    '$mod.DoIt$1($mod.li);',
+    '$mod.DoIt$1($mod.ni);',
+    '$mod.DoIt$1($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadString;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(s: string); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadString',
+    LinesToStr([ // statements
+    'this.DoIt = function (s) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadChar;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(c: char); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadChar',
+    LinesToStr([ // statements
+    'this.DoIt = function (c) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt$1($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadPointer;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  'procedure DoIt(p: pointer); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  DoIt(o);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadPointer',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (p) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.o);',
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_ProcType;
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];