mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 01:08:07 +02:00
* fixed calling inherited message handlers after r18162
git-svn-id: trunk@18173 -
This commit is contained in:
parent
392dafd175
commit
d8a2c47c75
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
63
tests/tbs/tb0577a.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user