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

pastojs: fixed type helper call as arg

Browse Source 
git-svn-id: trunk@41529 -
This commit is contained in:
Mattias Gaertner 2019-02-28 22:48:01 +00:00
parent f6cbe79a0a
commit f71fac34fd
3 changed files with 98 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -930,6 +930,7 @@ type
Procedure TestTypeHelper_Enumerator;
Procedure TestTypeHelper_String;
Procedure TestTypeHelper_Boolean;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_Constructor_NewInstance;
Procedure TestTypeHelper_InterfaceFail;
@ -17488,6 +17489,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
packages/pastojs/src/fppas2js.pp
View File

@ -18200,7 +18200,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;
@ -21352,7 +21352,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;
@ -21430,7 +21430,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;
@ -21499,7 +21499,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;
@ -21623,7 +21623,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);}}"
@ -21768,11 +21768,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
@ -21827,6 +21831,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
packages/pastojs/tests/tcmodules.pas
View File

@ -676,6 +676,7 @@ type
Procedure TestTypeHelper_ClassMethod;
Procedure TestTypeHelper_Constructor;
Procedure TestTypeHelper_Word;
Procedure TestTypeHelper_Double;
Procedure TestTypeHelper_StringChar;
Procedure TestTypeHelper_Array;
Procedure TestTypeHelper_EnumType;
@ -22893,6 +22894,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);