Browse Source

* don't crash on empty ProcDefs when handling interfaces, resolves #11295

git-svn-id: trunk@10978 -
florian 17 years ago
parent
commit
eca558b33b
4 changed files with 46 additions and 1 deletions
  1. 2 0
      .gitattributes
  2. 1 1
      compiler/symdef.pas
  3. 20 0
      tests/webtbs/tw11295a.pp
  4. 23 0
      tests/webtbs/tw11295b.pp

+ 2 - 0
.gitattributes

@@ -8206,6 +8206,8 @@ tests/webtbs/tw11254.pp svneol=native#text/plain
 tests/webtbs/tw11255.pp svneol=native#text/plain
 tests/webtbs/tw11288.pp svneol=native#text/plain
 tests/webtbs/tw11290.pp svneol=native#text/plain
+tests/webtbs/tw11295a.pp svneol=native#text/plain
+tests/webtbs/tw11295b.pp svneol=native#text/plain
 tests/webtbs/tw1132.pp svneol=native#text/plain
 tests/webtbs/tw1133.pp svneol=native#text/plain
 tests/webtbs/tw1152.pp svneol=native#text/plain

+ 1 - 1
compiler/symdef.pas

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

+ 20 - 0
tests/webtbs/tw11295a.pp

@@ -0,0 +1,20 @@
+program IntfDel;
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+
+uses
+  Classes;
+type
+  IA = interface
+  end;
+
+  TA = class(TObject, IA, IUnknown)
+  private
+    FUnknown: IUnknown;
+    property Unknown: IUnknown read FUnknown implements IUnknown;
+  end;
+
+begin
+end.

+ 23 - 0
tests/webtbs/tw11295b.pp

@@ -0,0 +1,23 @@
+program IntfDel;
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+
+uses
+  Classes;
+
+type
+  IA = interface
+  end;
+  IB = interface(IA)
+  end;
+
+  TA = class(TObject, IA, IB)
+  private
+    FA: IA;
+    property A: IA read FA implements IA;
+  end;
+
+begin
+end.