paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed typecast jsvalue(anobject/interface)

Browse Source 
git-svn-id: trunk@41346 -
This commit is contained in:
Mattias Gaertner 2019-02-16 19:48:10 +00:00
parent d2203e460c
commit 3cb31b75a7
2 changed files with 47 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1218,7 +1218,7 @@ const
btIntDouble,btUIntDouble,
btCurrency // in pas2js currency is more like an integer, instead of float
];
btAllJSValueSrcTypes = [btNil,btUntyped,btPointer]+btAllJSInteger
btAllJSValueSrcTypes = [btNil,btUntyped,btPointer,btSet]+btAllJSInteger
+btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans;
btAllJSValueTypeCastTo = btAllJSInteger
+btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans+[btPointer];
@ -9808,8 +9808,6 @@ var
Call: TJSCallExpression;
NotExpr: TJSUnaryNotExpression;
AddExpr: TJSAdditiveExpressionPlus;
TypeEl: TPasType;
C: TClass;
Int: TMaxPrecInt;
aResolver: TPas2JSResolver;
begin
@ -10072,20 +10070,6 @@ begin
begin
// type cast to jsvalue
Result:=ConvertExpression(Param,AContext);
// Note: convert value first in case it raises an exception
if ParamResolved.BaseType=btContext then
begin
TypeEl:=ParamResolved.LoTypeEl;
C:=TypeEl.ClassType;
if (C=TPasClassType) or (C=TPasRecordType) then
begin
// TObject(jsvalue) -> rtl.getObject(jsvalue)
Call:=CreateCallExpression(El);
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnGetObject)]);
Call.AddArg(Result);
Result:=Call;
end;
end;
exit;
end;
end;

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

@ -720,6 +720,7 @@ type
// jsvalue
Procedure TestJSValue_AssignToJSValue;
Procedure TestJSValue_TypeCastToBaseType;
Procedure TestJSValue_TypecastToJSValue;
Procedure TestJSValue_Equal;
Procedure TestJSValue_If;
Procedure TestJSValue_Not;
@ -17428,7 +17429,7 @@ begin
'$mod.v = $mod.IntfVar;',
'$mod.IntfVar = rtl.getObject($mod.v);',
'if (rtl.isExt($mod.v, $mod.IBird, 1)) ;',
'$mod.v = rtl.getObject($mod.IntfVar);',
'$mod.v = $mod.IntfVar;',
'$mod.v = $mod.IBird;',
'']));
end;
@ -24882,6 +24883,50 @@ begin
'']));
end;
procedure TTestModule.TestJSValue_TypecastToJSValue;
begin
StartProgram(false);
Add([
'type',
' TArr = array of word;',
' TRec = record end;',
' TSet = set of boolean;',
'procedure Fly(v: jsvalue);',
'begin',
'end;',
'var',
' a: TArr;',
' r: TRec;',
' s: TSet;',
'begin',
' Fly(jsvalue(a));',
' Fly(jsvalue(r));',
' Fly(jsvalue(s));',
'']);
ConvertProgram;
CheckSource('TestJSValue_TypecastToJSValue',
LinesToStr([ // statements
'rtl.recNewT($mod, "TRec", function () {',
' this.$eq = function (b) {',
' return true;',
' };',
' this.$assign = function (s) {',
' return this;',
' };',
'});',
'this.Fly = function (v) {',
'};',
'this.a = [];',
'this.r = $mod.TRec.$new();',
'this.s = {};',
'']),
LinesToStr([ // $mod.$main
'$mod.Fly($mod.a);',
'$mod.Fly($mod.r);',
'$mod.Fly($mod.s);',
'']));
end;
procedure TTestModule.TestJSValue_Equal;
begin
StartProgram(false);