pastojs: fixed class interfaces when ancestor has more einterfaces

git-svn-id: trunk@38714 -

packages/pastojs/src/fppas2js.pp

@@ -9282,10 +9282,12 @@ var
     Map: TPasClassIntfMap;
     FinishedGUIDs: TStringList;
     Intf: TPasType;
+    CurEl: TPasClassType;
   begin
     if El.Interfaces.Count=0 then exit;
     IntfMaps:=nil;
 
+
     FinishedGUIDs:=TStringList.Create;
     try
       ObjLit:=nil;
@@ -9295,7 +9297,8 @@ var
           begin
           for i:=0 to Scope.Interfaces.Count-1 do
             begin
-            if not IsMemberNeeded(TPasElement(El.Interfaces[i])) then continue;
+            CurEl:=TPasClassType(Scope.Element);
+            if not IsMemberNeeded(TPasElement(CurEl.Interfaces[i])) then continue;
             if IntfMaps=nil then
               begin
               // add "this.$intfmaps = {};"

packages/pastojs/tests/tcmodules.pas

@@ -484,6 +484,7 @@ type
     Procedure TestClassInterface_AncestorImpl;
     Procedure TestClassInterface_ImplReintroduce;
     Procedure TestClassInterface_MethodResolution;
+    Procedure TestClassInterface_AncestorMoreInterfaces;
     Procedure TestClassInterface_Corba_Delegation;
     Procedure TestClassInterface_Corba_DelegationStatic;
     Procedure TestClassInterface_Corba_Operators;
@@ -12718,6 +12719,52 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassInterface_AncestorMoreInterfaces;
+begin
+  StartProgram(false);
+  Add([
+  '{$interfaces com}',
+  'type',
+  '  IUnknown = interface',
+  '    function _AddRef: longint;',
+  '    procedure Walk;',
+  '  end;',
+  '  IBird = interface end;',
+  '  IDog = interface end;',
+  '  TObject = class(IBird,IDog)',
+  '    function _AddRef: longint; virtual; abstract;',
+  '    procedure Walk; virtual; abstract;',
+  '  end;',
+  '  TBird = class(IUnknown)',
+  '  end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassInterface_COM_AncestorLess',
+    LinesToStr([ // statements
+    'rtl.createInterface($mod, "IUnknown", "{5D22E7CA-4E77-3872-9406-7588F5800000}", ["_AddRef", "Walk"], null);',
+    'rtl.createInterface($mod, "IBird", "{136757F2-AF76-3468-8338-1526EC563676}", [], $mod.IUnknown);',
+    'rtl.createInterface($mod, "IDog", "{136757F2-AF76-3468-8565-8D26EC563676}", [], $mod.IUnknown);',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.$intfmaps = {};',
+    '  rtl.addIntf(this, $mod.IBird);',
+    '  rtl.addIntf(this, $mod.IDog);',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.$intfmaps = {};',
+    '  rtl.addIntf(this, $mod.IUnknown);',
+    '  rtl.addIntf(this, $mod.IBird);',
+    '  rtl.addIntf(this, $mod.IDog);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestClassInterface_Corba_Delegation;
 begin
   StartProgram(false);