Browse Source

pastojs: use VarRecs only if called

git-svn-id: trunk@41333 -
Mattias Gaertner 6 years ago
parent
commit
e0ada1ced9
2 changed files with 66 additions and 14 deletions
  1. 44 11
      packages/pastojs/src/pas2jsuseanalyzer.pp
  2. 22 3
      packages/pastojs/tests/tcoptimizations.pas

+ 44 - 11
packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils,
-  PasUseAnalyzer, PasTree,
+  PasUseAnalyzer, PasTree, PasResolver,
   FPPas2Js;
 
 type
@@ -34,24 +34,57 @@ type
 
   TPas2JSAnalyzer = class(TPasAnalyzer)
   public
-    function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
-      override;
+    procedure UseExpr(El: TPasExpr); override;
   end;
 
 implementation
 
 { TPas2JSAnalyzer }
 
-function TPas2JSAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode
-  ): boolean;
+procedure TPas2JSAnalyzer.UseExpr(El: TPasExpr);
+
+  procedure CheckArgs(Args: TFPList);
+  var
+    i: Integer;
+    ArgType: TPasType;
+    ModScope: TPas2JSModuleScope;
+  begin
+    if Args=nil then exit;
+    for i:=0 to Args.Count-1 do
+      begin
+      ArgType:=TPasArgument(Args[i]).ArgType;
+      if ArgType=nil then continue;
+      if (ArgType.ClassType=TPasArrayType)
+          and (TPasArrayType(ArgType).ElType=nil) then
+        begin
+        // array of const
+        ModScope:=NoNil(Resolver.RootElement.CustomData) as TPas2JSModuleScope;
+        if ModScope.SystemVarRecs=nil then
+          RaiseNotSupported(20190216104347,El);
+        UseProcedure(ModScope.SystemVarRecs);
+        break;
+        end;
+      end;
+  end;
+
 var
-  ModScope: TPas2JSModuleScope;
+  Ref: TResolvedReference;
+  Decl: TPasElement;
 begin
-  Result:=inherited UseModule(aModule, Mode);
-  if not Result then exit;
-  ModScope:=aModule.CustomData as TPas2JSModuleScope;
-  if ModScope.SystemVarRecs<>nil then
-    UseProcedure(ModScope.SystemVarRecs);
+  if El=nil then exit;
+  inherited UseExpr(El);
+
+  Ref:=nil;
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasProcedure then
+      CheckArgs(TPasProcedure(Decl).ProcType.Args)
+    else if Decl.ClassType=TPasProperty then
+      CheckArgs(Resolver.GetPasPropertyArgs(TPasProperty(Decl)));
+    end;
 end;
 
 end.

+ 22 - 3
packages/pastojs/tests/tcoptimizations.pas

@@ -78,7 +78,8 @@ type
     procedure TestWPO_Class_OmitPropertySetter2;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
-    procedure TestWPO_ArrayOfConst;
+    procedure TestWPO_ArrayOfConst_Use;
+    procedure TestWPO_ArrayOfConst_NotUsed;
     procedure TestWPO_Class_PropertyInOtherUnit;
     procedure TestWPO_ProgramPublicDeclaration;
     procedure TestWPO_ConstructorDefaultValueConst;
@@ -815,12 +816,13 @@ begin
   CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
 end;
 
-procedure TTestOptimizations.TestWPO_ArrayOfConst;
+procedure TTestOptimizations.TestWPO_ArrayOfConst_Use;
 begin
   StartProgram(true,[supTVarRec]);
   Add([
   'procedure Say(arr: array of const);',
-  'begin end;',
+  'begin',
+  'end;',
   'begin',
   '  Say([true]);']);
   ConvertProgram;
@@ -851,6 +853,23 @@ begin
   '']));
 end;
 
+procedure TTestOptimizations.TestWPO_ArrayOfConst_NotUsed;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '});',
+  '']));
+end;
+
 procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
 begin
   AddModuleWithIntfImplSrc('unit1.pp',