diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 98f9fead36..ca5bcf88ae 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -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; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index dd8ed8538d..b0b37b48c2 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -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); diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 855cfedb1d..981aff4945 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -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);