* inheritance based on message also needs to find hidden

private methods

git-svn-id: trunk@4024 -
This commit is contained in:
peter 2006-06-30 21:06:49 +00:00
parent c88b2e8369
commit 172413fd09
4 changed files with 78 additions and 2 deletions

2
.gitattributes vendored
View File

@ -7180,6 +7180,7 @@ tests/webtbs/tw5036.pp svneol=native#text/plain
tests/webtbs/tw5082.pp -text svneol=unset#text/plain
tests/webtbs/tw5086.pp -text
tests/webtbs/tw5094.pp -text
tests/webtbs/tw6203.pp svneol=native#text/plain
tests/webtbs/tw6435.pp svneol=native#text/plain
tests/webtbs/tw6491.pp svneol=native#text/plain
tests/webtbs/tw6624.pp svneol=native#text/plain
@ -7239,6 +7240,7 @@ tests/webtbs/uw4352c.pp svneol=native#text/plain
tests/webtbs/uw4352d.pp svneol=native#text/plain
tests/webtbs/uw4352e.pp svneol=native#text/plain
tests/webtbs/uw4541.pp svneol=native#text/plain
tests/webtbs/uw6203.pp svneol=native#text/plain
tests/webtbs/uw6767.pp svneol=native#text/plain
utils/Makefile svneol=native#text/plain
utils/Makefile.fpc svneol=native#text/plain

View File

@ -1804,8 +1804,9 @@ implementation
def:=tdef(classh.symtable.defindex.first);
while assigned(def) do
begin
{ Find also all hidden private methods to
be compatible with delphi, see tw6203 (PFV) }
if (def.deftype=procdef) and
tprocdef(def).is_visible_for_object(topclassh) and
(po_msgint in tprocdef(def).procoptions) and
(tprocdef(def).messageinf.i=i) then
begin
@ -1850,8 +1851,9 @@ implementation
def:=tdef(classh.symtable.defindex.first);
while assigned(def) do
begin
{ Find also all hidden private methods to
be compatible with delphi, see tw6203 (PFV) }
if (def.deftype=procdef) and
tprocdef(def).is_visible_for_object(topclassh) and
(po_msgstr in tprocdef(def).procoptions) and
(tprocdef(def).messageinf.str=s) then
begin

28
tests/webtbs/tw6203.pp Normal file
View File

@ -0,0 +1,28 @@
{$mode delphi}
uses
uw6203;
type
TDerived = class(TTest)
private
procedure CMTest(var Msg: TMessage); message CM_TEST;
end;
procedure TDerived.CMTest(var Msg: TMessage);
begin
inherited;
WriteLn('TDerived.CMTest');
end;
var
Test: TTest;
Msg: TMessage;
begin
err:=true;
Test := TDerived.Create;
Msg.Msg := CM_TEST;
Test.Dispatch(Msg);
if err then
halt(1);
end.

44
tests/webtbs/uw6203.pp Normal file
View File

@ -0,0 +1,44 @@
unit uw6203;
{$mode delphi}
interface
const
CM_TEST = $B000 + 18;
type
TMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
TTest = class
private
procedure CMTest(var Msg: TMessage); message CM_TEST;
end;
var
Err : boolean;
implementation
procedure TTest.CMTest(var Msg: TMessage);
begin
WriteLn('TTest.CMTest');
err:=false;
end;
end.