* 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/tb0575.pp svneol=native#text/plain
tests/tbs/tb0576.pp svneol=native#text/plain tests/tbs/tb0576.pp svneol=native#text/plain
tests/tbs/tb0577.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/tb205.pp svneol=native#text/plain
tests/tbs/ub0060.pp svneol=native#text/plain tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain tests/tbs/ub0069.pp svneol=native#text/plain

View File

@ -1810,9 +1810,23 @@ implementation
pd:=tprocdef(srsym.ProcdefList[j]); pd:=tprocdef(srsym.ProcdefList[j]);
{ in case of anonymous inherited, only match procdefs identical { in case of anonymous inherited, only match procdefs identical
to the current one (apart from hidden parameters), rather than to the current one (apart from hidden parameters), rather than
anything compatible to the parameters } anything compatible to the parameters -- except in case of
if anoninherited and the presence of a messagestr/int, in which case those have to
(compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then 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; continue;
foundanything:=true; foundanything:=true;
{ Store first procsym found } { Store first procsym found }

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.