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

pastojs: rename overloads in interface when intf finished

Browse Source 
git-svn-id: trunk@38518 -
This commit is contained in:
Mattias Gaertner 2018-03-13 18:36:02 +00:00
parent 602dd31a45
commit b24b2ee6fc
2 changed files with 78 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
packages/pastojs/src/fppas2js.pp
View File

@ -982,6 +982,7 @@ type
procedure ResolveImplAsm(El: TPasImplAsmStatement); override;
procedure ResolveNameExpr(El: TPasExpr; const aName: string;
Access: TResolvedRefAccess); override;
procedure FinishInterfaceSection(Section: TPasSection); override;
procedure FinishModule(CurModule: TPasModule); override;
procedure FinishEnumType(El: TPasEnumType); override;
procedure FinishSetType(El: TPasSetType); override;
@ -1827,38 +1828,21 @@ end;
procedure TPas2JSResolver.RenameOverloadsInSection(aSection: TPasSection);
var
ImplSection: TImplementationSection;
SectionClass: TClass;
IntfSection: TInterfaceSection;
begin
if aSection=nil then exit;
IntfSection:=nil;
if aSection.ClassType=TImplementationSection then
begin
IntfSection:=RootElement.InterfaceSection;
PushOverloadScope(IntfSection.CustomData as TPasIdentifierScope);
end;
PushOverloadScope(aSection.CustomData as TPasIdentifierScope);
RenameOverloads(aSection,aSection.Declarations);
SectionClass:=aSection.ClassType;
if SectionClass=TInterfaceSection then
begin
// unit interface
// first rename all overloads in interface and implementation
ImplSection:=(aSection.Parent as TPasModule).ImplementationSection;
if ImplSection<>nil then
begin
PushOverloadScope(ImplSection.CustomData as TPasIdentifierScope);
RenameOverloads(ImplSection,ImplSection.Declarations);
end;
// and then rename all nested overloads (e.g. methods)
// Important: nested overloads must check both interface and implementation
RenameSubOverloads(aSection.Declarations);
if ImplSection<>nil then
begin
RenameSubOverloads(ImplSection.Declarations);
PopOverloadScope;
end;
end
else
begin
// program or library
RenameSubOverloads(aSection.Declarations);
end;
RenameSubOverloads(aSection.Declarations);
PopOverloadScope;
if IntfSection<>nil then
PopOverloadScope;
{$IFDEF VerbosePas2JS}
//writeln('TPas2JSResolver.RenameOverloadsInSection END ',GetObjName(aSection));
{$ENDIF}
@ -1887,6 +1871,7 @@ begin
if ProcScope.ImplProc<>nil then
RaiseInternalError(20170221110853);
// proc implementation (not forward) -> skip
Proc.Name:=ProcScope.DeclarationProc.Name;
continue;
end;
if Proc.IsOverride then
@ -1899,7 +1884,7 @@ begin
if ProcScope.ImplProc<>nil then
ProcScope.ImplProc.Name:=Proc.Name;
end;
Continue;
continue;
end
else if Proc.IsExternal then
begin
@ -1922,7 +1907,7 @@ procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
var
i, OldScopeCount: Integer;
El: TPasElement;
Proc, ImplProc: TPasProcedure;
Proc: TPasProcedure;
ProcScope: TPasProcedureScope;
ClassScope, aScope: TPasClassScope;
ClassEl: TPasClassType;
@ -1935,28 +1920,19 @@ begin
if C.InheritsFrom(TPasProcedure) then
begin
Proc:=TPasProcedure(El);
if Proc.IsAbstract or Proc.IsExternal then continue;
ProcScope:=Proc.CustomData as TPasProcedureScope;
{$IFDEF VerbosePas2JS}
writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
{$ENDIF}
if ProcScope.DeclarationProc<>nil then
// proc implementation (not forward) -> skip
continue;
ImplProc:=Proc;
if ProcScope.ImplProc<>nil then
if Proc.Body<>nil then
begin
// this proc has a separate implementation
// -> switch to implementation
ImplProc:=ProcScope.ImplProc;
ProcScope:=ImplProc.CustomData as TPasProcedureScope;
PushOverloadScope(ProcScope);
// first rename all overloads on this level
RenameOverloads(Proc.Body,Proc.Body.Declarations);
// then process nested procedures
RenameSubOverloads(Proc.Body.Declarations);
PopOverloadScope;
end;
PushOverloadScope(ProcScope);
// first rename all overloads on this level
RenameOverloads(ImplProc.Body,ImplProc.Body.Declarations);
// then process nested procedures
RenameSubOverloads(ImplProc.Body.Declarations);
PopOverloadScope;
end
else if C=TPasClassType then
begin
@ -2146,19 +2122,27 @@ begin
end;
end;
procedure TPas2JSResolver.FinishInterfaceSection(Section: TPasSection);
begin
inherited FinishInterfaceSection(Section);
if FOverloadScopes=nil then
begin
FOverloadScopes:=TFPList.Create;
RenameOverloadsInSection(Section);
end;
end;
procedure TPas2JSResolver.FinishModule(CurModule: TPasModule);
var
ModuleClass: TClass;
begin
inherited FinishModule(CurModule);
FOverloadScopes:=TFPList.Create;
if FOverloadScopes=nil then
FOverloadScopes:=TFPList.Create;
try
ModuleClass:=CurModule.ClassType;
if ModuleClass=TPasModule then
begin
RenameOverloadsInSection(CurModule.InterfaceSection);
// Note: ImplementationSection is child of InterfaceSection
end
RenameOverloadsInSection(CurModule.ImplementationSection)
else if ModuleClass=TPasProgram then
RenameOverloadsInSection(TPasProgram(CurModule).ProgramSection)
else if CurModule.ClassType=TPasLibrary then
@ -2166,7 +2150,7 @@ begin
else
RaiseNotYetImplemented(20170221000032,CurModule);
finally
FOverloadScopes.Free;
FreeAndNil(FOverloadScopes);
end;
end;
@ -3095,6 +3079,7 @@ destructor TPas2JSResolver.Destroy;
begin
ClearElementData;
FreeAndNil(FExternalNames);
FreeAndNil(FOverloadScopes);
inherited Destroy;
end;

