From 5e36a73b806e09f5d6239d874334c7d5fdd2efc1 Mon Sep 17 00:00:00 2001 From: peter Date: Sun, 22 Jul 2007 19:47:55 +0000 Subject: [PATCH] * create a new vmt entry also if return type differs * search all parent classes for matching interface implementations git-svn-id: trunk@8138 - --- .gitattributes | 3 +- compiler/nobj.pas | 78 ++++++++++++++++------------------------- tests/webtbf/tw3183b.pp | 14 -------- tests/webtbs/tw9306a.pp | 63 +++++++++++++++++++++++++++++++++ tests/webtbs/tw9306b.pp | 63 +++++++++++++++++++++++++++++++++ 5 files changed, 159 insertions(+), 62 deletions(-) delete mode 100644 tests/webtbf/tw3183b.pp create mode 100644 tests/webtbs/tw9306a.pp create mode 100644 tests/webtbs/tw9306b.pp diff --git a/.gitattributes b/.gitattributes index 03d45c24c6..d3af86cbe4 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7285,7 +7285,6 @@ tests/webtbf/tw3116.pp svneol=native#text/plain tests/webtbf/tw3126.pp svneol=native#text/plain tests/webtbf/tw3145.pp svneol=native#text/plain tests/webtbf/tw3183.pp svneol=native#text/plain -tests/webtbf/tw3183b.pp svneol=native#text/plain tests/webtbf/tw3186.pp svneol=native#text/plain tests/webtbf/tw3218.pp svneol=native#text/plain tests/webtbf/tw3241.pp svneol=native#text/plain @@ -8353,6 +8352,8 @@ tests/webtbs/tw9209.pp svneol=native#text/plain tests/webtbs/tw9221.pp svneol=native#text/plain tests/webtbs/tw9261.pp svneol=native#text/x-pascal tests/webtbs/tw9278.pp svneol=native#text/plain +tests/webtbs/tw9306a.pp -text +tests/webtbs/tw9306b.pp -text tests/webtbs/tw9309.pp -text tests/webtbs/ub1873.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 41ceac9f37..2389a93073 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -128,7 +128,7 @@ implementation uses SysUtils, globals,verbose,systems, - symtable,symconst,symtype,defcmp, + symbase,symtable,symconst,symtype,defcmp, dbgbase, ncgrtti ; @@ -308,8 +308,9 @@ implementation MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false)); end; end - { same parameters } - else if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal) then + { same parameter and return types (parameter specifiers will be checked below) } + else if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_none,[])>=te_equal) and + compatible_childmethod_resultdef(procdefcoll^.data.returndef,pd.returndef) then begin { overload is inherited } if (po_overload in procdefcoll^.data.procoptions) then @@ -324,9 +325,10 @@ implementation include(pd.procoptions,po_hascallingconvention); end; - { the flags have to match except abstract and override } - { only if both are virtual !! } - if (procdefcoll^.data.proccalloption<>pd.proccalloption) or + { All parameter specifiers and some procedure the flags have to match + except abstract and override } + if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])pd.proccalloption) or (procdefcoll^.data.proctypeoption<>pd.proctypeoption) or ((procdefcoll^.data.procoptions*po_comp)<>(pd.procoptions*po_comp)) then begin @@ -334,19 +336,6 @@ implementation tprocsym(procdefcoll^.data.procsym).write_parameter_lists(pd); end; - { error, if the return types aren't equal } - if not compatible_childmethod_resultdef(procdefcoll^.data.returndef,pd.returndef) then - begin - if not((m_delphi in current_settings.modeswitches) and - is_interface(_class)) then - Message2(parser_e_overridden_methods_not_same_ret,pd.fullprocname(false), - procdefcoll^.data.fullprocname(false)) - else - { Delphi allows changing the result type of interface methods from anything to - anything (JM) } - Message2(parser_w_overridden_methods_not_same_ret,pd.fullprocname(false), - procdefcoll^.data.fullprocname(false)); - end; { check if the method to override is visible, check is only needed for the current parsed class. Parent classes are already validated and need to include all virtual methods including the ones not visible in the @@ -451,36 +440,37 @@ implementation po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint, po_exports,po_varargs,po_explicitparaloc,po_nostackframe]; var - sym: tsym; implprocdef : Tprocdef; i: cardinal; + hclass : tobjectdef; + hashedid : THashedIDString; + srsym : tsym; begin result:=nil; - - sym:=tsym(search_class_member(_class,name)); - if assigned(sym) and - (sym.typ=procsym) then + hashedid.id:=name; + hclass:=_class; + while assigned(hclass) do begin - { when the definition has overload directive set, we search for - overloaded definitions in the class, this only needs to be done once - for class entries as the tree keeps always the same } - if (not tprocsym(sym).overloadchecked) and - (po_overload in tprocdef(tprocsym(sym).ProcdefList[0]).procoptions) and - (tprocsym(sym).owner.symtabletype=ObjectSymtable) then - search_class_overloads(tprocsym(sym)); - - for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do + srsym:=tsym(hclass.symtable.FindWithHash(hashedid)); + if assigned(srsym) and + (srsym.typ=procsym) then begin - implprocdef:=tprocdef(Tprocsym(sym).ProcdefList[i]); - if (compare_paras(proc.paras,implprocdef.paras,cp_none,[])>=te_equal) and - (proc.proccalloption=implprocdef.proccalloption) and - (proc.proctypeoption=implprocdef.proctypeoption) and - ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) then + for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do begin - result:=implprocdef; - exit; + implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]); + if (implprocdef.procsym=tprocsym(srsym)) and + (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_comparedefaultvalue])>=te_equal) and + compatible_childmethod_resultdef(proc.returndef,implprocdef.returndef) and + (proc.proccalloption=implprocdef.proccalloption) and + (proc.proctypeoption=implprocdef.proctypeoption) and + ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) then + begin + result:=implprocdef; + exit; + end; end; end; + hclass:=hclass.childof; end; end; @@ -513,13 +503,7 @@ implementation implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name); { Add procdef to the implemented interface } if assigned(implprocdef) then - begin - if (compare_paras(tprocdef(def).paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_comparedefaultvalue])2 then + begin + writeln('Error'); + halt(1); + end; +end. diff --git a/tests/webtbs/tw9306b.pp b/tests/webtbs/tw9306b.pp new file mode 100644 index 0000000000..37494a053f --- /dev/null +++ b/tests/webtbs/tw9306b.pp @@ -0,0 +1,63 @@ +{$mode delphi} + +type + IIntf = interface + function Foo(const S: string): string; + end; + + IIntf2 = interface(IIntf) + function Foo(const S: string): Integer; + end; + + TIntf = class(TInterfacedObject, IIntf) + protected + { IIntf } + function Foo(const S: string): string; + end; + + TIntf2 = class(TIntf, IIntf2) + public + { IIntf2 } + function Foo(const S: string): Integer; overload; + end; + +var + erridx : longint; + +{ TIntf } + +function TIntf.Foo(const S: string): string; +begin + writeln('TIntf.Foo: ',S); + if erridx=0 then + erridx:=1; + result:=S; +end; + +{ TIntf2 } + +function TIntf2.Foo(const S: string): Integer; +begin + writeln('TIntf2.Foo: ',S); + if erridx=1 then + erridx:=2; + result:=0; +end; + +var + i1 : IIntf; + i2 : IIntf2; +begin + erridx:=0; + + i1:=TIntf2.Create; + i1.Foo('1234'); + + i2:=TIntf2.Create; + i2.Foo('1234'); + if erridx<>2 then + begin + writeln('Error'); + halt(1); + end; +end.