From 9a06e90b47b0c287125678f47e9b4a0092e0c477 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Fri, 8 Feb 2019 09:15:28 +0000 Subject: [PATCH] pastojs: helper: array property git-svn-id: trunk@41251 - --- packages/fcl-passrc/src/pasresolver.pp | 16 ++- packages/pastojs/src/fppas2js.pp | 55 +++++------ packages/pastojs/tests/tcmodules.pas | 129 ++++++++++++++++++++++++- 3 files changed, 168 insertions(+), 32 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 822ea1a74d..7846714f26 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -2004,6 +2004,8 @@ type function IsClassField(El: TPasElement): boolean; function GetFunctionType(El: TPasElement): TPasFunctionType; function IsMethod(El: TPasProcedure): boolean; + function IsHelperMethod(El: TPasElement): boolean; + function IsHelper(El: TPasElement): boolean; function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean; function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean; function IsArrayType(const ResolvedEl: TPasResolverResult): boolean; @@ -15942,7 +15944,8 @@ begin if ClassRecScope=nil then RaiseInternalError(20190123120156,GetObjName(StartScope)); TypeEl:=ClassRecScope.Element as TPasType; - if (TypeEl.ClassType=TPasClassType) and (TPasClassType(TypeEl).HelperForType<>nil) then + if (TypeEl.ClassType=TPasClassType) + and (TPasClassType(TypeEl).HelperForType<>nil) then TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType); TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl; if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then @@ -22084,6 +22087,17 @@ begin Result:=IsMethod(ProcScope.DeclarationProc); end; +function TPasResolver.IsHelperMethod(El: TPasElement): boolean; +begin + Result:=(El is TPasProcedure) and (El.Parent is TPasClassType) + and (TPasClassType(El.Parent).HelperForType<>nil); +end; + +function TPasResolver.IsHelper(El: TPasElement): boolean; +begin + Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil); +end; + function TPasResolver.IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean; var diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 9560236ef9..db4ceda242 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1806,7 +1806,7 @@ type Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement); // create elements for helpers Function CreateCallHelperMethod(Proc: TPasProcedure; Expr: TPasExpr; - AContext: TConvertContext): TJSElement; virtual; + AContext: TConvertContext): TJSCallExpression; virtual; // Statements Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual; @@ -7301,8 +7301,7 @@ begin end; LeftJS:=nil; - if (RightRefDecl.Parent.ClassType=TPasClassType) - and (TPasClassType(RightRefDecl.Parent).HelperForType<>nil) then + if aResolver.IsHelper(RightRefDecl.Parent) then begin // LeftJS.HelperMember if RightRefDecl is TPasVariable then @@ -7702,8 +7701,7 @@ begin Decl:=aResolver.GetPasPropertySetter(Prop); if Decl is TPasProcedure then begin - if (Decl.Parent is TPasClassType) - and (TPasClassType(Decl.Parent).HelperForType<>nil) then + if aResolver.IsHelper(Decl.Parent) then begin Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext); exit; @@ -7772,8 +7770,7 @@ begin Call.AddArg(CreateLiteralString(El,TransformVariableName(Decl,AContext))); exit; end - else if (Decl is TPasProcedure) and (Decl.Parent is TPasClassType) - and (TPasClassType(Decl.Parent).HelperForType<>nil) + else if aResolver.IsHelperMethod(Decl) and not (rrfNoImplicitCallWithoutParams in Ref.Flags) then begin Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext); @@ -8712,17 +8709,18 @@ var Result:=nil; AssignContext:=nil; aResolver:=AContext.Resolver; - Call:=CreateCallExpression(El); + Call:=nil; try case AContext.Access of caAssign: begin AccessEl:=aResolver.GetPasPropertySetter(Prop); if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then - begin - FreeAndNil(Call); exit; - end; + if aResolver.IsHelperMethod(AccessEl) then + Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El.Value,AContext) + else + Call:=CreateCallExpression(El); AssignContext:=AContext.AccessContext as TAssignContext; AssignContext.PropertyEl:=Prop; AssignContext.Call:=Call; @@ -8731,16 +8729,17 @@ var begin AccessEl:=aResolver.GetPasPropertyGetter(Prop); if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then - begin - FreeAndNil(Call); exit; - end; + if aResolver.IsHelperMethod(AccessEl) then + Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El.Value,AContext) + else + Call:=CreateCallExpression(El); end else RaiseNotSupported(El,AContext,20170213213317); end; - if CheckPath then + if CheckPath and (Call.Expr=nil) then if aResolver.IsNameExpr(El.Value) then // no special context else if El.Value is TBinaryExpr then @@ -8953,12 +8952,11 @@ begin writeln('TPasToJSConverter.ConvertArrayParams Value=',GetResolverResultDbg(ResolvedEl)); {$ENDIF} if ResolvedEl.BaseType in btAllJSStrings then - // astring[] + // aString[] ConvertStringBracket(ResolvedEl) else if (ResolvedEl.IdentEl is TPasProperty) - and (aResolver.IsNameExpr(El.Value) or (El.Value is TBinaryExpr)) and (aResolver.GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then - // aproperty[] + // aProperty[] ConvertIndexedProperty(TPasProperty(ResolvedEl.IdentEl),AContext,true) else if ResolvedEl.BaseType=btContext then begin @@ -9167,8 +9165,7 @@ begin end else if C.InheritsFrom(TPasProcedure) then begin - if (Decl.Parent is TPasClassType) - and (TPasClassType(Decl.Parent).HelperForType<>nil) then + if aResolver.IsHelper(Decl.Parent) then begin // calling a helper method Result:=CreateCallHelperMethod(TPasProcedure(Decl),El.Value,AContext); @@ -14038,8 +14035,7 @@ begin else begin ThisPas:=ProcScope.ClassRecScope.Element; - if (ThisPas.ClassType=TPasClassType) - and (TPasClassType(ThisPas).HelperForType<>nil) then + if aResolver.IsHelper(ThisPas) then begin // helper method HelperForType:=aResolver.ResolveAliasType(TPasClassType(ThisPas).HelperForType); @@ -15471,8 +15467,7 @@ begin Result:=CreateReferencePathExpr(Proc,AContext); exit; end; - IsHelper:=(Proc.Parent.ClassType=TPasClassType) - and (TPasClassType(Proc.Parent).HelperForType<>nil); + IsHelper:=aResolver.IsHelper(Proc.Parent); NeedClass:=aResolver.IsClassMethod(Proc); // an of-object method -> create "rtl.createCallback(Target,func)" @@ -15870,8 +15865,7 @@ begin if (Expr<>nil) then begin // explicit property read - if (Decl.Parent is TPasClassType) - and (TPasClassType(Decl.Parent).HelperForType<>nil) then + if aResolver.IsHelper(Decl.Parent) then begin Result:=CreateCallHelperMethod(TPasProcedure(Decl),Expr,AContext); exit; @@ -16919,7 +16913,7 @@ begin end; function TPasToJSConverter.CreateCallHelperMethod(Proc: TPasProcedure; - Expr: TPasExpr; AContext: TConvertContext): TJSElement; + Expr: TPasExpr; AContext: TConvertContext): TJSCallExpression; var Left: TPasExpr; WithExprScope: TPas2JSWithExprScope; @@ -17202,6 +17196,13 @@ begin if Prop<>nil then begin + if aResolver.GetPasPropertyArgs(Prop).Count>0 then + begin + // arguments are passed by ConvertParamsExpr + Result:=Call; + Call:=nil; + exit; + end; case AContext.Access of caAssign: begin diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index cc069334c8..27f7f61a2d 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -638,11 +638,10 @@ type Procedure TestClassHelper_Constructor; Procedure TestClassHelper_InheritedObjFPC; Procedure TestClassHelper_Property; - // todo: TestClassHelper_Property_Array - // todo: TestClassHelper_Property_Index - // todo: TestClassHelper_ClassProperty + Procedure TestClassHelper_Property_Array; + //Procedure TestClassHelper_Property_Array_Default; + // todo: TestClassHelper_ClassProperty static/nonstatic // todo: TestClassHelper_ClassProperty_Array - // todo: TestClassHelper_ClassProperty_Index // todo: TestClassHelper_Overload // todo: TestClassHelper_ForIn // todo: TestRecordHelper_ClassVar @@ -19534,6 +19533,128 @@ begin ''])); end; +procedure TTestModule.TestClassHelper_Property_Array; +begin + StartProgram(false); + Add([ + 'type', + ' TObject = class', + ' function GetSpeed(Index: boolean): word;', + ' procedure SetSpeed(Index: boolean; Value: word);', + ' end;', + ' TObjHelper = class helper for TObject', + ' function GetSize(Index: boolean): word;', + ' procedure SetSize(Index: boolean; Value: word);', + ' property Size[Index: boolean]: word read GetSize write SetSize;', + ' property Speed[Index: boolean]: word read GetSpeed write SetSpeed;', + ' end;', + ' TBird = class', + ' property Items[Index: boolean]: word read GetSize write SetSize;', + ' procedure DoIt;', + ' end;', + 'var', + ' b: TBird;', + 'function Tobject.GetSpeed(Index: boolean): word;', + 'begin', + ' Result:=Size[false];', + ' Size[true]:=Size[false]+11;', + ' Speed[true]:=Speed[false]+12;', + ' Self.Size[true]:=Self.Size[false]+21;', + ' Self.Speed[true]:=Self.Speed[false]+22;', + ' with Self do begin', + ' Size[true]:=Size[false]+31;', + ' Speed[true]:=Speed[false]+32;', + ' end;', + 'end;', + 'procedure Tobject.SetSpeed(Index: boolean; Value: word);', + 'begin', + 'end;', + 'function TObjHelper.GetSize(Index: boolean): word;', + 'begin', + ' Size[true]:=Size[false]+11;', + ' Speed[true]:=Speed[false]+12;', + ' Self.Size[true]:=Self.Size[false]+21;', + ' Self.Speed[true]:=Self.Speed[false]+22;', + ' with Self do begin', + ' Size[true]:=Size[false]+31;', + ' Speed[true]:=Speed[false]+32;', + ' end;', + 'end;', + 'procedure TObjHelper.SetSize(Index: boolean; Value: word);', + 'begin', + 'end;', + 'procedure TBird.DoIt;', + 'begin', + ' Items[true]:=Items[false]+11;', + ' Self.Items[true]:=Self.Items[false]+21;', + ' with Self do Items[true]:=Items[false]+31;', + 'end;', + 'begin', + ' b.Size[true]:=b.Size[false]+11;', + ' b.Speed[true]:=b.Speed[false]+12;', + ' b.Items[true]:=b.Items[false]+13;', + ' with b do begin', + ' Size[true]:=Size[false]+21;', + ' Speed[true]:=Speed[false]+22;', + ' Items[true]:=Items[false]+23;', + ' end;', + '']); + ConvertProgram; + CheckSource('TestClassHelper_Property_Array', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' };', + ' this.$final = function () {', + ' };', + ' this.GetSpeed = function (Index) {', + ' var Result = 0;', + ' Result = $mod.TObjHelper.GetSize.apply(this, false);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);', + ' this.SetSpeed(true, this.GetSpeed(false) + 12);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);', + ' this.SetSpeed(true, this.GetSpeed(false) + 22);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);', + ' this.SetSpeed(true, this.GetSpeed(false) + 32);', + ' return Result;', + ' };', + ' this.SetSpeed = function (Index, Value) {', + ' };', + '});', + 'rtl.createHelper($mod, "TObjHelper", null, function () {', + ' this.GetSize = function (Index) {', + ' var Result = 0;', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);', + ' this.SetSpeed(true, this.GetSpeed(false) + 12);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);', + ' this.SetSpeed(true, this.GetSpeed(false) + 22);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);', + ' this.SetSpeed(true, this.GetSpeed(false) + 32);', + ' return Result;', + ' };', + ' this.SetSize = function (Index, Value) {', + ' };', + '});', + 'rtl.createClass($mod, "TBird", $mod.TObject, function () {', + ' this.DoIt = function () {', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);', + ' $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);', + ' };', + '});', + 'this.b = null;', + '']), + LinesToStr([ // $mod.$main + '$mod.TObjHelper.SetSize.apply($mod.b, true, $mod.TObjHelper.GetSize.apply($mod.b, false) + 11);', + '$mod.b.SetSpeed(true, $mod.b.GetSpeed(false) + 12);', + '$mod.TObjHelper.SetSize.apply($mod.b, true, $mod.TObjHelper.GetSize.apply($mod.b, false) + 13);', + 'var $with1 = $mod.b;', + '$mod.TObjHelper.SetSize.apply($with1, true, $mod.TObjHelper.GetSize.apply($with1, false) + 21);', + '$with1.SetSpeed(true, $with1.GetSpeed(false) + 22);', + '$mod.TObjHelper.SetSize.apply($with1, true, $mod.TObjHelper.GetSize.apply($with1, false) + 23);', + ''])); +end; + procedure TTestModule.TestProcType; begin StartProgram(false);