diff options
| -rw-r--r-- | compiler/nobj.pas | 8 | ||||
| -rw-r--r-- | tests/tbf/tb0267.pp | 34 | ||||
| -rw-r--r-- | tests/tbs/tb0654.pp | 34 | ||||
| -rw-r--r-- | tests/webtbs/tw27349.pp | 8 |
4 files changed, 80 insertions, 4 deletions
diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 1c5ccc49a4..5bba262cde 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -511,6 +511,7 @@ implementation hclass : tobjectdef; hashedid : THashedIDString; srsym : tsym; + overload: boolean; begin result:=nil; hashedid.id:=name; @@ -523,9 +524,12 @@ implementation ((hclass=_class) or is_visible_for_object(srsym,_class)) then begin + overload:=false; for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do begin implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]); + if po_overload in implprocdef.procoptions then + overload:=true; if (implprocdef.procsym=tprocsym(srsym)) and (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv])>=te_equal) and (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and @@ -546,6 +550,10 @@ implementation exit; end; end; + { like with normal procdef resolution (in htypechk), stop if + we encounter a proc without the overload directive } + if not overload then + exit; end; hclass:=hclass.childof; end; diff --git a/tests/tbf/tb0267.pp b/tests/tbf/tb0267.pp new file mode 100644 index 0000000000..af4c41b933 --- /dev/null +++ b/tests/tbf/tb0267.pp @@ -0,0 +1,34 @@ +{ %fail } + +{$mode objfpc}{$h+} +{$interfaces corba} + +type + tintf = interface + procedure test(l: longint); + procedure test(s: string); + end; + + tp = class + procedure test(l: longint); virtual; + procedure test(s: string); virtual; + end; + + tc = class(tp, tintf) + procedure test(l: longint); override; + end; + +procedure tp.test(l: longint); + begin + end; + +procedure tp.test(s: string); + begin + end; + +procedure tc.test(l: longint); + begin + end; + +begin +end. diff --git a/tests/tbs/tb0654.pp b/tests/tbs/tb0654.pp new file mode 100644 index 0000000000..a0025acc1d --- /dev/null +++ b/tests/tbs/tb0654.pp @@ -0,0 +1,34 @@ +{ %norun } + +{$mode objfpc}{$h+} +{$interfaces corba} + +type + tintf = interface + procedure test(l: longint); + procedure test(s: string); + end; + + tp = class + procedure test(l: longint); overload; virtual; + procedure test(s: string); overload; virtual; + end; + + tc = class(tp, tintf) + procedure test(l: longint); override; + end; + +procedure tp.test(l: longint); + begin + end; + +procedure tp.test(s: string); + begin + end; + +procedure tc.test(l: longint); + begin + end; + +begin +end. diff --git a/tests/webtbs/tw27349.pp b/tests/webtbs/tw27349.pp index 3800976725..6d8ac92ed0 100644 --- a/tests/webtbs/tw27349.pp +++ b/tests/webtbs/tw27349.pp @@ -13,7 +13,7 @@ type type tmyintf = class(TInterfacedObject, iinterface) - function _AddRef : longint; stdcall; + function _AddRef : longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; end; end; @@ -23,17 +23,17 @@ type type tmyintf = class(TInterfacedObject, iinterface) - function _AddRef : longint; stdcall; + function _AddRef : longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; end; end; -function C.tmyintf._AddRef: longint; stdcall; +function C.tmyintf._AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin result := inherited _AddRef; // OK end; -function R.tmyintf._AddRef: longint; stdcall; +function R.tmyintf._AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin result := inherited _AddRef; // FAIL end; |