diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 276914a85d..39a6a2c435 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -20993,7 +20993,7 @@ var Bin: TBinaryExpr; LeftResolved: TPasResolverResult; SelfJS: TJSElement; - PosEl: TPasExpr; + PosEl, NameExpr: TPasExpr; ProcPath: String; Call: TJSCallExpression; IdentEl: TPasElement; @@ -21030,64 +21030,70 @@ begin PosEl:=Expr; aResolver.ComputeElement(Left,LeftResolved,[]); end - else if Expr is TBinaryExpr then + else begin - // e.g. "path.proc(args)" or "path.proc" - Bin:=TBinaryExpr(Expr); - if Bin.OpCode<>eopSubIdent then - RaiseNotSupported(Expr,AContext,20190201163152); - Left:=Bin.left; - aResolver.ComputeElement(Left,LeftResolved,[]); - PosEl:=Bin.right; - if PosEl.CustomData is TResolvedReference then - Ref:=TResolvedReference(PosEl.CustomData); - end - else if aResolver.IsNameExpr(Expr) then - begin - // e.g. "proc(args)" - PosEl:=Expr; - if not (Expr.CustomData is TResolvedReference) then - RaiseNotSupported(Expr,AContext,20190201163210); - Ref:=TResolvedReference(Expr.CustomData); - WithExprScope:=Ref.WithExprScope as TPas2JSWithExprScope; - if WithExprScope<>nil then + NameExpr:=Expr; + if NameExpr is TInlineSpecializeExpr then + NameExpr:=TInlineSpecializeExpr(NameExpr).NameExpr; + if NameExpr is TBinaryExpr then begin - // e.g. "with left do proc()" - // -> Left is the WithVarName - aResolver.ComputeElement(WithExprScope.Expr,LeftResolved,[]); + // e.g. "path.proc(args)" or "path.proc" + Bin:=TBinaryExpr(NameExpr); + if Bin.OpCode<>eopSubIdent then + RaiseNotSupported(NameExpr,AContext,20190201163152); + Left:=Bin.left; + aResolver.ComputeElement(Left,LeftResolved,[]); + PosEl:=Bin.right; + if PosEl.CustomData is TResolvedReference then + Ref:=TResolvedReference(PosEl.CustomData); + end + else if aResolver.IsNameExpr(NameExpr) then + begin + // e.g. "proc(args)" + PosEl:=NameExpr; + if not (NameExpr.CustomData is TResolvedReference) then + RaiseNotSupported(NameExpr,AContext,20190201163210); + Ref:=TResolvedReference(NameExpr.CustomData); + WithExprScope:=Ref.WithExprScope as TPas2JSWithExprScope; + if WithExprScope<>nil then + begin + // e.g. "with left do proc()" + // -> Left is the WithVarName + aResolver.ComputeElement(WithExprScope.Expr,LeftResolved,[]); + end + else + begin + // inside helper method, no explicit left expression + if IsStatic then + LeftResolved:=default(TPasResolverResult) + else + begin + SelfScope:=aResolver.GetSelfScope(NameExpr); + if SelfScope=nil then + RaiseNotSupported(PosEl,AContext,20190205171529); + if SelfScope.SelfArg=nil then + RaiseNotSupported(PosEl,AContext,20190205171902,GetObjName(SelfScope.Element)); + aResolver.ComputeElement(SelfScope.SelfArg,LeftResolved,[]); + end; + end; + end + else if NameExpr is TParamsExpr then + begin + // implicit call, e.g. default property a[] + PosEl:=NameExpr; + if not (NameExpr.CustomData is TResolvedReference) then + RaiseNotSupported(NameExpr,AContext,20190208105144); + Ref:=TResolvedReference(PosEl.CustomData); + if Ref.Declaration.ClassType<>TPasProperty then + RaiseNotSupported(NameExpr,AContext,20190208105222); + Left:=TParamsExpr(NameExpr).Value; + aResolver.ComputeElement(Left,LeftResolved,[]); end else begin - // inside helper method, no explicit left expression - if IsStatic then - LeftResolved:=default(TPasResolverResult) - else - begin - SelfScope:=aResolver.GetSelfScope(Expr); - if SelfScope=nil then - RaiseNotSupported(PosEl,AContext,20190205171529); - if SelfScope.SelfArg=nil then - RaiseNotSupported(PosEl,AContext,20190205171902,GetObjName(SelfScope.Element)); - aResolver.ComputeElement(SelfScope.SelfArg,LeftResolved,[]); - end; + RaiseNotSupported(NameExpr,AContext,20190201163210); + LeftResolved:=default(TPasResolverResult); end; - end - else if Expr is TParamsExpr then - begin - // implicit call, e.g. default property a[] - PosEl:=Expr; - if not (Expr.CustomData is TResolvedReference) then - RaiseNotSupported(Expr,AContext,20190208105144); - Ref:=TResolvedReference(PosEl.CustomData); - if Ref.Declaration.ClassType<>TPasProperty then - RaiseNotSupported(Expr,AContext,20190208105222); - Left:=TParamsExpr(Expr).Value; - aResolver.ComputeElement(Left,LeftResolved,[]); - end - else - begin - RaiseNotSupported(Expr,AContext,20190201163210); - LeftResolved:=default(TPasResolverResult); end; LoTypeEl:=LeftResolved.LoTypeEl; @@ -21234,7 +21240,11 @@ begin // create HelperType.HelperCall.call(SelfJS) Call:=CreateCallExpression(Expr); - ProcPath:=CreateReferencePath(Proc,AContext,rpkPathAndName); + if (coShortRefGlobals in Options) + and (TPas2JSProcedureScope(Proc.CustomData).SpecializedFromItem<>nil) then + ProcPath:=CreateGlobalElPath(Proc,AContext) + else + ProcPath:=CreateReferencePath(Proc,AContext,rpkPathAndName); if not IsStatic then ProcPath:=ProcPath+'.call'; Call.Expr:=CreatePrimitiveDotExpr(ProcPath,Expr); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 31093a78db..02d46a0513 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -65,10 +65,9 @@ type procedure TestOptShortRefGlobals_GenericMethod_Call; procedure TestOptShortRefGlobals_GenericStaticMethod_Call; // ToDo: GenericMethod_CallInherited ObjFPC+Delphi - // ToDo: procedure TestOptShortRefGlobals_GenericHelperMethod_Call_Delphi; + procedure TestOptShortRefGlobals_GenericClassHelperMethod; procedure TestOptShortRefGlobals_GenericMethod_ProcVar; procedure TestOptShortRefGlobals_GenericStaticMethod_ProcVar; - // ToDo: proc var procedure TestOptShortRefGlobals_SameUnit_EnumType; procedure TestOptShortRefGlobals_SameUnit_ClassType; procedure TestOptShortRefGlobals_SameUnit_RecordType; @@ -838,6 +837,107 @@ begin ''])); end; +procedure TTestOptimizations.TestOptShortRefGlobals_GenericClassHelperMethod; +begin + AddModuleWithIntfImplSrc('UnitA.pas', + LinesToStr([ + 'type', + ' TBird = class', + ' end;', + ' TBirdHelper = class helper for TBird', + ' generic function Fly(a: word = 13): T;', + ' generic class function Say(a: word = 13): T;', + ' end;', + '']), + LinesToStr([ + 'generic function TBirdHelper.Fly(a: word): T;', + 'begin', + 'end;', + 'generic class function TBirdHelper.Say(a: word): T;', + 'begin', + 'end;', + ''])); + StartUnit(true,[supTObject]); + Add([ + '{$optimization JSShortRefGlobals}', + 'interface', + 'uses unita;', + 'type', + ' TEagle = class(TBird)', + ' procedure Test;', + ' class procedure Lay;', + ' end;', + 'implementation', + 'procedure TEagle.Test;', + 'begin', + ' specialize Fly;', + ' specialize Fly(31);', + ' specialize Say;', + ' specialize Say(32);', + ' self.specialize Fly;', + ' self.specialize Fly(41);', + ' self.specialize Say;', + ' self.specialize Say(42);', + ' with Self do begin', + ' specialize Fly;', + ' specialize Fly(51);', + ' specialize Say;', + ' specialize Say(52);', + ' end;', + 'end;', + 'class procedure TEagle.Lay;', + 'begin', + ' specialize Say;', + ' specialize Say(32);', + ' self.specialize Say;', + ' self.specialize Say(42);', + ' with Self do begin', + ' specialize Say;', + ' specialize Say(52);', + ' end;', + 'end;', + '']); + ConvertUnit; + CheckSource('TestOptShortRefGlobals_GenericClassHelperMethod', + LinesToStr([ + 'var $lt = null;', + 'var $lm = pas.UnitA;', + 'var $lt1 = $lm.TBird;', + 'var $lt2 = $lm.TBirdHelper;', + 'var $lp = $lt2.Fly$G1;', + 'var $lp1 = $lt2.Say$G1;', + 'rtl.createClass(this, "TEagle", $lt1, function () {', + ' $lt = this;', + ' this.Test = function () {', + ' $lp.call(this, 13);', + ' $lp.call(this, 31);', + ' $lp1.call(this.$class, 13);', + ' $lp1.call(this.$class, 32);', + ' $lp.call(this, 13);', + ' $lp.call(this, 41);', + ' $lp1.call(this.$class, 13);', + ' $lp1.call(this.$class, 42);', + ' $lp.call(this, 13);', + ' $lp.call(this, 51);', + ' $lp1.call(this.$class, 13);', + ' $lp1.call(this.$class, 52);', + ' };', + ' this.Lay = function () {', + ' $lp1.call(this, 13);', + ' $lp1.call(this, 32);', + ' $lp1.call(this, 13);', + ' $lp1.call(this, 42);', + ' $lp1.call(this, 13);', + ' $lp1.call(this, 52);', + ' };', + '});', + '']), + LinesToStr([ + '']), + LinesToStr([ + ''])); +end; + procedure TTestOptimizations.TestOptShortRefGlobals_GenericMethod_ProcVar; begin AddModuleWithIntfImplSrc('UnitA.pas',