paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 03:39:28 +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
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.

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

@ -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',