* fixed calling inherited message handlers after r18162

git-svn-id: trunk@18173 -
This commit is contained in:
Jonas Maebe 2011-08-11 20:08:43 +00:00
parent 392dafd175
commit d8a2c47c75
3 changed files with 82 additions and 4 deletions

1
.gitattributes vendored
View File

@ -9134,6 +9134,7 @@ tests/tbs/tb0574.pp svneol=native#text/pascal
tests/tbs/tb0575.pp svneol=native#text/plain
tests/tbs/tb0576.pp svneol=native#text/plain
tests/tbs/tb0577.pp svneol=native#text/plain
tests/tbs/tb0577a.pp svneol=native#text/plain
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain

View File

@ -1810,10 +1810,24 @@ implementation
pd:=tprocdef(srsym.ProcdefList[j]);
{ in case of anonymous inherited, only match procdefs identical
to the current one (apart from hidden parameters), rather than
anything compatible to the parameters }
if anoninherited and
(compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then
continue;
anything compatible to the parameters -- except in case of
the presence of a messagestr/int, in which case those have to
match exactly }
if anoninherited then
if po_msgint in current_procinfo.procdef.procoptions then
begin
if not(po_msgint in pd.procoptions) or
(pd.messageinf.i<>current_procinfo.procdef.messageinf.i) then
continue
end
else if po_msgstr in current_procinfo.procdef.procoptions then
begin
if not(po_msgstr in pd.procoptions) or
(pd.messageinf.str^<>current_procinfo.procdef.messageinf.str^) then
continue
end
else if (compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then
continue;
foundanything:=true;
{ Store first procsym found }
if not assigned(FProcsym) then

63
tests/tbs/tb0577a.pp Normal file
View File

@ -0,0 +1,63 @@
{$mode delphi}
const
cdefaulthandler = 1;
cinheritedhandler = 2;
cunsupportedhandler = 3;
type
tc = class
procedure defaulthandler(var message); override;
procedure handler(var message:longint); message cinheritedhandler;
end;
tc2 = class(tc)
procedure handler(var message: longint);
end;
tc3 = class(tc2)
procedure someproc(var message:tc3); message cinheritedhandler;
procedure handler(var message:tc3); message cunsupportedhandler;
end;
var
glob: longint;
procedure tc.defaulthandler(var message);
begin
glob:=cdefaulthandler;
end;
procedure tc.handler(var message: longint);
begin
glob:=cinheritedhandler;
end;
procedure tc2.handler(var message: longint);
begin
halt(1);
end;
procedure tc3.someproc(var message: tc3);
begin
inherited;
end;
procedure tc3.handler(var message: tc3);
begin
glob:=cunsupportedhandler;
inherited
end;
var
c: tc3;
begin
c:=tc3.create;
c.someproc(c);
if glob<>cinheritedhandler then
halt(2);
c.handler(c);
if glob<>cdefaulthandler then
halt(3);
end.