paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-13 15:19:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed type helper call as arg

Browse Source
This commit is contained in:
mattias 2019-02-28 22:48:25 +00:00
parent ef6fcf289f
commit 82953ae5b8
3 changed files with 98 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -925,6 +925,7 @@ type
Procedure TestTypeHelper_Enumerator;
Procedure TestTypeHelper_String;
Procedure TestTypeHelper_Boolean;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_Constructor_NewInstance;
Procedure TestTypeHelper_InterfaceFail;
@ -17291,6 +17292,30 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestTypeHelper_Double;
begin
StartProgram(false);
Add([
'{$modeswitch typehelpers}',
'type',
' Float = type double;',
' THelper = type helper for float',
' const NPI = 3.141592;',
' function ToStr: String;',
' end;',
'function THelper.ToStr: String;',
'begin',
'end;',
'var',
' a,b: Float;',
' s: string;',
'begin',
' s:=(a * b.NPI).ToStr;',
' s:=(a * float.NPI).ToStr;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
var
aMarker: PSrcMarker;

20
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -17825,7 +17825,7 @@ begin
// append args
ProcType:=Proc.ProcType;
if Expr.Parent is TParamsExpr then
if (Expr.Parent is TParamsExpr) and (TParamsExpr(Expr.Parent).Value=Expr) then
ParamsExpr:=TParamsExpr(Expr.Parent)
else
ParamsExpr:=nil;
@ -20878,7 +20878,7 @@ begin
begin
// pass set with argDefault -> create reference rtl.refSet(right)
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
writeln('TPasToJSConverter.CreateProcCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateReferencedSet(El,Result);
end;
@ -20956,7 +20956,7 @@ begin
begin
// pass record with argDefault -> "TGuid.$clone(RightRecord)"
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
writeln('TPasToJSConverter.CreateProcCallArg clone RECORD TGuid variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateRecordCallClone(El,TPasRecordType(ArgTypeEl),Result,AContext);
end;
@ -21025,7 +21025,7 @@ begin
begin
// pass record with argDefault -> "RightRecord.$clone(RightRecord)"
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
writeln('TPasToJSConverter.CreateProcCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
{$ENDIF}
Result:=CreateRecordCallClone(El,TPasRecordType(ExprTypeEl),Result,AContext);
end;
@ -21107,7 +21107,7 @@ begin
// ParamContext.Getter is the last part of the FullGetter
// FullSetter is created from FullGetter by replacing the Getter with the Setter
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArg VAR FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
writeln('TPasToJSConverter.CreateProcCallArgRef VAR El=',GetObjName(El),' FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter),' ',GetResolverResultDbg(ResolvedEl));
{$ENDIF}
// create "{p:path,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
@ -21252,11 +21252,15 @@ begin
else
begin
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter));
writeln('TPasToJSConverter.CreateProcCallArgRef FullGetter=',GetObjName(FullGetter),' Setter=',GetObjName(ParamContext.Setter));
{$ENDIF}
RaiseNotSupported(El,AContext,20170213230336);
end;
{$IFDEF VerbosePas2JS}
//writeln('TPasToJSConverter.CreateProcCallArgRef GetExpr=',GetObjName(GetExpr),' SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
{$ENDIF}
if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
or (SetExpr.ClassType=TJSDotMemberExpression)
or (SetExpr.ClassType=TJSBracketMemberExpression) then
@ -21307,6 +21311,10 @@ begin
else
RaiseInconsistency(20170213225940,El);
{$IFDEF VerbosePas2JS}
//writeln('TPasToJSConverter.CreateProcCallArgRef created full SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName);
{$ENDIF}
// add p:GetPathExpr
AddVar(TempRefGetPathName,GetPathExpr);

59
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -675,6 +675,7 @@ type
Procedure TestTypeHelper_ClassMethod;
Procedure TestTypeHelper_Constructor;
Procedure TestTypeHelper_Word;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_StringChar;
Procedure TestTypeHelper_Array;
Procedure TestTypeHelper_EnumType;
@ -22735,6 +22736,64 @@ begin
'']));
end;
procedure TTestModule.TestTypeHelper_Double;
begin
StartProgram(false);
Add([
'{$modeswitch typehelpers}',
'type',
' Float = type double;',
' THelper = type helper for double',
' const NPI = 3.141592;',
' function ToStr: String;',
' end;',
'function THelper.ToStr: String;',
'begin',
'end;',
'procedure DoIt(s: string);',
'begin',
'end;',
'var f: Float;',
'begin',
' DoIt(f.toStr);',
' DoIt(f.toStr());',
'']);
ConvertProgram;
CheckSource('TestTypeHelper_Double',
LinesToStr([ // statements
'rtl.createHelper($mod, "THelper", null, function () {',
' this.NPI = 3.141592;',
' this.ToStr = function () {',
' var Result = "";',
' return Result;',
' };',
'});',
'this.DoIt = function (s) {',
'};',
'this.f = 0.0;',
'']),
LinesToStr([ // $mod.$main
'$mod.DoIt($mod.THelper.ToStr.call({',
' p: $mod,',
' get: function () {',
' return this.p.f;',
' },',
' set: function (v) {',
' this.p.f = v;',
' }',
'}));',
'$mod.DoIt($mod.THelper.ToStr.call({',
' p: $mod,',
' get: function () {',
' return this.p.f;',
' },',
' set: function (v) {',
' this.p.f = v;',
' }',
'}));',
'']));
end;
procedure TTestModule.TestTypeHelper_StringChar;
begin
StartProgram(false);