44
packages/pastojs/tests/tcmodules.pas
View File

@ -270,8 +270,9 @@ type
Procedure TestProc_VarParamV;
Procedure TestProc_Overload;
Procedure TestProc_OverloadForward;
Procedure TestProc_OverloadUnit;
Procedure TestProc_OverloadIntfImpl;
Procedure TestProc_OverloadNested;
Procedure TestProc_OverloadUnitCycle;
Procedure TestProc_Varargs;
Procedure TestProc_ConstOrder;
Procedure TestProc_LocalVarAbsolute;
@ -3091,7 +3092,7 @@ begin
'']));
end;
procedure TTestModule.TestProc_OverloadUnit;
procedure TTestModule.TestProc_OverloadIntfImpl;
begin
StartUnit(false);
Add('interface');
@ -3242,6 +3243,45 @@ begin
'']));
end;
procedure TTestModule.TestProc_OverloadUnitCycle;
begin
AddModuleWithIntfImplSrc('Unit2.pas',
LinesToStr([
'type',
' TObject = class',
' procedure DoIt(b: boolean); virtual; abstract;',
' procedure DoIt(i: longint); virtual; abstract;',
' end;',
'']),
'uses test1;');
StartUnit(true);
Add([
'interface',
'uses unit2;',
'type',
' TEagle = class(TObject)',
' procedure DoIt(b: boolean); override;',
' procedure DoIt(i: longint); override;',
' end;',
'implementation',
'procedure TEagle.DoIt(b: boolean); begin end;',
'procedure TEagle.DoIt(i: longint); begin end;',
'']);
ConvertUnit;
CheckSource('TestProc_OverloadUnitCycle',
LinesToStr([ // statements
'rtl.createClass($mod, "TEagle", pas.Unit2.TObject, function () {',
' this.DoIt = function (b) {',
' };',
' this.DoIt$1 = function (i) {',
' };',
'});',
'']),
'',
LinesToStr([
'']));
end;
procedure TTestModule.TestProc_Varargs;
begin
StartProgram(false);