pastojs: helper: array property

git-svn-id: trunk@41251 -
This commit is contained in:
Mattias Gaertner 2019-02-08 09:15:28 +00:00
parent ff90e7622a
commit 9a06e90b47
3 changed files with 168 additions and 32 deletions

View File

@ -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

View File

@ -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

View File

@ -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);