Browse Source

* patch by Aleksa Todorovic to fix generic interfaces, resolves #16100

git-svn-id: trunk@16477 -
florian 14 years ago
parent
commit
f570934b45
3 changed files with 24 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/symdef.pas
  3. 22 0
      tests/webtbs/tw16100.pp

+ 1 - 0
.gitattributes

@@ -10660,6 +10660,7 @@ tests/webtbs/tw16034.pp svneol=native#text/plain
 tests/webtbs/tw16040.pp svneol=native#text/plain
 tests/webtbs/tw16040.pp svneol=native#text/plain
 tests/webtbs/tw16065.pp svneol=native#text/pascal
 tests/webtbs/tw16065.pp svneol=native#text/pascal
 tests/webtbs/tw16083.pp svneol=native#text/plain
 tests/webtbs/tw16083.pp svneol=native#text/plain
+tests/webtbs/tw16100.pp svneol=native#text/pascal
 tests/webtbs/tw16108.pp svneol=native#text/plain
 tests/webtbs/tw16108.pp svneol=native#text/plain
 tests/webtbs/tw16130.pp svneol=native#text/pascal
 tests/webtbs/tw16130.pp svneol=native#text/pascal
 tests/webtbs/tw16161.pp svneol=native#text/pascal
 tests/webtbs/tw16161.pp svneol=native#text/pascal

+ 1 - 1
compiler/symdef.pas

@@ -5176,7 +5176,7 @@ implementation
       begin
       begin
         result:=false;
         result:=false;
         { interfaces being implemented through delegation are not mergable (FK) }
         { interfaces being implemented through delegation are not mergable (FK) }
-        if (IType<>etStandard) or (MergingIntf.IType<>etStandard) or not(assigned(ProcDefs)) then
+        if (IType<>etStandard) or (MergingIntf.IType<>etStandard) or not(assigned(ProcDefs)) or not(assigned(MergingIntf.ProcDefs)) then
           exit;
           exit;
         weight:=0;
         weight:=0;
         { empty interface is mergeable }
         { empty interface is mergeable }

+ 22 - 0
tests/webtbs/tw16100.pp

@@ -0,0 +1,22 @@
+{$mode objfpc}
+{$interfaces corba}
+type
+MyInterface = interface
+end;
+
+generic MyGenInterface<_T> = interface
+    procedure MyProc(x:_T);
+end;
+
+MyGenInterface_Pointer = specialize MyGenInterface<Pointer>;
+
+MyClass = class(MyInterface,MyGenInterface_Pointer)
+    procedure MyProc(x:Pointer);
+end;
+
+procedure MyClass.MyProc(x:Pointer);
+begin
+end;
+
+begin
+end.