mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* inheritance based on message also needs to find hidden
private methods git-svn-id: trunk@4024 -
This commit is contained in:
parent
c88b2e8369
commit
172413fd09
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -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
|
||||
|
@ -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
28
tests/webtbs/tw6203.pp
Normal 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
44
tests/webtbs/uw6203.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user