+ add support for type helpers to also extend interface types

git-svn-id: trunk@37023 -

.gitattributes

@@ -13445,6 +13445,7 @@ tests/test/tthlp20.pp svneol=native#text/pascal
 tests/test/tthlp21.pp svneol=native#text/pascal
 tests/test/tthlp22.pp svneol=native#text/pascal
 tests/test/tthlp23.pp svneol=native#text/pascal
+tests/test/tthlp24.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal

compiler/ncal.pas

@@ -3831,7 +3831,10 @@ implementation
                 method via its type is not possible (always must be called via
                 the actual instance) }
               if (methodpointer.nodetype=typen) and
-                 (is_interface(methodpointer.resultdef) or
+                 ((
+                   is_interface(methodpointer.resultdef) and not
+                   is_objectpascal_helper(tdef(procdefinition.owner.defowner))
+                  ) or
                   is_objc_protocol_or_category(methodpointer.resultdef)) then
                 CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename);
 

compiler/symconst.pas

@@ -889,7 +889,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
      default_class_type=odt_javaclass;
 {$endif not jvm}
 
-     objecttypes_with_helpers=[odt_class];
+     objecttypes_with_helpers=[odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface];
 
 { !! Be sure to keep these in sync with ones in rtl/inc/varianth.inc }
       varempty = 0;

tests/test/tthlp24.pp

@@ -0,0 +1,134 @@
+program tthlp24;
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+
+type
+  ITestIntf = interface
+    function Blubb: LongInt;
+    function Foobar: LongInt;
+  end;
+
+  ITestIntfSub = interface(ITestIntf)
+    function Something: LongInt;
+  end;
+
+  ITestIntfSubSub = interface(ITestIntfSub)
+    function SomethingElse: LongInt;
+  end;
+
+  TTest = class(TInterfacedObject, ITestIntf)
+    function Blubb: LongInt;
+    function Foobar: LongInt;
+  end;
+
+  TTestSub = class(TTest, ITestIntfSub)
+    function Something: LongInt;
+  end;
+
+  TTestSubSub = class(TTestSub, ITestIntfSubSub)
+    function SomethingElse: LongInt;
+  end;
+
+  TTestIntfHelper = type helper for ITestIntf
+    function Blubb: LongInt;
+    function Foobar(aArg: LongInt): LongInt; overload;
+    function Test: LongInt;
+    class function TestStatic: LongInt; static;
+  end;
+
+  TTestIntfSubSubHelper = type helper(TTestIntfHelper) for ITestIntfSubSub
+    function SomethingElse: LongInt;
+  end;
+
+{ TTestSubSub }
+
+function TTestSubSub.SomethingElse: LongInt;
+begin
+  Result := 9;
+end;
+
+{ TTestSub }
+
+function TTestSub.Something: LongInt;
+begin
+  Result := 8;
+end;
+
+{ TTestIntfSubSubHelper }
+
+function TTestIntfSubSubHelper.SomethingElse: LongInt;
+begin
+  Result := 7;
+end;
+
+{ TTest }
+
+function TTest.Blubb: LongInt;
+begin
+  Result := 4;
+end;
+
+function TTest.Foobar: LongInt;
+begin
+  Result := 5;
+end;
+
+{ TTestIntfHelper }
+
+function TTestIntfHelper.Blubb: LongInt;
+begin
+  Result := 3;
+end;
+
+function TTestIntfHelper.Foobar(aArg: LongInt): LongInt;
+begin
+  Result := aArg;
+end;
+
+function TTestIntfHelper.Test: LongInt;
+begin
+  Result := 1;
+end;
+
+class function TTestIntfHelper.TestStatic: LongInt;
+begin
+  Result := 2;
+end;
+
+var
+  i: ITestIntf;
+  _is: ITestIntfSub;
+  iss: ITestIntfSubSub;
+begin
+  i := TTest.Create;
+  if i.Test <> 1 then
+    Halt(1);
+  if i.TestStatic <> 2 then
+    Halt(2);
+  if ITestIntf.TestStatic <> 2 then
+    Halt(3);
+  if i.Blubb <> 3 then
+    Halt(4);
+  if i.Foobar <> 5 then
+    Halt(5);
+  if i.Foobar(6) <> 6 then
+    Halt(6);
+  i := Nil;
+
+  _is := TTestSub.Create;
+  if _is.Blubb <> 3 then
+    Halt(7);
+  if _is.Foobar(8) <> 8 then
+    Halt(8);
+  _is := Nil;
+
+  iss := TTestSubSub.Create;
+  if iss.SomethingElse <> 7 then
+    Halt(9);
+  if iss.Blubb <> 3 then
+    Halt(10);
+  iss := Nil;
+
+  Writeln('ok');
+end.