mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 21:09:24 +02:00
pastojs: helper: array property
git-svn-id: trunk@41251 -
This commit is contained in:
parent
ff90e7622a
commit
9a06e90b47
@ -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
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
Loading…
Reference in New Issue
Block a user