diff --git a/.gitattributes b/.gitattributes index 8ef735a518..1576393edf 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8045,6 +8045,7 @@ tests/webtbs/tw6641.pp svneol=native#text/plain tests/webtbs/tw6684.pp svneol=native#text/plain tests/webtbs/tw6686.pp svneol=native#text/plain tests/webtbs/tw6687.pp svneol=native#text/plain +tests/webtbs/tw6690.pp svneol=native#text/plain tests/webtbs/tw6700.pp svneol=native#text/plain tests/webtbs/tw6735.pp svneol=native#text/plain tests/webtbs/tw6742.pp svneol=native#text/plain diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index f200ca0cfe..9301f8d480 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -420,8 +420,12 @@ implementation end; odt_interfacecorba, odt_interfacecom: - if not(is_interface(childof)) then - Message(parser_e_mix_of_classes_and_objects); + begin + if not(is_interface(childof)) then + Message(parser_e_mix_of_classes_and_objects); + classtype:=childof.objecttype; + aktobjectdef.objecttype:=classtype; + end; odt_cppclass: if not(is_cppclass(childof)) then Message(parser_e_mix_of_classes_and_objects); diff --git a/tests/webtbs/tw6690.pp b/tests/webtbs/tw6690.pp new file mode 100644 index 0000000000..3dc1c443ec --- /dev/null +++ b/tests/webtbs/tw6690.pp @@ -0,0 +1,76 @@ +program inheritedcorba; +{$mode objfpc}{$h+} +uses + typinfo; + +type + {$interfaces corba} + iinterface1 = interface + procedure proc1; + end; + {$interfaces com} + iinterface2 = interface + procedure proc2; + end; + + iinterface3 = interface(iinterface1) + procedure proc3; + end; + iinterface4 = interface(iinterface2) + procedure proc4; + end; + + {$interfaces corba} + iinterface5 = interface(iinterface1) + procedure proc5; + end; + iinterface6 = interface(iinterface2) + procedure proc6; + end; + + tclass1 = class(iinterface1) + public + procedure proc1; + end; + +{tclass6 = class(iinterface6) + public + procedure proc6; + end; +} +{ does not compile because it is com style interface: + inheritedcorba.pas(36,12) Error: No matching implementation for + interface method "IUnknown.QueryInterface(const TGuid,out ): + LongInt;StdCall" found ... +} +procedure writeinterfacetype(po: ptypeinfo); +begin + case po^.kind of + tkinterfaceraw: if (po^.name<>'iinterface1') and + (po^.name<>'iinterface3') and + (po^.name<>'iinterface5') then + halt(1); + tkinterface: if (po^.name<>'iinterface2') and + (po^.name<>'iinterface4') and + (po^.name<>'iinterface6') then + halt(1); + else + halt(1); + end; +end; + +{ tclass1 } + +procedure tclass1.proc1; +begin +end; + +begin + writeinterfacetype(typeinfo(iinterface1)); + writeinterfacetype(typeinfo(iinterface2)); + writeinterfacetype(typeinfo(iinterface3)); + writeinterfacetype(typeinfo(iinterface4)); + writeinterfacetype(typeinfo(iinterface5)); + writeinterfacetype(typeinfo(iinterface6)); + writeln('ok'); +end.