paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 21:49:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: overload distance for jsvalue

Browse Source 
git-svn-id: trunk@35932 -
This commit is contained in:
Mattias Gaertner 2017-04-24 10:57:09 +00:00
parent 793622e3c9
commit a437e6ff5d
2 changed files with 330 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/pastojs/src/fppas2js.pp
View File

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

317
packages/pastojs/tests/tcmodules.pas
View File

@ -447,6 +447,12 @@ type
Procedure TestJSValue_ProcType_Assign; Procedure TestJSValue_ProcType_Assign;
Procedure TestJSValue_ProcType_Equal; Procedure TestJSValue_ProcType_Equal;
Procedure TestJSValue_AssignToPointerFail; Procedure TestJSValue_AssignToPointerFail;
Procedure TestJSValue_OverloadDouble;
Procedure TestJSValue_OverloadNativeInt;
Procedure TestJSValue_OverloadWord;
Procedure TestJSValue_OverloadString;
Procedure TestJSValue_OverloadChar;
Procedure TestJSValue_OverloadPointer;
// RTTI // RTTI
Procedure TestRTTI_ProcType; Procedure TestRTTI_ProcType;
@ -11769,6 +11775,317 @@ begin
ConvertProgram; ConvertProgram;
end; 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; procedure TTestModule.TestRTTI_ProcType;
begin begin
Converter.Options:=Converter.Options-[coNoTypeInfo]; Converter.Options:=Converter.Options-[coNoTypeInfo];