pastojs: rename overloads in interface when intf finished

git-svn-id: trunk@38518 -

packages/pastojs/src/fppas2js.pp

@@ -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,37 +1828,20 @@ end;
 
 procedure TPas2JSResolver.RenameOverloadsInSection(aSection: TPasSection);
 var
-  ImplSection: TImplementationSection;
+  IntfSection: TInterfaceSection;
-  SectionClass: TClass;
 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;
+  if IntfSection<>nil then
-    end
-  else
-    begin
-    // program or library
-    RenameSubOverloads(aSection.Declarations);
-    end;
     PopOverloadScope;
   {$IFDEF VerbosePas2JS}
   //writeln('TPas2JSResolver.RenameOverloadsInSection END ',GetObjName(aSection));
@@ -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
+      if Proc.Body<>nil then
-        // proc implementation (not forward) -> skip
-        continue;
-      ImplProc:=Proc;
-      if ProcScope.ImplProc<>nil then
         begin
-        // this proc has a separate implementation
-        // -> switch to implementation
-        ImplProc:=ProcScope.ImplProc;
-        ProcScope:=ImplProc.CustomData as TPasProcedureScope;
-        end;
         PushOverloadScope(ProcScope);
         // first rename all overloads on this level
-      RenameOverloads(ImplProc.Body,ImplProc.Body.Declarations);
+        RenameOverloads(Proc.Body,Proc.Body.Declarations);
         // then process nested procedures
-      RenameSubOverloads(ImplProc.Body.Declarations);
+        RenameSubOverloads(Proc.Body.Declarations);
         PopOverloadScope;
+        end;
       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);
+  if FOverloadScopes=nil then
     FOverloadScopes:=TFPList.Create;
   try
     ModuleClass:=CurModule.ClassType;
     if ModuleClass=TPasModule then
-      begin
+      RenameOverloadsInSection(CurModule.ImplementationSection)
-      RenameOverloadsInSection(CurModule.InterfaceSection);
-      // Note: ImplementationSection is child of InterfaceSection
-      end
     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;
 

packages/pastojs/tests/tcmodules.pas

@@ -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);