Browse Source

pastojs: shortrefglobals: generic helper method

git-svn-id: trunk@47278 -
(cherry picked from commit 0b670d0d3130db60dd73d0d3f161ddb4e239e5f8)
Mattias Gaertner 4 years ago
parent
commit
f94207053b
2 changed files with 166 additions and 56 deletions
  1. 64 54
      packages/pastojs/src/fppas2js.pp
  2. 102 2
      packages/pastojs/tests/tcoptimizations.pas

+ 64 - 54
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
-      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
+    else
       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
-        begin
-        // e.g. "with left do proc()"
-        // -> Left is the WithVarName
-        aResolver.ComputeElement(WithExprScope.Expr,LeftResolved,[]);
+      NameExpr:=Expr;
+      if NameExpr is TInlineSpecializeExpr then
+        NameExpr:=TInlineSpecializeExpr(NameExpr).NameExpr;
+      if NameExpr is TBinaryExpr then
+        begin
+        // 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
-        begin
-        // inside helper method, no explicit left expression
-        if IsStatic then
-          LeftResolved:=default(TPasResolverResult)
+      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
-          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,[]);
+          // 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
+        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);

+ 102 - 2
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<T>(a: word = 13): T;',
+    '    generic class function Say<T>(a: word = 13): T;',
+    '  end;',
+    '']),
+  LinesToStr([
+    'generic function TBirdHelper.Fly<T>(a: word): T;',
+    'begin',
+    'end;',
+    'generic class function TBirdHelper.Say<T>(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<Word>;',
+  '  specialize Fly<Word>(31);',
+  '  specialize Say<word>;',
+  '  specialize Say<Word>(32);',
+  '  self.specialize Fly<Word>;',
+  '  self.specialize Fly<Word>(41);',
+  '  self.specialize Say<Word>;',
+  '  self.specialize Say<Word>(42);',
+  '  with Self do begin',
+  '    specialize Fly<Word>;',
+  '    specialize Fly<Word>(51);',
+  '    specialize Say<Word>;',
+  '    specialize Say<Word>(52);',
+  '  end;',
+  'end;',
+  'class procedure TEagle.Lay;',
+  'begin',
+  '  specialize Say<Word>;',
+  '  specialize Say<Word>(32);',
+  '  self.specialize Say<Word>;',
+  '  self.specialize Say<Word>(42);',
+  '  with Self do begin',
+  '    specialize Say<Word>;',
+  '    specialize Say<Word>(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',