paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 13:09:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: use VarRecs only if called

Browse Source 
git-svn-id: trunk@41333 -
This commit is contained in:
Mattias Gaertner 2019-02-16 09:46:38 +00:00
parent 3d2de82656
commit e0ada1ced9
2 changed files with 66 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
packages/pastojs/src/pas2jsuseanalyzer.pp
View File

@ -25,7 +25,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
PasUseAnalyzer, PasTree, PasUseAnalyzer, PasTree, PasResolver,
FPPas2Js; FPPas2Js;
type type
@ -34,24 +34,57 @@ type
TPas2JSAnalyzer = class(TPasAnalyzer) TPas2JSAnalyzer = class(TPasAnalyzer)
public public
function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; procedure UseExpr(El: TPasExpr); override;
override;
end; end;
implementation implementation
{ TPas2JSAnalyzer } { TPas2JSAnalyzer }
function TPas2JSAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode procedure TPas2JSAnalyzer.UseExpr(El: TPasExpr);
): boolean;
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 var
ModScope: TPas2JSModuleScope; Ref: TResolvedReference;
Decl: TPasElement;
begin begin
Result:=inherited UseModule(aModule, Mode); if El=nil then exit;
if not Result then exit; inherited UseExpr(El);
ModScope:=aModule.CustomData as TPas2JSModuleScope;
if ModScope.SystemVarRecs<>nil then Ref:=nil;
UseProcedure(ModScope.SystemVarRecs); 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;
end. end.

25
packages/pastojs/tests/tcoptimizations.pas
View File

@ -78,7 +78,8 @@ type
procedure TestWPO_Class_OmitPropertySetter2; procedure TestWPO_Class_OmitPropertySetter2;
procedure TestWPO_CallInherited; procedure TestWPO_CallInherited;
procedure TestWPO_UseUnit; procedure TestWPO_UseUnit;
procedure TestWPO_ArrayOfConst; procedure TestWPO_ArrayOfConst_Use;
procedure TestWPO_ArrayOfConst_NotUsed;
procedure TestWPO_Class_PropertyInOtherUnit; procedure TestWPO_Class_PropertyInOtherUnit;
procedure TestWPO_ProgramPublicDeclaration; procedure TestWPO_ProgramPublicDeclaration;
procedure TestWPO_ConstructorDefaultValueConst; procedure TestWPO_ConstructorDefaultValueConst;
@ -815,12 +816,13 @@ begin
CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc); CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
end; end;
procedure TTestOptimizations.TestWPO_ArrayOfConst; procedure TTestOptimizations.TestWPO_ArrayOfConst_Use;
begin begin
StartProgram(true,[supTVarRec]); StartProgram(true,[supTVarRec]);
Add([ Add([
'procedure Say(arr: array of const);', 'procedure Say(arr: array of const);',
'begin end;', 'begin',
'end;',
'begin', 'begin',
' Say([true]);']); ' Say([true]);']);
ConvertProgram; ConvertProgram;
@ -851,6 +853,23 @@ begin
''])); '']));
end; 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; procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
begin begin
AddModuleWithIntfImplSrc('unit1.pp', AddModuleWithIntfImplSrc('unit1.pp',